summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--krpc.cabal1
-rw-r--r--src/Remote/KRPC.hs18
-rw-r--r--tests/Client.hs8
-rw-r--r--tests/Server.hs1
-rw-r--r--tests/Shared.hs6
5 files changed, 30 insertions, 4 deletions
diff --git a/krpc.cabal b/krpc.cabal
index 059f6348..779d7abc 100644
--- a/krpc.cabal
+++ b/krpc.cabal
@@ -57,6 +57,7 @@ test-suite test-client
57 other-modules: Shared 57 other-modules: Shared
58 build-depends: base == 4.* 58 build-depends: base == 4.*
59 , bytestring 59 , bytestring
60 , containers
60 , process 61 , process
61 , filepath 62 , filepath
62 63
diff --git a/src/Remote/KRPC.hs b/src/Remote/KRPC.hs
index e1ad0853..1b4ae4b6 100644
--- a/src/Remote/KRPC.hs
+++ b/src/Remote/KRPC.hs
@@ -175,7 +175,9 @@ extractArgs :: BEncodable arg
175 => [ParamName] -> Map ParamName BEncode -> Result arg 175 => [ParamName] -> Map ParamName BEncode -> Result arg
176extractArgs as d = fromBEncode =<< 176extractArgs as d = fromBEncode =<<
177 case as of 177 case as of
178 [] -> Right (BList []) 178 [] -> if M.null d
179 then Right (BList [])
180 else Right (BDict d)
179 [x] -> f x 181 [x] -> f x
180 xs -> BList <$> mapM f xs 182 xs -> BList <$> mapM f xs
181 where 183 where
@@ -184,12 +186,22 @@ extractArgs as d = fromBEncode =<<
184{-# INLINE extractArgs #-} 186{-# INLINE extractArgs #-}
185 187
186injectVals :: BEncodable arg => [ParamName] -> arg -> [(ParamName, BEncode)] 188injectVals :: BEncodable arg => [ParamName] -> arg -> [(ParamName, BEncode)]
187injectVals [] (toBEncode -> BList []) = [] 189injectVals [] (toBEncode -> be)
190 = case be of
191 BList [] -> []
192 BDict d -> M.toList d
193 _ -> invalidParamList [] be
194
188injectVals [p] (toBEncode -> arg) = [(p, arg)] 195injectVals [p] (toBEncode -> arg) = [(p, arg)]
189injectVals ps (toBEncode -> BList as) = L.zip ps as 196injectVals ps (toBEncode -> BList as) = L.zip ps as
190injectVals _ _ = error "KRPC.injectVals: impossible" 197injectVals pl a = invalidParamList pl (toBEncode a)
191{-# INLINE injectVals #-} 198{-# INLINE injectVals #-}
192 199
200invalidParamList :: [ParamName] -> BEncode -> a
201invalidParamList pl be
202 = error $ "KRPC invalid parameter list: " ++ show pl ++ "\n" ++
203 "while procedure args are: " ++ show be
204
193-- | Alias to Socket, through might change in future. 205-- | Alias to Socket, through might change in future.
194type Remote = Socket 206type Remote = Socket
195 207
diff --git a/tests/Client.hs b/tests/Client.hs
index 1b9ef8d2..313cd56e 100644
--- a/tests/Client.hs
+++ b/tests/Client.hs
@@ -5,6 +5,7 @@ import Control.Concurrent
5import Control.Exception 5import Control.Exception
6import qualified Data.ByteString as B 6import qualified Data.ByteString as B
7import Data.BEncode 7import Data.BEncode
8import Data.Map
8import System.Environment 9import System.Environment
9import System.Process 10import System.Process
10import System.FilePath 11import System.FilePath
@@ -69,4 +70,11 @@ tests =
69 70
70 , testCase "raw method" $ 71 , testCase "raw method" $
71 BInteger 10 ==? call addr rawM (BInteger 10) 72 BInteger 10 ==? call addr rawM (BInteger 10)
73
74 , testCase "raw dict" $
75 let dict = BDict $ fromList
76 [ ("some_int", BInteger 100)
77 , ("some_list", BList [BInteger 10])
78 ]
79 in dict ==? call addr rawDictM dict
72 ] 80 ]
diff --git a/tests/Server.hs b/tests/Server.hs
index 7cd6a5d6..aaf6d9f2 100644
--- a/tests/Server.hs
+++ b/tests/Server.hs
@@ -15,4 +15,5 @@ main = server 6000
15 , reverseM ==> return . reverse 15 , reverseM ==> return . reverse
16 , shiftR ==> \(a, b, c) -> return (c, a, b) 16 , shiftR ==> \(a, b, c) -> return (c, a, b)
17 , rawM ==> return 17 , rawM ==> return
18 , rawDictM ==> return
18 ] 19 ]
diff --git a/tests/Shared.hs b/tests/Shared.hs
index a04b6093..f64112da 100644
--- a/tests/Shared.hs
+++ b/tests/Shared.hs
@@ -7,6 +7,7 @@ module Shared
7 , reverseM 7 , reverseM
8 , shiftR 8 , shiftR
9 , rawM 9 , rawM
10 , rawDictM
10 ) where 11 ) where
11 12
12import Data.ByteString (ByteString) 13import Data.ByteString (ByteString)
@@ -32,4 +33,7 @@ shiftR :: Method ((), Int, [Int]) ([Int], (), Int)
32shiftR = method "shiftR" ["x", "y", "z"] ["a", "b", "c"] 33shiftR = method "shiftR" ["x", "y", "z"] ["a", "b", "c"]
33 34
34rawM :: Method BEncode BEncode 35rawM :: Method BEncode BEncode
35rawM = method "rawM" [""] [""] \ No newline at end of file 36rawM = method "rawM" [""] [""]
37
38rawDictM :: Method BEncode BEncode
39rawDictM = method "m" [] [] \ No newline at end of file