diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-05-12 07:25:41 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-05-12 07:25:41 +0400 |
commit | fafdbec2cb64f11513bfe3a0a220562de97d9e36 (patch) | |
tree | 8491924a8e3010b575f0bc8c257ee0cd0e8517da /src/Remote/KRPC | |
parent | eff48f66c6d8e7231eef0ef3c3561e19865a2637 (diff) |
~ Remove orphaned scheme validation.
Diffstat (limited to 'src/Remote/KRPC')
-rw-r--r-- | src/Remote/KRPC/Method.hs | 14 | ||||
-rw-r--r-- | src/Remote/KRPC/Protocol.hs | 45 |
2 files changed, 2 insertions, 57 deletions
diff --git a/src/Remote/KRPC/Method.hs b/src/Remote/KRPC/Method.hs index 4283256b..4d91fe47 100644 --- a/src/Remote/KRPC/Method.hs +++ b/src/Remote/KRPC/Method.hs | |||
@@ -9,7 +9,6 @@ | |||
9 | {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} | 9 | {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} |
10 | module Remote.KRPC.Method | 10 | module Remote.KRPC.Method |
11 | ( Method(methodName, methodParams, methodVals) | 11 | ( Method(methodName, methodParams, methodVals) |
12 | , methodQueryScheme, methodRespScheme | ||
13 | 12 | ||
14 | -- * Construction | 13 | -- * Construction |
15 | , method | 14 | , method |
@@ -18,10 +17,6 @@ module Remote.KRPC.Method | |||
18 | , idM | 17 | , idM |
19 | ) where | 18 | ) where |
20 | 19 | ||
21 | import Control.Applicative | ||
22 | import Data.BEncode | ||
23 | import Data.Set as S | ||
24 | |||
25 | import Remote.KRPC.Protocol | 20 | import Remote.KRPC.Protocol |
26 | 21 | ||
27 | 22 | ||
@@ -43,15 +38,6 @@ data Method param result = Method { | |||
43 | -- | Description of each return value in /right to left/ order. | 38 | -- | Description of each return value in /right to left/ order. |
44 | , methodVals :: [ValName] | 39 | , methodVals :: [ValName] |
45 | } | 40 | } |
46 | methodQueryScheme :: Method a b -> KQueryScheme | ||
47 | methodQueryScheme = KQueryScheme <$> methodName | ||
48 | <*> S.fromList . methodParams | ||
49 | {-# INLINE methodQueryScheme #-} | ||
50 | |||
51 | |||
52 | methodRespScheme :: Method a b -> KResponseScheme | ||
53 | methodRespScheme = KResponseScheme . S.fromList . methodVals | ||
54 | {-# INLINE methodRespScheme #-} | ||
55 | 41 | ||
56 | -- TODO ppMethod | 42 | -- TODO ppMethod |
57 | 43 | ||
diff --git a/src/Remote/KRPC/Protocol.hs b/src/Remote/KRPC/Protocol.hs index 7351831b..133c899a 100644 --- a/src/Remote/KRPC/Protocol.hs +++ b/src/Remote/KRPC/Protocol.hs | |||
@@ -17,19 +17,15 @@ | |||
17 | {-# LANGUAGE DefaultSignatures #-} | 17 | {-# LANGUAGE DefaultSignatures #-} |
18 | module Remote.KRPC.Protocol | 18 | module Remote.KRPC.Protocol |
19 | ( | 19 | ( |
20 | -- * Message | ||
21 | KMessage(..) | ||
22 | 20 | ||
23 | -- * Error | 21 | -- * Error |
24 | , KError(..), errorCode, mkKError | 22 | KError(..), errorCode, mkKError |
25 | 23 | ||
26 | -- * Query | 24 | -- * Query |
27 | , KQuery(queryMethod, queryArgs), MethodName, ParamName, kquery | 25 | , KQuery(queryMethod, queryArgs), MethodName, ParamName, kquery |
28 | , KQueryScheme(KQueryScheme, qscMethod, qscParams) | ||
29 | 26 | ||
30 | -- * Response | 27 | -- * Response |
31 | , KResponse(respVals), ValName, kresponse | 28 | , KResponse(respVals), ValName, kresponse |
32 | , KResponseScheme(KResponseScheme, rscVals) | ||
33 | 29 | ||
34 | , sendMessage, recvResponse | 30 | , sendMessage, recvResponse |
35 | 31 | ||
@@ -52,28 +48,11 @@ import Data.ByteString as B | |||
52 | import Data.ByteString.Char8 as BC | 48 | import Data.ByteString.Char8 as BC |
53 | import qualified Data.ByteString.Lazy as LB | 49 | import qualified Data.ByteString.Lazy as LB |
54 | import Data.Map as M | 50 | import Data.Map as M |
55 | import Data.Set as S | ||
56 | 51 | ||
57 | import Network.Socket hiding (recvFrom) | 52 | import Network.Socket hiding (recvFrom) |
58 | import Network.Socket.ByteString | 53 | import Network.Socket.ByteString |
59 | 54 | ||
60 | 55 | ||
61 | |||
62 | -- | Used to validate message by its scheme | ||
63 | -- | ||
64 | -- forall m. m `validate` scheme m | ||
65 | -- | ||
66 | class KMessage message scheme | message -> scheme where | ||
67 | -- | Get a message scheme. | ||
68 | scheme :: message -> scheme | ||
69 | |||
70 | -- | Check a message with a scheme. | ||
71 | validate :: message -> scheme -> Bool | ||
72 | |||
73 | default validate :: Eq scheme => message -> scheme -> Bool | ||
74 | validate = (==) . scheme | ||
75 | {-# INLINE validate #-} | ||
76 | |||
77 | -- TODO Text -> ByteString | 56 | -- TODO Text -> ByteString |
78 | -- TODO document that it is and how transferred | 57 | -- TODO document that it is and how transferred |
79 | data KError | 58 | data KError |
@@ -102,11 +81,6 @@ instance BEncodable KError where | |||
102 | 81 | ||
103 | fromBEncode _ = decodingError "KError" | 82 | fromBEncode _ = decodingError "KError" |
104 | 83 | ||
105 | instance KMessage KError ErrorCode where | ||
106 | {-# SPECIALIZE instance KMessage KError ErrorCode #-} | ||
107 | scheme = errorCode | ||
108 | {-# INLINE scheme #-} | ||
109 | |||
110 | type ErrorCode = Int | 84 | type ErrorCode = Int |
111 | 85 | ||
112 | errorCode :: KError -> ErrorCode | 86 | errorCode :: KError -> ErrorCode |
@@ -157,15 +131,8 @@ kquery :: MethodName -> [(ParamName, BEncode)] -> KQuery | |||
157 | kquery name args = KQuery name (M.fromList args) | 131 | kquery name args = KQuery name (M.fromList args) |
158 | {-# INLINE kquery #-} | 132 | {-# INLINE kquery #-} |
159 | 133 | ||
160 | data KQueryScheme = KQueryScheme { | ||
161 | qscMethod :: MethodName | ||
162 | , qscParams :: Set ParamName | ||
163 | } deriving (Show, Read, Eq, Ord) | ||
164 | 134 | ||
165 | instance KMessage KQuery KQueryScheme where | 135 | |
166 | {-# SPECIALIZE instance KMessage KQuery KQueryScheme #-} | ||
167 | scheme q = KQueryScheme (queryMethod q) (M.keysSet (queryArgs q)) | ||
168 | {-# INLINE scheme #-} | ||
169 | 136 | ||
170 | type ValName = ByteString | 137 | type ValName = ByteString |
171 | 138 | ||
@@ -191,14 +158,6 @@ kresponse :: [(ValName, BEncode)] -> KResponse | |||
191 | kresponse = KResponse . M.fromList | 158 | kresponse = KResponse . M.fromList |
192 | {-# INLINE kresponse #-} | 159 | {-# INLINE kresponse #-} |
193 | 160 | ||
194 | newtype KResponseScheme = KResponseScheme { | ||
195 | rscVals :: Set ValName | ||
196 | } deriving (Show, Read, Eq, Ord) | ||
197 | |||
198 | instance KMessage KResponse KResponseScheme where | ||
199 | {-# SPECIALIZE instance KMessage KResponse KResponseScheme #-} | ||
200 | scheme = KResponseScheme . keysSet . respVals | ||
201 | {-# INLINE scheme #-} | ||
202 | 161 | ||
203 | 162 | ||
204 | type KRemoteAddr = (HostAddress, PortNumber) | 163 | type KRemoteAddr = (HostAddress, PortNumber) |