git.iko.soy/reflex
on develop help sign in
add tests for matchResponsesWithRequests
d9f7decJoe Betz
test/RequesterT.hs+65−2
compare with develop
unifiedsplit
@@ -1,22 +1,35 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE LambdaCase #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE RecursiveDo #-}
9{-# LANGUAGE RecursiveDo #-}
7{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE TemplateHaskell #-}
12+{-# LANGUAGE TypeApplications #-}
13+{-# LANGUAGE TypeFamilies #-}
8module Main where
14module Main where
9
15
10−import Control.Lens
16+import Control.Lens hiding (has)
11import Control.Monad
17import Control.Monad
18+import Control.Monad.Fail (MonadFail)
12import Control.Monad.Fix
19import Control.Monad.Fix
20+import Control.Monad.IO.Class (MonadIO, liftIO)
13import Control.Monad.Primitive
21import Control.Monad.Primitive
22+import Data.Constraint.Extras
23+import Data.Constraint.Extras.TH
24+import Data.Constraint.Forall
14import qualified Data.Dependent.Map as DMap
25import qualified Data.Dependent.Map as DMap
15import Data.Dependent.Sum
26import Data.Dependent.Sum
16import Data.Functor.Misc
27import Data.Functor.Misc
28+import Data.Map (Map)
17import qualified Data.Map as M
29import qualified Data.Map as M
18import Data.These
30import Data.These
19import Data.List.NonEmpty.Deferred
31import Data.List.NonEmpty.Deferred
32+import Text.Read (readMaybe)
20
33
21#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
34#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
22import Data.These.Lens
35import Data.These.Lens
@@ -27,6 +40,8 @@ import Reflex.Requester.Base
27import Reflex.Requester.Class
40import Reflex.Requester.Class
28import Test.Run
41import Test.Run
29
42
43+import Debug.Trace hiding (traceEvent)
44+
30data RequestInt a where
45data RequestInt a where
31 RequestInt :: Int -> RequestInt Int
46 RequestInt :: Int -> RequestInt Int
32
47
@@ -35,7 +50,7 @@ main = do
35 os1 <- runApp' (unwrapApp testOrdering) $
50 os1 <- runApp' (unwrapApp testOrdering) $
36 [ Just ()
51 [ Just ()
37 ]
52 ]
38− print os1
53+ --print os1
39 os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
54 os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
40 [ This ()
55 [ This ()
41 , That ()
56 , That ()
@@ -51,12 +66,18 @@ main = do
51 print os5
66 print os5
52 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
67 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
53 print os6
68 print os6
69+ os7 <- runApp' testMatchRequestsWithResponses $ map Just [ TestRequest_Increment 1, TestRequest_Increment 2 ]
70+ print os7
71+ os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "abcd" ]
72+ print os8
54 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
73 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
55 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
74 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
56 let ![[Nothing, Just [2]]] = os3
75 let ![[Nothing, Just [2]]] = os3
57 let ![[Nothing, Just [2]]] = os4
76 let ![[Nothing, Just [2]]] = os4
58 let ![[Nothing, Just [1, 2]]] = os5
77 let ![[Nothing, Just [1, 2]]] = os5
59 let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
78 let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
79+ let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)
80+ let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)
60 return ()
81 return ()
61
82
62unwrapApp :: forall t m a.
83unwrapApp :: forall t m a.
@@ -177,3 +198,45 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
177 -- This has the effect of delaying pulse' from pulse
198 -- This has the effect of delaying pulse' from pulse
178 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
199 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
179 requestingIdentity pulse'
200 requestingIdentity pulse'
201+
202+data TestRequest a where
203+ TestRequest_Reverse :: String -> TestRequest String
204+ TestRequest_Increment :: Int -> TestRequest Int
205+
206+testMatchRequestsWithResponses
207+ :: forall m t req a
208+ . ( MonadFix m
209+ , MonadHold t m
210+ , Reflex t
211+ , PerformEvent t m
212+ , MonadIO (Performable m)
213+ , ForallF Show req
214+ , Has Read req
215+ , PrimMonad m
216+ , Show (req a)
217+ , Show a
218+ , MonadIO m
219+ )
220+ => Event t (req a) -> m (Event t (Map Int String))
221+testMatchRequestsWithResponses pulse = mdo
222+ (_, requests) <- runRequesterT (requesting pulse) responses
223+ let rawResponseMap = M.map (\v ->
224+ case words v of
225+ ["reverse", str] -> reverse str
226+ ["increment", i] -> show $ succ $ (read i :: Int)
227+ ) <$> rawRequestMap
228+ (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponseMap)
229+ pure rawResponseMap
230+ where
231+ reqEncoder :: forall a. req a -> (String, String -> Maybe a)
232+ reqEncoder r =
233+ ( whichever @Show @req @a $ show r
234+ , \x -> has @Read r $ readMaybe x
235+ )
236+
237+deriveArgDict ''TestRequest
238+
239+instance Show (TestRequest a) where
240+ show = \case
241+ TestRequest_Reverse str -> "reverse " <> str
242+ TestRequest_Increment i -> "increment " <> show i