@@ -14,7 +14,6 @@
1414{-# LANGUAGE RecursiveDo #-}
1515{-# LANGUAGE ScopedTypeVariables #-}
1616{-# LANGUAGE StandaloneDeriving #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1817{-# LANGUAGE TemplateHaskell #-}
1918{-# LANGUAGE TypeApplications #-}
2019{-# LANGUAGE TypeFamilies #-}
@@ -31,12 +30,14 @@ import Data.Constraint.Forall
3130import qualified Data.Dependent.Map as DMap
3231import Data.Dependent.Sum
3332import Data.Functor.Misc
33+import Data.List (words)
3434import Data.Map (Map)
3535import qualified Data.Map as M
3636import Data.Some (Some (Some))
3737import Data.Text (Text)
3838import Data.These
3939import Text.Read (readMaybe)
40+import Control.Monad.Trans.Class (lift)
4041
4142#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
4243import Data.These.Lens
@@ -73,14 +74,18 @@ main = do
7374 print os5
7475 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
7576 print os6
76− os7 <- runApp' testMatchRequestsWithResponses $ map (Just . Identity) [ "hey" ]
77+ os7 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Increment 1 ]
7778 print os7
79+ os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "yoyo" ]
80+ print os8
7881 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
7982 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
8083 let ![[Nothing, Just [2]]] = os3
8184 let ![[Nothing, Just [2]]] = os4
8285 let ![[Nothing, Just [1, 2]]] = os5
8386 -- 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)
8489
8590 return ()
8691
@@ -200,48 +205,40 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
200205 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
201206 requestingIdentity pulse'
202207
203−{--
204−
205−
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
216−
217−Matches incoming responses with previously-sent requests and uses the provided request "decoder" function to process incoming responses.
218−
219−--}
208+data TestRequest a where
209+ TestRequest_Reverse :: String -> TestRequest String
210+ TestRequest_Increment :: Int -> TestRequest Int
220211
221212testMatchRequestsWithResponses
222− :: forall m t request a
213+ :: forall m t req a
223214 . ( MonadFix m
224215 , MonadHold t m
225216 , Reflex t
226217 , PerformEvent t m
227− , TriggerEvent t m
228218 , MonadIO (Performable m)
229− , ForallF Show Identity
230− , Has Read Identity
219+ , ForallF Show req
220+ , Has Read req
231221 )
232− => Event t (Identity Text) -> m (Event t ())
222+ => Event t (req a) -> m (Event t (Map Int String))
233223testMatchRequestsWithResponses pulse = mdo
234224 (_, requests) <- runRequesterT (requesting pulse) responses
235− let rawResponses = rawRequestMap
225+ let rawResponses = M.map (\v ->
226+ case words v of
227+ ["reverse", str] -> reverse str
228+ ["increment", i] -> show $ succ $ (read i :: Int)
229+ ) <$> rawRequestMap
236230 (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)
237− pure never
231+ pure rawResponses
238232 where
239− reqEncoder :: forall a. Identity a -> (String, String -> Maybe a)
233+ reqEncoder :: forall a. req a -> (String, String -> Maybe a)
240234 reqEncoder r =
241− ( whichever @Show @Identity @a $ show r
235+ ( whichever @Show @req @a $ show r
242236 , \x -> has @Read r $ readMaybe x
243237 )
244238
239+deriveArgDict ''TestRequest
245240
246−deriving instance TriggerEvent (SpiderTimeline Global) (PerformEventT (SpiderTimeline Global) (SpiderHost Global))
247−
241+instance Show (TestRequest a) where
242+ show = \case
243+ TestRequest_Reverse str -> "reverse " <> str
244+ TestRequest_Increment i -> "increment " <> show i