@@ -1,9 +1,11 @@
11{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE RecursiveDo #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
34module Main where
45
56import Control.Lens
67import Control.Monad
8+import Control.Monad.Fix
79import Data.These
810
911import Reflex
@@ -24,6 +26,8 @@ main = do
2426 , These () ()
2527 ]
2628 print os2
29+ os3@[[Nothing, Just [2]]] <- runApp' (unwrapApp testMoribundTellEvent) [Just ()]
30+ print os3
2731 return ()
2832
2933unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])
@@ -43,3 +47,19 @@ testSimultaneous pulse = do
4347 forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)
4448 return ()
4549
50+-- | Test that a widget telling and event which fires at the same time it has been replaced
51+-- doesn't count along with the new widget.
52+testMoribundTellEvent
53+ :: forall t m
54+ . ( Reflex t
55+ , Adjustable t m
56+ , MonadHold t m
57+ , MonadFix m
58+ )
59+ => Event t ()
60+ -> EventWriterT t [Int] m ()
61+testMoribundTellEvent pulse = do
62+ rec let tellIntOnReplce :: Int -> EventWriterT t [Int] m ()
63+ tellIntOnReplce x = tellEvent $ [x] <$ rwrFinished
64+ (_, rwrFinished) <- runWithReplace (tellIntOnReplce 1) $ tellIntOnReplce 2 <$ pulse
65+ return ()