@@ -31,34 +31,40 @@ main = hspec $ do
31
31
timeoutWrapperAsync (checkFRPBlocking $ P. proc " cat" [] ) `shouldReturn` Right (Just Exit )
32
32
it " isn't blocked by a downstream blocking process" $ do
33
33
timeoutWrapperAsync (checkFRPBlocking $ P. proc " sleep" [" infinity" ]) `shouldReturn` Right (Just Exit )
34
- it " sends messages on stdin and receives messages on stdout and stderr" $ runHeadlessApp $ do
35
- let
36
- -- Produces an event when the given message is seen on both stdout and stderr of the given process events
37
- getSawMessage procOut msg = do
38
- let filterMsg = mapMaybe (guard . (== msg))
39
- seen <- foldDyn ($) (False , False ) $
40
- mergeWith (.)
41
- [ first (const True ) <$ filterMsg (_process_stdout procOut)
42
- , second (const True ) <$ filterMsg (_process_stderr procOut)
43
- ]
44
- pure $ mapMaybe (guard . (== (True , True ))) $ updated seen
45
-
46
- rec
47
- procOut <- createProcess (P. proc " tee" [" /dev/stderr" ]) $ ProcessConfig send never
48
- aWasSeen <- getSawMessage procOut " a\n "
49
- bWasSeen <- getSawMessage procOut " b\n "
50
- pb <- getPostBuild
34
+ it " sends messages on stdin and receives messages on stdout and stderr" $ do
35
+ () <- runHeadlessApp $ do
51
36
let
52
- send = leftmost
53
- [ SendPipe_Message " a\n " <$ pb
54
- , SendPipe_Message " b\n " <$ aWasSeen
55
- , SendPipe_LastMessage " c\n " <$ bWasSeen
56
- ]
37
+ -- Produces an event when the given message is seen on both stdout and stderr of the given process events
38
+ getSawMessage procOut msg = do
39
+ let filterMsg = mapMaybe (guard . (== msg))
40
+ seen <- foldDyn ($) (False , False ) $
41
+ mergeWith (.)
42
+ [ first (const True ) <$ filterMsg (_process_stdout procOut)
43
+ , second (const True ) <$ filterMsg (_process_stderr procOut)
44
+ ]
45
+ pure $ mapMaybe (guard . (== (True , True ))) $ updated seen
46
+
47
+ rec
48
+ procOut <- createProcess (P. proc " tee" [" /dev/stderr" ]) $ ProcessConfig send never
49
+ aWasSeen <- getSawMessage procOut " a\n "
50
+ bWasSeen <- getSawMessage procOut " b\n "
51
+ pb <- getPostBuild
52
+ let
53
+ send = leftmost
54
+ [ SendPipe_Message " a\n " <$ pb
55
+ , SendPipe_Message " b\n " <$ aWasSeen
56
+ , SendPipe_LastMessage " c\n " <$ bWasSeen
57
+ ]
57
58
58
- getSawMessage procOut " c\n "
59
+ getSawMessage procOut " c\n "
60
+ pure ()
59
61
60
- it " sends signals" $ runHeadlessApp $ void . _process_exit <$> sendSignalTest
61
- it " fires event when signal is sent" $ runHeadlessApp $ void . _process_signal <$> sendSignalTest
62
+ it " sends signals" $ do
63
+ () <- runHeadlessApp $ void . _process_exit <$> sendSignalTest
64
+ pure ()
65
+ it " fires event when signal is sent" $ do
66
+ () <- runHeadlessApp $ void . _process_signal <$> sendSignalTest
67
+ pure ()
62
68
63
69
where
64
70
sendSignalTest :: MonadHeadlessApp t m => m (Process t ByteString ByteString )
@@ -68,7 +74,6 @@ main = hspec $ do
68
74
liftIO $ threadDelay 1000000 *> signalTrigger 15 -- SIGTERM
69
75
pure procOut
70
76
71
-
72
77
-- This datatype signals that the FRP network was able to exit on its own.
73
78
data Exit = Exit deriving (Show , Eq )
74
79
0 commit comments