Skip to content

Commit

Permalink
produce and verify output in performEvent test
Browse files Browse the repository at this point in the history
  • Loading branch information
JBetz committed Jan 16, 2020
1 parent 94f1d3b commit 6091e55
Showing 1 changed file with 18 additions and 7 deletions.
25 changes: 18 additions & 7 deletions test/RequesterT.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
Expand Down Expand Up @@ -80,6 +81,7 @@ main = do
let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)
let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)
let ![[Nothing,Just "0:1"],[Nothing,Just "1:2"],[Nothing,Just "2:3"]] = os9
return ()

unwrapApp :: forall t m a.
Expand Down Expand Up @@ -241,17 +243,26 @@ testMatchRequestsWithResponses pulse = mdo
, \x -> has @Read r $ readMaybe x
)

-- If a widget is destroyed, and simultaneously it tries to use performEvent, the event shouldn't be performed.
-- If a widget is destroyed, and simultaneously it tries to use performEvent, the event does not get performed.
-- TODO Determine whether this is actually the behavior we want.
testMoribundPerformEvent
:: ( Adjustable t m
:: forall t m
. ( Adjustable t m
, PerformEvent t m
, MonadIO (Performable m)
, MonadHold t m
, Reflex t
)
=> Event t Int -> m (Event t ())
=> Event t Int -> m (Event t String)
testMoribundPerformEvent pulse = do
runWithReplace (performEvent $ liftIO . print <$> pulse) $ ffor pulse $ \i -> do
performEvent $ liftIO . print <$> pulse
pure ()
pure never
(outputInitial, outputReplaced) <- runWithReplace (performPrint 0 pulse) $ ffor pulse $ \i -> performPrint i pulse
switchHold outputInitial outputReplaced
where
performPrint i evt =
let outputEvt = ((show i <> ":") <>) . show <$> evt
in performEvent $ ffor outputEvt $ \output ->
let msg = show i <> ":" <> show output
in return output


deriveArgDict ''TestRequest

0 comments on commit 6091e55

Please sign in to comment.