summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/QueryResponse.hs26
1 files changed, 13 insertions, 13 deletions
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index b6fea4a9..f6f2807d 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -39,7 +39,7 @@ import Data.Maybe
39-- > r <- sendQuery client method q 39-- > r <- sendQuery client method q
40-- > -- Quit client. 40-- > -- Quit client.
41-- > quitServer 41-- > quitServer
42forkListener :: Client err tbl meth tid addr x ctx -> IO (IO ()) 42forkListener :: Client err meth tid addr x ctx -> IO (IO ())
43forkListener client = do 43forkListener client = do
44 thread_id <- forkIO $ do 44 thread_id <- forkIO $ do
45 myThreadId >>= flip labelThread "listener" 45 myThreadId >>= flip labelThread "listener"
@@ -53,11 +53,11 @@ forkListener client = do
53-- dispatch the response. 53-- dispatch the response.
54sendQuery :: 54sendQuery ::
55 forall err a b tbl x ctx meth tid addr. 55 forall err a b tbl x ctx meth tid addr.
56 Client err tbl meth tid addr x ctx -- ^ A query/response implementation. 56 Client err meth tid addr x ctx -- ^ A query/response implementation.
57 -> MethodSerializer addr x ctx meth a b -- ^ Information for marshalling the query. 57 -> MethodSerializer addr x ctx meth a b -- ^ Information for marshalling the query.
58 -> a -- ^ The outbound query. 58 -> a -- ^ The outbound query.
59 -> addr -- ^ Destination address of query. 59 -> addr -- ^ Destination address of query.
60 -> IO (Maybe b) -- ^ The response, or 'Nothing' if it timed out. 60 -> IO (Maybe b) -- ^ The response, or 'Nothing' if it timed out.
61sendQuery (Client net d err pending whoami) meth q addr = do 61sendQuery (Client net d err pending whoami) meth q addr = do
62 mvar <- newEmptyMVar 62 mvar <- newEmptyMVar
63 tid <- atomically $ do 63 tid <- atomically $ do
@@ -78,7 +78,7 @@ sendQuery (Client net d err pending whoami) meth q addr = do
78-- * Implementing a query\/response 'Client'. 78-- * Implementing a query\/response 'Client'.
79 79
80-- | All inputs required to implement a query\/response client. 80-- | All inputs required to implement a query\/response client.
81data Client err tbl meth tid addr x ctx = Client 81data Client err meth tid addr x ctx = forall tbl. Client
82 { -- | The 'Transport' used to dispatch and receive packets. 82 { -- | The 'Transport' used to dispatch and receive packets.
83 clientNet :: Transport err addr x 83 clientNet :: Transport err addr x
84 -- | Methods for handling inbound packets. 84 -- | Methods for handling inbound packets.
@@ -118,11 +118,11 @@ data MethodHandler err tid addr x ctx = forall a b. MethodHandler
118-- parse is successful, the returned IO action will construct our reply. 118-- parse is successful, the returned IO action will construct our reply.
119-- Otherwise, a parse err is returned. 119-- Otherwise, a parse err is returned.
120dispatchQuery :: MethodHandler err tid addr x ctx -- ^ Handler to invoke. 120dispatchQuery :: MethodHandler err tid addr x ctx -- ^ Handler to invoke.
121 -> ctx -- ^ Arbitrary context used during serialization. 121 -> ctx -- ^ Arbitrary context used during serialization.
122 -> tid -- ^ The transaction id for this query\/response session. 122 -> tid -- ^ The transaction id for this query\/response session.
123 -> addr -- ^ Our own address, to which the query was sent. 123 -> addr -- ^ Our own address, to which the query was sent.
124 -> x -- ^ The query packet. 124 -> x -- ^ The query packet.
125 -> addr -- ^ The origin address of the query. 125 -> addr -- ^ The origin address of the query.
126 -> Either err (IO x) 126 -> Either err (IO x)
127dispatchQuery (MethodHandler unwrapQ wrapR f) ctx tid self x addr = 127dispatchQuery (MethodHandler unwrapQ wrapR f) ctx tid self x addr =
128 fmap (\a -> wrapR ctx tid self addr <$> f addr a) $ unwrapQ x 128 fmap (\a -> wrapR ctx tid self addr <$> f addr a) $ unwrapQ x
@@ -269,7 +269,7 @@ data ErrorReporter addr x meth tid err = ErrorReporter
269-- 'fix' in a forked thread that loops until 'awaitMessage' returns 'Nothing' 269-- 'fix' in a forked thread that loops until 'awaitMessage' returns 'Nothing'
270-- or throws an exception. 270-- or throws an exception.
271handleMessage :: 271handleMessage ::
272 Client err tbl meth tid addr x ctx 272 Client err meth tid addr x ctx
273 -> IO () 273 -> IO ()
274 -> IO () 274 -> IO ()
275handleMessage (Client net d err pending whoami) again = do 275handleMessage (Client net d err pending whoami) again = do