git.iko.soy/patch
on develop help sign in
Add tests showing RequesterT/EventWriterT inconsistency
baadc4cTom Smalley
test/EventWriterT.hs+18
compare with develop
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE GADTs #-}
3{-# LANGUAGE RecursiveDo #-}
4{-# LANGUAGE RecursiveDo #-}
@@ -36,6 +37,9 @@ main = do
36 print os4
37 print os4
37 os5@[[Nothing, Just [1, 2]]] <- runApp' (unwrapApp testLiveTellEventDMap) [Just ()]
38 os5@[[Nothing, Just [1, 2]]] <- runApp' (unwrapApp testLiveTellEventDMap) [Just ()]
38 print os5
39 print os5
40+ os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
41+ print os6
42+ let ![[Nothing, Nothing]] = os6
39 return ()
43 return ()
40
44
41unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])
45unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])
@@ -112,3 +116,17 @@ testLiveTellEventDMap pulse = do
112 (mapToDMap $ M.singleton 1 ())
116 (mapToDMap $ M.singleton 1 ())
113 ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton 2 ()) <$ pulse)
117 ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton 2 ()) <$ pulse)
114 return ()
118 return ()
119+
120+delayedPulse
121+ :: forall t m
122+ . ( Reflex t
123+ , Adjustable t m
124+ , MonadHold t m
125+ , MonadFix m
126+ )
127+ => Event t ()
128+ -> EventWriterT t [Int] m ()
129+delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
130+ -- This has the effect of delaying pulse' from pulse
131+ (_, pulse') <- runWithReplace (pure ()) $ pure [1] <$ pulse
132+ tellEvent pulse'
test/RequesterT.hs+21
@@ -42,11 +42,14 @@ main = do
42 print os4
42 print os4
43 os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
43 os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
44 print os5
44 print os5
45+ os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
46+ print os6
45 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
47 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
46 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
48 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
47 let ![[Nothing, Just [2]]] = os3
49 let ![[Nothing, Just [2]]] = os3
48 let ![[Nothing, Just [2]]] = os4
50 let ![[Nothing, Just [2]]] = os4
49 let ![[Nothing, Just [1, 2]]] = os5
51 let ![[Nothing, Just [1, 2]]] = os5
52+ let ![[Nothing, Nothing]] = os6
50 return ()
53 return ()
51
54
52unwrapRequest :: DSum tag RequestInt -> Int
55unwrapRequest :: DSum tag RequestInt -> Int
@@ -146,3 +149,21 @@ testLiveRequestDMap pulse = do
146 (mapToDMap $ M.singleton 1 ())
149 (mapToDMap $ M.singleton 1 ())
147 ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton 2 ()) <$ pulse)
150 ((PatchDMap $ DMap.map (ComposeMaybe . Just) $ mapToDMap $ M.singleton 2 ()) <$ pulse)
148 return ()
151 return ()
152+
153+delayedPulse
154+ :: forall t m
155+ . ( Reflex t
156+ , Adjustable t m
157+ , MonadHold t m
158+ , MonadFix m
159+ , Response m ~ Identity
160+ , Request m ~ RequestInt
161+ , PerformEvent t m
162+ , Requester t m
163+ )
164+ => Event t ()
165+ -> m ()
166+delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
167+ -- This has the effect of delaying pulse' from pulse
168+ (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse
169+ requestingIdentity pulse'