@@ -2,76 +2,131 @@ module Test.Main where
22
33import Prelude
44
5- import Data.Either (hush )
5+ import Data.Either (Either (..), hush )
66import Data.Maybe (Maybe (..))
77import Data.Posix.Signal (Signal (..))
88import Data.Posix.Signal as Signal
99import Effect (Effect )
10- import Effect.Console (log )
10+ import Effect.Aff (Aff , effectCanceler , launchAff_ , makeAff , nonCanceler )
11+ import Effect.Class (liftEffect )
12+ import Effect.Class.Console (log )
13+ import Effect.Exception (throw , throwException )
1114import Node.Buffer as Buffer
12- import Node.ChildProcess (errorH , exec' , execSync' , exitH , kill , spawn , stdout )
15+ import Node.ChildProcess (exec' , execSync' , kill , spawn , stdin )
16+ import Node.ChildProcess as CP
17+ import Node.ChildProcess.Aff (waitSpawned )
1318import Node.ChildProcess.Types (Exit (..), fromKillSignal )
1419import Node.Encoding (Encoding (..))
1520import Node.Encoding as NE
16- import Node.Errors.SystemError ( code )
17- import Node.EventEmitter ( on_ )
18- import Node.Stream ( dataH )
21+ import Node.EventEmitter ( EventHandle , once , once_ )
22+ import Node.Stream as Stream
23+ import Unsafe.Coerce ( unsafeCoerce )
1924
2025main :: Effect Unit
21- main = do
22- log " spawns processes ok "
26+ main = launchAff_ do
27+ writingToStdinWorks
2328 spawnLs
29+ nonExistentExecutable
30+ noEffectsTooEarly
31+ killsProcess
32+ execLs
33+ execSyncEcho " some value"
2434
25- log " emits an error if executable does not exist"
26- nonExistentExecutable $ do
27- log " nonexistent executable: all good."
35+ until
36+ :: forall emitter psCb jsCb a
37+ . emitter
38+ -> EventHandle emitter psCb jsCb
39+ -> ((a -> Effect Unit ) -> psCb )
40+ -> Aff a
41+ until ee event cb = makeAff \done -> do
42+ rm <- ee # once event (cb (done <<< Right ))
43+ pure $ effectCanceler rm
2844
29- log " doesn't perform effects too early"
30- spawn " ls" " -la" -> do
31- let _ = kill ls
32- ls # on_ exitH \exit ->
33- case exit of
34- Normally 0 ->
35- log " All good!"
36- _ -> do
37- log (" Bad exit: expected `Normally 0`, got: "
45+ writingToStdinWorks :: Aff Unit
46+ writingToStdinWorks = do
47+ log " \n writing to stdin works"
48+ sp <- liftEffect $ spawn " sh" " ./test/sleep.sh"
49+ liftEffect do
50+ (stdin sp) # once_ Stream .errorH \err -> do
51+ log " Error in stdin"
52+ throwException $ unsafeCoerce err
53+ buf <- Buffer .fromString " helllo" UTF8
54+ void $ Stream .write (stdin sp) buf
55+ sp # once_ CP .errorH \err -> do
56+ log " Error in child process"
57+ throwException $ unsafeCoerce err
58+ exit <- until sp CP .closeH \completeAff -> \exit ->
59+ completeAff exit
60+ log $ " spawn sleep done "
3861
39- log " kills processes"
40- spawn " ls" " -la" -> do
41- _ <- kill ls
42- ls # on_ exitH \exit ->
43- case exit of
44- BySignal s | Just SIGTERM <- Signal .fromString =<< (hush $ fromKillSignal s) ->
45- log " All good!"
46- _ -> do
47- log (" Bad exit: expected `BySignal SIGTERM`, got: "
62+ spawnLs :: Aff Unit
63+ spawnLs = do
64+ log " \n spawns processes ok"
65+ ls <- liftEffect $ spawn " ls" " -la"
66+ res <- waitSpawned ls
67+ case res of
68+ Right pid -> log $ " ls successfully spawned with PID: "
69+ Left err -> liftEffect $ throwException $ unsafeCoerce err
70+ exit <- until ls CP .closeH \complete -> \exit -> complete exit
71+ case exit of
72+ Normally 0 -> log $ " ls exited with 0"
73+ Normally i -> liftEffect $ throw $ " ls had non-zero exit: "
74+ BySignal sig -> liftEffect $ throw $ " ls exited with sig: "
4875
49- log " exec"
50- execLs
76+ nonExistentExecutable :: Aff Unit
77+ nonExistentExecutable = do
78+ log " \n emits an error if executable does not exist"
79+ ch <- liftEffect $ spawn " this-does-not-exist" []
80+ res <- waitSpawned ch
81+ case res of
82+ Left _ -> log " nonexistent executable: all good."
83+ Right pid -> liftEffect $ throw $ " nonexistent executable started with PID: "
5184
52- spawnLs :: Effect Unit
53- spawnLs = do
54- ls <- spawn " ls" " -la"
55- ls # on_ exitH \exit ->
56- log $ " ls exited: "
57- (stdout ls) # on_ dataH (Buffer .toString UTF8 >=> log)
85+ noEffectsTooEarly :: Aff Unit
86+ noEffectsTooEarly = do
87+ log " \n doesn't perform effects too early"
88+ ls <- liftEffect $ spawn " ls" " -la"
89+ let _ = kill ls
90+ exit <- until ls CP .exitH \complete -> \exit -> complete exit
91+ case exit of
92+ Normally 0 ->
93+ log " All good!"
94+ _ ->
95+ liftEffect $ throw $ " Bad exit: expected `Normally 0`, got: "
5896
59- nonExistentExecutable :: Effect Unit -> Effect Unit
60- nonExistentExecutable done = do
61- ch <- spawn " this-does-not-exist" []
62- ch # on_ errorH \err ->
63- log (code err) *> done
97+ killsProcess :: Aff Unit
98+ killsProcess = do
99+ log " \n kills processes"
100+ ls <- liftEffect $ spawn " ls" " -la"
101+ _ <- liftEffect $ kill ls
102+ exit <- until ls CP .exitH \complete -> \exit -> complete exit
103+ case exit of
104+ BySignal s | Just SIGTERM <- Signal .fromString =<< (hush $ fromKillSignal s) ->
105+ log " All good!"
106+ _ -> do
107+ liftEffect $ throw $ " Bad exit: expected `BySignal SIGTERM`, got: "
64108
65- execLs :: Effect Unit
109+ execLs :: Aff Unit
66110execLs = do
67- -- returned ChildProcess is ignored here
68- _ <- exec' " ls >&2" ->
69- log " redirected to stderr:" Buffer .toString UTF8 r.stderr >>= log)
70- pure unit
111+ log " \n exec"
112+ r <- makeAff \done -> do
113+ -- returned ChildProcess is ignored here
114+ void $ exec' " ls >&2" Right )
115+ pure nonCanceler
116+ stdout' <- liftEffect $ Buffer .toString UTF8 r.stdout
117+ stderr' <- liftEffect $ Buffer .toString UTF8 r.stderr
118+ when (stdout' /= " " do
119+ liftEffect $ throw $ " stdout should be redirected to stderr but had content: "
120+ when (stderr' == " " do
121+ liftEffect $ throw $ " stderr should have content but was empty"
122+ log " stdout was successfully redirected to stderr"
71123
72- execSyncEcho :: String -> Effect Unit
73- execSyncEcho str = do
124+ execSyncEcho :: String -> Aff Unit
125+ execSyncEcho str = liftEffect do
126+ log " \n execSyncEcho"
74127 buf <- Buffer .fromString str UTF8
75128 resBuf <- execSync' " cat" Just buf })
76129 res <- Buffer .toString NE.UTF8 resBuf
77- log res
130+ when (str /= res) do
131+ throw $ " cat did not output its input. \n Got: " " \n Expected: "
132+ log " cat successfully re-outputted its input"
0 commit comments