diff options
Diffstat (limited to 'src/Remote/KRPC.hs')
-rw-r--r-- | src/Remote/KRPC.hs | 29 |
1 files changed, 22 insertions, 7 deletions
diff --git a/src/Remote/KRPC.hs b/src/Remote/KRPC.hs index 0e9838f1..e1ad0853 100644 --- a/src/Remote/KRPC.hs +++ b/src/Remote/KRPC.hs | |||
@@ -100,6 +100,10 @@ module Remote.KRPC | |||
100 | 100 | ||
101 | -- * Server | 101 | -- * Server |
102 | , MethodHandler, (==>), server | 102 | , MethodHandler, (==>), server |
103 | |||
104 | -- * Internal | ||
105 | , call_ | ||
106 | , withRemote | ||
103 | ) where | 107 | ) where |
104 | 108 | ||
105 | import Control.Applicative | 109 | import Control.Applicative |
@@ -186,7 +190,8 @@ injectVals ps (toBEncode -> BList as) = L.zip ps as | |||
186 | injectVals _ _ = error "KRPC.injectVals: impossible" | 190 | injectVals _ _ = error "KRPC.injectVals: impossible" |
187 | {-# INLINE injectVals #-} | 191 | {-# INLINE injectVals #-} |
188 | 192 | ||
189 | 193 | -- | Alias to Socket, through might change in future. | |
194 | type Remote = Socket | ||
190 | 195 | ||
191 | -- | Represent any error mentioned by protocol specification that | 196 | -- | Represent any error mentioned by protocol specification that |
192 | -- 'call', 'await' might throw. | 197 | -- 'call', 'await' might throw. |
@@ -208,10 +213,10 @@ queryCall sock addr m arg = sendMessage q addr sock | |||
208 | q = kquery (methodName m) (injectVals (methodParams m) arg) | 213 | q = kquery (methodName m) (injectVals (methodParams m) arg) |
209 | 214 | ||
210 | getResult :: BEncodable result | 215 | getResult :: BEncodable result |
211 | => KRemote -> KRemoteAddr | 216 | => KRemote |
212 | -> Method param result -> IO result | 217 | -> Method param result -> IO result |
213 | getResult sock addr m = do | 218 | getResult sock m = do |
214 | resp <- recvResponse addr sock | 219 | resp <- recvResponse sock |
215 | case resp of | 220 | case resp of |
216 | Left e -> throw (RPCException e) | 221 | Left e -> throw (RPCException e) |
217 | Right (respVals -> dict) -> do | 222 | Right (respVals -> dict) -> do |
@@ -228,9 +233,19 @@ call :: (MonadBaseControl IO host, MonadIO host) | |||
228 | -> Method param result -- ^ Procedure to call. | 233 | -> Method param result -- ^ Procedure to call. |
229 | -> param -- ^ Arguments passed by callee to procedure. | 234 | -> param -- ^ Arguments passed by callee to procedure. |
230 | -> host result -- ^ Values returned by callee from the procedure. | 235 | -> host result -- ^ Values returned by callee from the procedure. |
231 | call addr m arg = liftIO $ withRemote $ \sock -> do | 236 | call addr m arg = liftIO $ withRemote $ \sock -> do call_ sock addr m arg |
237 | |||
238 | -- | The same as 'call' but use already opened socket. | ||
239 | call_ :: (MonadBaseControl IO host, MonadIO host) | ||
240 | => (BEncodable param, BEncodable result) | ||
241 | => Remote -- ^ Socket to use | ||
242 | -> RemoteAddr -- ^ Address of callee. | ||
243 | -> Method param result -- ^ Procedure to call. | ||
244 | -> param -- ^ Arguments passed by callee to procedure. | ||
245 | -> host result -- ^ Values returned by callee from the procedure. | ||
246 | call_ sock addr m arg = liftIO $ do | ||
232 | queryCall sock addr m arg | 247 | queryCall sock addr m arg |
233 | getResult sock addr m | 248 | getResult sock m |
234 | 249 | ||
235 | 250 | ||
236 | -- | Asynchonous result typically get from 'async' call. Used to defer | 251 | -- | Asynchonous result typically get from 'async' call. Used to defer |
@@ -265,7 +280,7 @@ async addr m arg = do | |||
265 | liftIO $ withRemote $ \sock -> | 280 | liftIO $ withRemote $ \sock -> |
266 | queryCall sock addr m arg | 281 | queryCall sock addr m arg |
267 | return $ Async $ withRemote $ \sock -> | 282 | return $ Async $ withRemote $ \sock -> |
268 | getResult sock addr m | 283 | getResult sock m |
269 | 284 | ||
270 | -- | Will wait until the callee finished processing of procedure call | 285 | -- | Will wait until the callee finished processing of procedure call |
271 | -- and return its results. Throws 'RPCException' on any error | 286 | -- and return its results. Throws 'RPCException' on any error |