1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures #-}
module Network.KRPC.Method
( Method (..)
, KRPC (..)
) where
import Data.BEncode (BEncode)
import Data.Char
import Data.Monoid
import Data.List as L
import Data.String
import Data.Typeable
import Network.KRPC.Message
-- | Method datatype used to describe name, parameters and return
-- values of procedure. Client use a method to /invoke/, server
-- /implements/ the method to make the actual work.
--
-- We use the following fantom types to ensure type-safiety:
--
-- * param: Type of method parameters. Ordinary Tuple type used
-- to specify more than one parameter, so for example @Method
-- (Int, Int) result@ will take two arguments.
--
-- * result: Type of return value of the method. Similarly,
-- tuple used to specify more than one return value, so for
-- exsample @Method (Foo, Bar) (Bar, Foo)@ will take two arguments
-- and return two values.
--
newtype Method param result = Method MethodName
deriving (Eq, Ord, IsString, BEncode)
instance (Typeable a, Typeable b) => Show (Method a b) where
showsPrec _ = showsMethod
showsMethod :: forall a. forall b. Typeable a => Typeable b
=> Method a b -> ShowS
showsMethod (Method name) =
shows name <>
showString " :: " <>
shows paramsTy <>
showString " -> " <>
shows valuesTy
where
impossible = error "KRPC.showsMethod: impossible"
paramsTy = typeOf (impossible :: a)
valuesTy = typeOf (impossible :: b)
-- | Example:
-- @
-- data Ping = Ping Text deriving BEncode
-- data Pong = Pong Text deriving BEncode
--
-- instance KRPC Ping Pong where
-- method = "ping"
-- @
class (BEncode req, BEncode resp) => KRPC req resp | req -> resp where
method :: Method req resp
-- TODO add underscores
default method :: Typeable req => Method req resp
method = Method $ fromString $ L.map toLower $ show $ typeOf hole
where
hole = error "krpc.method: impossible" :: req
|
