@@ -14,7 +14,6 @@
14{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RecursiveDo #-}
15{-# LANGUAGE ScopedTypeVariables #-}
15{-# LANGUAGE ScopedTypeVariables #-}
16{-# LANGUAGE StandaloneDeriving #-}
16{-# LANGUAGE StandaloneDeriving #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18{-# LANGUAGE TemplateHaskell #-}
17{-# LANGUAGE TemplateHaskell #-}
19{-# LANGUAGE TypeApplications #-}
18{-# LANGUAGE TypeApplications #-}
20{-# LANGUAGE TypeFamilies #-}
19{-# LANGUAGE TypeFamilies #-}
@@ -31,12 +30,14 @@ import Data.Constraint.Forall
31import qualified Data.Dependent.Map as DMap
30import qualified Data.Dependent.Map as DMap
32import Data.Dependent.Sum
31import Data.Dependent.Sum
33import Data.Functor.Misc
32import Data.Functor.Misc
33+import Data.List (words)
34import Data.Map (Map)
34import Data.Map (Map)
35import qualified Data.Map as M
35import qualified Data.Map as M
36import Data.Some (Some (Some))
36import Data.Some (Some (Some))
37import Data.Text (Text)
37import Data.Text (Text)
38import Data.These
38import Data.These
39import Text.Read (readMaybe)
39import Text.Read (readMaybe)
40+import Control.Monad.Trans.Class (lift)
41#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
42#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
42import Data.These.Lens
43import Data.These.Lens
@@ -73,14 +74,18 @@ main = do
74 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
75 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
76− os7 <- runApp' testMatchRequestsWithResponses $ map (Just . Identity) [ "hey" ]
77+ os7 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Increment 1 ]
79+ os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "yoyo" ]
78 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
81 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
79 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
82 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
80 let ![[Nothing, Just [2]]] = os3
83 let ![[Nothing, Just [2]]] = os3
81 let ![[Nothing, Just [2]]] = os4
84 let ![[Nothing, Just [2]]] = os4
82 let ![[Nothing, Just [1, 2]]] = os5
85 let ![[Nothing, Just [1, 2]]] = os5
83 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
86 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
87+ let !(Just [(1,"2")]) = M.toList <$> head (head os7)
88+ let !(Just [(1,"oyoy")]) = M.toList <$> head (head os8)
@@ -200,48 +205,40 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
200 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
205 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
201 requestingIdentity pulse'
206 requestingIdentity pulse'
203−{--
208+data TestRequest a where
204−
209+ TestRequest_Reverse :: String -> TestRequest String
205−
210+ TestRequest_Increment :: Int -> TestRequest Int
206−matchResponsesWithRequestsSource#
207− :: (MonadFix m, MonadHold t m, Reflex t)
208− => (forall a. request a -> (rawRequest, rawResponse -> response a))
209− Given a request (from Requester), produces the wire format of the request and a function used to process the associated response
210− -> Event t (RequesterData request)
211− The outgoing requests
212− -> Event t (Int, rawResponse)
213− The incoming responses, tagged by an identifying key
214− -> m (Event t (Map Int rawRequest), Event t (RequesterData response))
215− A map of outgoing wire-format requests and an event of responses keyed by the RequesterData key of the associated outgoing request
217−Matches incoming responses with previously-sent requests and uses the provided request "decoder" function to process incoming responses.
221testMatchRequestsWithResponses
212testMatchRequestsWithResponses
222− :: forall m t request a
213+ :: forall m t req a
223 . ( MonadFix m
214 . ( MonadFix m
224 , MonadHold t m
215 , MonadHold t m
225 , Reflex t
216 , Reflex t
226 , PerformEvent t m
217 , PerformEvent t m
228 , MonadIO (Performable m)
218 , MonadIO (Performable m)
229− , ForallF Show Identity
219+ , ForallF Show req
230− , Has Read Identity
220+ , Has Read req
232− => Event t (Identity Text) -> m (Event t ())
222+ => Event t (req a) -> m (Event t (Map Int String))
233testMatchRequestsWithResponses pulse = mdo
223testMatchRequestsWithResponses pulse = mdo
234 (_, requests) <- runRequesterT (requesting pulse) responses
224 (_, requests) <- runRequesterT (requesting pulse) responses
225+ let rawResponses = M.map (\v ->
227+ ["reverse", str] -> reverse str
228+ ["increment", i] -> show $ succ $ (read i :: Int)
235− let rawResponses = rawRequestMap
229+ ) <$> rawRequestMap
236 (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)
230 (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)
237− pure never
231+ pure rawResponses
239− reqEncoder :: forall a. Identity a -> (String, String -> Maybe a)
233+ reqEncoder :: forall a. req a -> (String, String -> Maybe a)
240 reqEncoder r =
234 reqEncoder r =
241− ( whichever @Show @Identity @a $ show r
235+ ( whichever @Show @req @a $ show r
242 , \x -> has @Read r $ readMaybe x
236 , \x -> has @Read r $ readMaybe x
239+deriveArgDict ''TestRequest
246−deriving instance TriggerEvent (SpiderTimeline Global) (PerformEventT (SpiderTimeline Global) (SpiderHost Global))
241+instance Show (TestRequest a) where
243+ TestRequest_Reverse str -> "reverse " <> str
244+ TestRequest_Increment i -> "increment " <> show i