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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-- |
-- Copyright : (c) Sam Truzjan 2013, 2014
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- Normally, you don't need to import this module.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
module Network.KRPC.Method
( Method (..)
, KRPC (..)
) where
#ifdef VERSION_bencoding
import Data.BEncode (BEncode)
#else
import Data.Serialize
#endif
import Data.ByteString.Char8 as BC
import Data.Char
import Data.Monoid
import Data.List as L
import Data.String
import Data.Typeable
import Network.DatagramServer.Mainline
-- | Method datatype used to describe method 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.
--
-- * result: Type of return value of the method.
--
newtype Method param result = Method { methodName :: MethodName }
deriving ( Eq, Ord
#ifdef VERSION_bencoding
, IsString
, BEncode
#endif
)
-- | Example:
--
-- @show (Method \"concat\" :: [Int] Int) == \"concat :: [Int] -> Int\"@
--
instance (Typeable a, Typeable b) => Show (Method a b) where
showsPrec _ = showsMethod
showsMethod :: forall a b. ( Typeable a , Typeable b ) => Method a b -> ShowS
showsMethod (Method name) =
#ifdef VERSION_bencoding
showString (BC.unpack name) <>
#else
shows (show name) <>
#endif
showString " :: " <>
shows paramsTy <>
showString " -> " <>
shows valuesTy
where
impossible = error "KRPC.showsMethod: impossible"
paramsTy = typeOf (impossible :: a)
valuesTy = typeOf (impossible :: b)
-- | In order to perform or handle KRPC query you need to provide
-- corresponding 'KRPC' class.
--
-- Example:
--
-- @
-- data Ping = Ping Text deriving BEncode
-- data Pong = Pong Text deriving BEncode
--
-- instance 'KRPC' Ping Pong where
-- method = \"ping\"
-- @
--
class ( Typeable req, Typeable resp
#ifdef VERSION_bencoding
, BEncode req, BEncode resp
#else
, Serialize req, Serialize resp
#endif
)
=> KRPC req resp | req -> resp, resp -> req where
type Envelope req resp
-- | Method name. Default implementation uses lowercased @req@
-- datatype name.
--
method :: Method req resp
#ifdef VERSION_bencoding
-- 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
#endif
unseal :: Envelope req resp -> Either String req
seal :: resp -> Envelope req resp
|
