WIP test case for performEvent

Author: JBetz

test/RequesterT.hs

@@ -70,6 +70,8 @@ main = do
   print os7
   os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "abcd" ]
   print os8
+  os9 <- runApp' testMoribundPerformEvent $ map Just [ 1 .. 3 ]
+  print os9
   let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
   let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
   let ![[Nothing, Just [2]]] = os3
@@ -203,6 +205,11 @@ data TestRequest a where
   TestRequest_Reverse :: String -> TestRequest String
   TestRequest_Increment :: Int -> TestRequest Int
 
+instance Show (TestRequest a) where
+  show = \case
+    TestRequest_Reverse str -> "reverse " <> str
+    TestRequest_Increment i -> "increment " <> show i
+
 testMatchRequestsWithResponses
   :: forall m t req a
    . ( MonadFix m
@@ -234,9 +241,17 @@ testMatchRequestsWithResponses pulse = mdo
       , \x -> has @Read r $ readMaybe x
       )
 
-deriveArgDict ''TestRequest
+-- If a widget is destroyed, and simultaneously it tries to use performEvent, the event shouldn't be performed.
+testMoribundPerformEvent
+  :: ( Adjustable t m
+     , PerformEvent t m
+     , MonadIO (Performable m)
+     )
+  => Event t Int -> m (Event t ())
+testMoribundPerformEvent pulse = do
+  runWithReplace (performEvent $ liftIO . print <$> pulse) $ ffor pulse $ \i -> do
+    performEvent $ liftIO . print <$> pulse
+    pure ()
+  pure never
 
-instance Show (TestRequest a) where
-  show = \case
-    TestRequest_Reverse str -> "reverse " <> str
-    TestRequest_Increment i -> "increment " <> show i
+deriveArgDict ''TestRequest