diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-07-08 23:49:49 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-07-08 23:49:49 +0400 |
commit | e8dc0c6087738dc6e08298e3c108d8d61fd92a10 (patch) | |
tree | 0c1b4980b19b47e3e1ead490981cabf8bc5c96a9 /src | |
parent | 76b4937c99f131bbe52ef22b03a0bb7317280257 (diff) |
~ Code style.
Diffstat (limited to 'src')
-rw-r--r-- | src/Remote/KRPC.hs | 43 |
1 files changed, 17 insertions, 26 deletions
diff --git a/src/Remote/KRPC.hs b/src/Remote/KRPC.hs index 1b4ae4b6..74842db6 100644 --- a/src/Remote/KRPC.hs +++ b/src/Remote/KRPC.hs | |||
@@ -170,31 +170,22 @@ method :: MethodName -> [ParamName] -> [ValName] -> Method param result | |||
170 | method = Method | 170 | method = Method |
171 | {-# INLINE method #-} | 171 | {-# INLINE method #-} |
172 | 172 | ||
173 | lookupKey :: ParamName -> Map ByteString BEncode -> Result BEncode | ||
174 | lookupKey x = maybe (Left ("not found key " ++ BC.unpack x)) Right . M.lookup x | ||
173 | 175 | ||
174 | extractArgs :: BEncodable arg | 176 | extractArgs :: [ParamName] -> Map ParamName BEncode -> Result BEncode |
175 | => [ParamName] -> Map ParamName BEncode -> Result arg | 177 | extractArgs [] d = Right $ if M.null d then BList [] else BDict d |
176 | extractArgs as d = fromBEncode =<< | 178 | extractArgs [x] d = lookupKey x d |
177 | case as of | 179 | extractArgs xs d = BList <$> mapM (`lookupKey` d) xs |
178 | [] -> if M.null d | ||
179 | then Right (BList []) | ||
180 | else Right (BDict d) | ||
181 | [x] -> f x | ||
182 | xs -> BList <$> mapM f xs | ||
183 | where | ||
184 | f x = maybe (Left ("not found key " ++ BC.unpack x)) Right | ||
185 | (M.lookup x d) | ||
186 | {-# INLINE extractArgs #-} | 180 | {-# INLINE extractArgs #-} |
187 | 181 | ||
188 | injectVals :: BEncodable arg => [ParamName] -> arg -> [(ParamName, BEncode)] | 182 | injectVals :: [ParamName] -> BEncode -> [(ParamName, BEncode)] |
189 | injectVals [] (toBEncode -> be) | 183 | injectVals [] (BList []) = [] |
190 | = case be of | 184 | injectVals [] (BDict d ) = M.toList d |
191 | BList [] -> [] | 185 | injectVals [] be = invalidParamList [] be |
192 | BDict d -> M.toList d | 186 | injectVals [p] arg = [(p, arg)] |
193 | _ -> invalidParamList [] be | 187 | injectVals ps (BList as) = L.zip ps as |
194 | 188 | injectVals ps be = invalidParamList ps be | |
195 | injectVals [p] (toBEncode -> arg) = [(p, arg)] | ||
196 | injectVals ps (toBEncode -> BList as) = L.zip ps as | ||
197 | injectVals pl a = invalidParamList pl (toBEncode a) | ||
198 | {-# INLINE injectVals #-} | 189 | {-# INLINE injectVals #-} |
199 | 190 | ||
200 | invalidParamList :: [ParamName] -> BEncode -> a | 191 | invalidParamList :: [ParamName] -> BEncode -> a |
@@ -222,7 +213,7 @@ queryCall :: BEncodable param | |||
222 | -> Method param result -> param -> IO () | 213 | -> Method param result -> param -> IO () |
223 | queryCall sock addr m arg = sendMessage q addr sock | 214 | queryCall sock addr m arg = sendMessage q addr sock |
224 | where | 215 | where |
225 | q = kquery (methodName m) (injectVals (methodParams m) arg) | 216 | q = kquery (methodName m) (injectVals (methodParams m) (toBEncode arg)) |
226 | 217 | ||
227 | getResult :: BEncodable result | 218 | getResult :: BEncodable result |
228 | => KRemote | 219 | => KRemote |
@@ -232,7 +223,7 @@ getResult sock m = do | |||
232 | case resp of | 223 | case resp of |
233 | Left e -> throw (RPCException e) | 224 | Left e -> throw (RPCException e) |
234 | Right (respVals -> dict) -> do | 225 | Right (respVals -> dict) -> do |
235 | case extractArgs (methodVals m) dict of | 226 | case fromBEncode =<< extractArgs (methodVals m) dict of |
236 | Right vals -> return vals | 227 | Right vals -> return vals |
237 | Left e -> throw (RPCException (ProtocolError (BC.pack e))) | 228 | Left e -> throw (RPCException (ProtocolError (BC.pack e))) |
238 | 229 | ||
@@ -323,11 +314,11 @@ m ==> body = (methodName m, newbody) | |||
323 | where | 314 | where |
324 | {-# INLINE newbody #-} | 315 | {-# INLINE newbody #-} |
325 | newbody q = | 316 | newbody q = |
326 | case extractArgs (methodParams m) (queryArgs q) of | 317 | case fromBEncode =<< extractArgs (methodParams m) (queryArgs q) of |
327 | Left e -> return (Left (ProtocolError (BC.pack e))) | 318 | Left e -> return (Left (ProtocolError (BC.pack e))) |
328 | Right a -> do | 319 | Right a -> do |
329 | r <- body a | 320 | r <- body a |
330 | return (Right (kresponse (injectVals (methodVals m) r))) | 321 | return (Right (kresponse (injectVals (methodVals m) (toBEncode r)))) |
331 | 322 | ||
332 | infix 1 ==> | 323 | infix 1 ==> |
333 | 324 | ||