| ... |
... |
@@ -34,8 +34,10 @@ module GHCi.Message |
|
34
|
34
|
-- * Consume `reply` exactly once
|
|
35
|
35
|
, WriteReply -- abstract
|
|
36
|
36
|
, writeReply
|
|
37
|
|
- -- , thenLinearly
|
|
38
|
|
- -- , forkIOLinearly
|
|
|
37
|
+
|
|
|
38
|
+ -- * Low-level interface for async bidirectional RPC
|
|
|
39
|
+ , withAsyncReq
|
|
|
40
|
+ , withAsyncHandler
|
|
39
|
41
|
) where
|
|
40
|
42
|
|
|
41
|
43
|
import Prelude -- See note [Why do we import Prelude here?]
|
| ... |
... |
@@ -786,7 +788,11 @@ remoteTHCall pipe msg = bimap fromSerializableException id . runGet get |
|
786
|
788
|
<$> withAsyncReq pipe (putTHMessage msg)
|
|
787
|
789
|
|
|
788
|
790
|
-- | Handle a 'THMessage' request on the host and reply to the interpreter
|
|
789
|
|
--- handleRemoteTHCall = undefined
|
|
|
791
|
+handleRemoteTHCall
|
|
|
792
|
+ :: Pipe -> (forall a. Binary a => WriteReply a %1 -> Message a -> IO r) -> IO r
|
|
|
793
|
+handleRemoteTHCall pipe k =
|
|
|
794
|
+ withAsyncHandler pipe getMessage \(WriteReply reply) (Msg @a msg) -> do
|
|
|
795
|
+ k (WriteReply (reply . fmap (put @a))) msg
|
|
790
|
796
|
|
|
791
|
797
|
--------------------------------------------------------------------------------
|
|
792
|
798
|
-- * Matching requests with async replies
|
| ... |
... |
@@ -815,6 +821,10 @@ withAsyncReq pipe msg = do |
|
815
|
821
|
-- The handler receives as an argument the function to use to reply to the request.
|
|
816
|
822
|
-- It must be used exactly once (all requests expect a reply, and you can't
|
|
817
|
823
|
-- reply more than once). Linear types enforce this.
|
|
|
824
|
+--
|
|
|
825
|
+-- TODO: list of @a -> Bool@s or other proxy for which the handler runs in a
|
|
|
826
|
+-- forked thread? better than linear forkIO that can be misleading or used
|
|
|
827
|
+-- improperly for other linear stuff
|
|
818
|
828
|
withAsyncHandler :: Pipe -> Get a -> (WriteReply Put %1 -> a -> IO r) -> IO r
|
|
819
|
829
|
withAsyncHandler pipe getit k = do
|
|
820
|
830
|
ack <- newEmptyMVar
|