diff options
Diffstat (limited to 'src/Network/QueryResponse.hs')
-rw-r--r-- | src/Network/QueryResponse.hs | 26 |
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 |
42 | forkListener :: Client err tbl meth tid addr x ctx -> IO (IO ()) | 42 | forkListener :: Client err meth tid addr x ctx -> IO (IO ()) |
43 | forkListener client = do | 43 | forkListener 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. |
54 | sendQuery :: | 54 | sendQuery :: |
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. |
61 | sendQuery (Client net d err pending whoami) meth q addr = do | 61 | sendQuery (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. |
81 | data Client err tbl meth tid addr x ctx = Client | 81 | data 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. |
120 | dispatchQuery :: MethodHandler err tid addr x ctx -- ^ Handler to invoke. | 120 | dispatchQuery :: 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) |
127 | dispatchQuery (MethodHandler unwrapQ wrapR f) ctx tid self x addr = | 127 | dispatchQuery (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. |
271 | handleMessage :: | 271 | handleMessage :: |
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 () |
275 | handleMessage (Client net d err pending whoami) again = do | 275 | handleMessage (Client net d err pending whoami) again = do |