git.iko.soy/reflex
on develop help sign in
WIP
e5b8423Joe Betz
test/RequesterT.hs+74−1
compare with develop
unifiedsplit
@@ -1,20 +1,42 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE ConstraintKinds #-}
4+{-# LANGUAGE DeriveAnyClass #-}
5+{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
7+{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GADTs #-}
8{-# LANGUAGE GADTs #-}
9+{-# LANGUAGE LambdaCase #-}
10+{-# LANGUAGE MultiParamTypeClasses #-}
11+{-# LANGUAGE OverloadedStrings #-}
12+{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE RecursiveDo #-}
14{-# LANGUAGE RecursiveDo #-}
7{-# LANGUAGE ScopedTypeVariables #-}
15{-# LANGUAGE ScopedTypeVariables #-}
16+{-# LANGUAGE StandaloneDeriving #-}
17+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# LANGUAGE TypeApplications #-}
20+{-# LANGUAGE TypeFamilies #-}
8module Main where
21module Main where
9
22
10−import Control.Lens
23+import Control.Lens hiding (has)
11import Control.Monad
24import Control.Monad
12import Control.Monad.Fix
25import Control.Monad.Fix
26+import Control.Monad.IO.Class (MonadIO)
27+import Data.Aeson (Value, FromJSON (..), ToJSON, Result(..), toJSON, fromJSON)
28+import Data.Constraint.Extras
29+import Data.Constraint.Extras.TH
30+import Data.Constraint.Forall
13import qualified Data.Dependent.Map as DMap
31import qualified Data.Dependent.Map as DMap
14import Data.Dependent.Sum
32import Data.Dependent.Sum
15import Data.Functor.Misc
33import Data.Functor.Misc
34+import Data.Map (Map)
16import qualified Data.Map as M
35import qualified Data.Map as M
36+import Data.Some (Some (Some))
37+import Data.Text (Text)
17import Data.These
38import Data.These
39+import Text.Read (readMaybe)
18
40
19#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
41#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
20import Data.These.Lens
42import Data.These.Lens
@@ -25,6 +47,8 @@ import Reflex.Requester.Base
25import Reflex.Requester.Class
47import Reflex.Requester.Class
26import Test.Run
48import Test.Run
27
49
50+import GHC.Generics
51+
28data RequestInt a where
52data RequestInt a where
29 RequestInt :: Int -> RequestInt Int
53 RequestInt :: Int -> RequestInt Int
30
54
@@ -49,12 +73,15 @@ main = do
49 print os5
73 print os5
50 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
74 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
51 print os6
75 print os6
76+ os7 <- runApp' testMatchRequestsWithResponses $ map (Just . Identity) [ "hey" ]
77+ print os7
52 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
78 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'
53 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
79 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2
54 let ![[Nothing, Just [2]]] = os3
80 let ![[Nothing, Just [2]]] = os3
55 let ![[Nothing, Just [2]]] = os4
81 let ![[Nothing, Just [2]]] = os4
56 let ![[Nothing, Just [1, 2]]] = os5
82 let ![[Nothing, Just [1, 2]]] = os5
57 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
83 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
84+
58 return ()
85 return ()
59
86
60unwrapRequest :: DSum tag RequestInt -> Int
87unwrapRequest :: DSum tag RequestInt -> Int
@@ -172,3 +199,49 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
172 -- This has the effect of delaying pulse' from pulse
199 -- This has the effect of delaying pulse' from pulse
173 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
200 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
174 requestingIdentity pulse'
201 requestingIdentity pulse'
202+
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+--}
220+
221+testMatchRequestsWithResponses
222+ :: forall m t request a
223+ . ( MonadFix m
224+ , MonadHold t m
225+ , Reflex t
226+ , PerformEvent t m
227+ , TriggerEvent t m
228+ , MonadIO (Performable m)
229+ , ForallF Show Identity
230+ , Has Read Identity
231+ )
232+ => Event t (Identity Text) -> m (Event t ())
233+testMatchRequestsWithResponses pulse = mdo
234+ (_, requests) <- runRequesterT (requesting pulse) responses
235+ let rawResponses = rawRequestMap
236+ (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)
237+ pure never
238+ where
239+ reqEncoder :: forall a. Identity a -> (String, String -> Maybe a)
240+ reqEncoder r =
241+ ( whichever @Show @Identity @a $ show r
242+ , \x -> has @Read r $ readMaybe x
243+ )
244+
245+
246+deriving instance TriggerEvent (SpiderTimeline Global) (PerformEventT (SpiderTimeline Global) (SpiderHost Global))
247+