Skip to content

Commit

Permalink
Fixes for upcoming reflex 0.9.3.0
Browse files Browse the repository at this point in the history
  • Loading branch information
ali-abrar committed Jan 12, 2024
1 parent d6f4dc1 commit 31ff6f7
Showing 1 changed file with 31 additions and 26 deletions.
57 changes: 31 additions & 26 deletions test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,34 +31,40 @@ main = hspec $ do
timeoutWrapperAsync (checkFRPBlocking $ P.proc "cat" []) `shouldReturn` Right (Just Exit)
it "isn't blocked by a downstream blocking process" $ do
timeoutWrapperAsync (checkFRPBlocking $ P.proc "sleep" ["infinity"]) `shouldReturn` Right (Just Exit)
it "sends messages on stdin and receives messages on stdout and stderr" $ runHeadlessApp $ do
let
-- Produces an event when the given message is seen on both stdout and stderr of the given process events
getSawMessage procOut msg = do
let filterMsg = mapMaybe (guard . (== msg))
seen <- foldDyn ($) (False, False) $
mergeWith (.)
[ first (const True) <$ filterMsg (_process_stdout procOut)
, second (const True) <$ filterMsg (_process_stderr procOut)
]
pure $ mapMaybe (guard . (== (True, True))) $ updated seen

rec
procOut <- createProcess (P.proc "tee" ["/dev/stderr"]) $ ProcessConfig send never
aWasSeen <- getSawMessage procOut "a\n"
bWasSeen <- getSawMessage procOut "b\n"
pb <- getPostBuild
it "sends messages on stdin and receives messages on stdout and stderr" $ do
() <- runHeadlessApp $ do
let
send = leftmost
[ SendPipe_Message "a\n" <$ pb
, SendPipe_Message "b\n" <$ aWasSeen
, SendPipe_LastMessage "c\n" <$ bWasSeen
]
-- Produces an event when the given message is seen on both stdout and stderr of the given process events
getSawMessage procOut msg = do
let filterMsg = mapMaybe (guard . (== msg))
seen <- foldDyn ($) (False, False) $
mergeWith (.)
[ first (const True) <$ filterMsg (_process_stdout procOut)
, second (const True) <$ filterMsg (_process_stderr procOut)
]
pure $ mapMaybe (guard . (== (True, True))) $ updated seen

rec
procOut <- createProcess (P.proc "tee" ["/dev/stderr"]) $ ProcessConfig send never
aWasSeen <- getSawMessage procOut "a\n"
bWasSeen <- getSawMessage procOut "b\n"
pb <- getPostBuild
let
send = leftmost
[ SendPipe_Message "a\n" <$ pb
, SendPipe_Message "b\n" <$ aWasSeen
, SendPipe_LastMessage "c\n" <$ bWasSeen
]

getSawMessage procOut "c\n"
getSawMessage procOut "c\n"
pure ()

it "sends signals" $ runHeadlessApp $ void . _process_exit <$> sendSignalTest
it "fires event when signal is sent" $ runHeadlessApp $ void . _process_signal <$> sendSignalTest
it "sends signals" $ do
() <- runHeadlessApp $ void . _process_exit <$> sendSignalTest
pure ()
it "fires event when signal is sent" $ do
() <- runHeadlessApp $ void . _process_signal <$> sendSignalTest
pure ()

where
sendSignalTest :: MonadHeadlessApp t m => m (Process t ByteString ByteString)
Expand All @@ -68,7 +74,6 @@ main = hspec $ do
liftIO $ threadDelay 1000000 *> signalTrigger 15 -- SIGTERM
pure procOut


-- This datatype signals that the FRP network was able to exit on its own.
data Exit = Exit deriving (Show, Eq)

Expand Down

0 comments on commit 31ff6f7

Please sign in to comment.