git.iko.soy/reflex
on develop help sign in
test case for performEvent
bcf920cJoe Betz
test/RequesterT.hs+28−6
compare with develop
unifiedsplit
@@ -17,7 +17,7 @@ import Control.Lens hiding (has)
17import Control.Monad
17import Control.Monad
18import Control.Monad.Fail (MonadFail)
18import Control.Monad.Fail (MonadFail)
19import Control.Monad.Fix
19import Control.Monad.Fix
20−import Control.Monad.IO.Class (MonadIO, liftIO)
20+import Control.Monad.IO.Class (MonadIO)
21import Control.Monad.Primitive
21import Control.Monad.Primitive
22import Data.Constraint.Extras
22import Data.Constraint.Extras
23import Data.Constraint.Extras.TH
23import Data.Constraint.Extras.TH
@@ -70,6 +70,8 @@ main = do
70 print os7
70 print os7
71 os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "abcd" ]
71 os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "abcd" ]
72 print os8
72 print os8
73+ os9 <- runApp' testMoribundPerformEvent $ map Just [ 1 .. 3 ]
74+ print os9
73 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
75 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
74 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
76 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
75 let ![[Nothing, Just [2]]] = os3
77 let ![[Nothing, Just [2]]] = os3
@@ -78,6 +80,7 @@ main = do
78 let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
80 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)
81 let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)
80 let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)
82 let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)
83+ let ![[Nothing,Just "0:1"],[Nothing,Just "1:2"],[Nothing,Just "2:3"]] = os9
81 return ()
84 return ()
82
85
83unwrapApp :: forall t m a.
86unwrapApp :: forall t m a.
@@ -203,6 +206,11 @@ data TestRequest a where
203 TestRequest_Reverse :: String -> TestRequest String
206 TestRequest_Reverse :: String -> TestRequest String
204 TestRequest_Increment :: Int -> TestRequest Int
207 TestRequest_Increment :: Int -> TestRequest Int
205
208
209+instance Show (TestRequest a) where
210+ show = \case
211+ TestRequest_Reverse str -> "reverse " <> str
212+ TestRequest_Increment i -> "increment " <> show i
213+
206testMatchRequestsWithResponses
214testMatchRequestsWithResponses
207 :: forall m t req a
215 :: forall m t req a
208 . ( MonadFix m
216 . ( MonadFix m
@@ -234,9 +242,23 @@ testMatchRequestsWithResponses pulse = mdo
234 , \x -> has @Read r $ readMaybe x
242 , \x -> has @Read r $ readMaybe x
235 )
243 )
236
244
237−deriveArgDict ''TestRequest
245+-- If a widget is destroyed, and simultaneously it tries to use performEvent, the event does not get performed.
246+-- TODO Determine whether this is actually the behavior we want.
247+testMoribundPerformEvent
248+ :: forall t m
249+ . ( Adjustable t m
250+ , PerformEvent t m
251+ , MonadHold t m
252+ , Reflex t
253+ )
254+ => Event t Int -> m (Event t String)
255+testMoribundPerformEvent pulse = do
256+ (outputInitial, outputReplaced) <- runWithReplace (performPrint 0 pulse) $ ffor pulse $ \i -> performPrint i pulse
257+ switchHold outputInitial outputReplaced
258+ where
259+ performPrint i evt =
260+ performEvent $ ffor evt $ \output ->
261+ return $ show i <> ":" <> show output
238
262
263+
239−instance Show (TestRequest a) where
264+deriveArgDict ''TestRequest
240− show = \case
241− TestRequest_Reverse str -> "reverse " <> str
242− TestRequest_Increment i -> "increment " <> show i