summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-07-08 23:49:49 +0400
committerSam T <pxqr.sta@gmail.com>2013-07-08 23:49:49 +0400
commite8dc0c6087738dc6e08298e3c108d8d61fd92a10 (patch)
tree0c1b4980b19b47e3e1ead490981cabf8bc5c96a9 /src
parent76b4937c99f131bbe52ef22b03a0bb7317280257 (diff)
~ Code style.
Diffstat (limited to 'src')
-rw-r--r--src/Remote/KRPC.hs43
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
170method = Method 170method = Method
171{-# INLINE method #-} 171{-# INLINE method #-}
172 172
173lookupKey :: ParamName -> Map ByteString BEncode -> Result BEncode
174lookupKey x = maybe (Left ("not found key " ++ BC.unpack x)) Right . M.lookup x
173 175
174extractArgs :: BEncodable arg 176extractArgs :: [ParamName] -> Map ParamName BEncode -> Result BEncode
175 => [ParamName] -> Map ParamName BEncode -> Result arg 177extractArgs [] d = Right $ if M.null d then BList [] else BDict d
176extractArgs as d = fromBEncode =<< 178extractArgs [x] d = lookupKey x d
177 case as of 179extractArgs 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
188injectVals :: BEncodable arg => [ParamName] -> arg -> [(ParamName, BEncode)] 182injectVals :: [ParamName] -> BEncode -> [(ParamName, BEncode)]
189injectVals [] (toBEncode -> be) 183injectVals [] (BList []) = []
190 = case be of 184injectVals [] (BDict d ) = M.toList d
191 BList [] -> [] 185injectVals [] be = invalidParamList [] be
192 BDict d -> M.toList d 186injectVals [p] arg = [(p, arg)]
193 _ -> invalidParamList [] be 187injectVals ps (BList as) = L.zip ps as
194 188injectVals ps be = invalidParamList ps be
195injectVals [p] (toBEncode -> arg) = [(p, arg)]
196injectVals ps (toBEncode -> BList as) = L.zip ps as
197injectVals pl a = invalidParamList pl (toBEncode a)
198{-# INLINE injectVals #-} 189{-# INLINE injectVals #-}
199 190
200invalidParamList :: [ParamName] -> BEncode -> a 191invalidParamList :: [ParamName] -> BEncode -> a
@@ -222,7 +213,7 @@ queryCall :: BEncodable param
222 -> Method param result -> param -> IO () 213 -> Method param result -> param -> IO ()
223queryCall sock addr m arg = sendMessage q addr sock 214queryCall 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
227getResult :: BEncodable result 218getResult :: 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
332infix 1 ==> 323infix 1 ==>
333 324