|
@@ -2,14 +2,23 @@ module Main where
|
|
|
|
|
|
|
|
import Prelude
|
|
import Prelude
|
|
|
|
|
|
|
|
|
|
+import Data.Either (Either(..))
|
|
|
import Data.Maybe (Maybe(..))
|
|
import Data.Maybe (Maybe(..))
|
|
|
import Effect (Effect)
|
|
import Effect (Effect)
|
|
|
-import Effect.Class.Console (log)
|
|
|
|
|
|
|
+import Effect.Aff (Aff, effectCanceler, launchAff_, makeAff)
|
|
|
|
|
+import Effect.Class (liftEffect)
|
|
|
|
|
+import Effect.Class.Console (log, logShow)
|
|
|
|
|
+import Effect.Exception (throw, throwException)
|
|
|
import Node.Buffer (toString)
|
|
import Node.Buffer (toString)
|
|
|
-import Node.ChildProcess (ExecResult)
|
|
|
|
|
|
|
+import Node.ChildProcess (ExecResult, connected, exitCode, spawn, stdout)
|
|
|
import Node.ChildProcess as ChildProcess
|
|
import Node.ChildProcess as ChildProcess
|
|
|
|
|
+import Node.ChildProcess.Aff (waitSpawned)
|
|
|
|
|
+import Node.ChildProcess.Types (Exit(..))
|
|
|
import Node.Encoding (Encoding(..))
|
|
import Node.Encoding (Encoding(..))
|
|
|
import Node.Errors.SystemError (code, message)
|
|
import Node.Errors.SystemError (code, message)
|
|
|
|
|
+import Node.EventEmitter (EventHandle, once)
|
|
|
|
|
+import Node.Stream (read)
|
|
|
|
|
+import Unsafe.Coerce (unsafeCoerce)
|
|
|
|
|
|
|
|
|
|
|
|
|
main :: Effect Unit
|
|
main :: Effect Unit
|
|
@@ -17,6 +26,12 @@ main = do
|
|
|
log "hello"
|
|
log "hello"
|
|
|
_ <- ChildProcess.exec' "pwd" identity readExec
|
|
_ <- ChildProcess.exec' "pwd" identity readExec
|
|
|
_ <- ChildProcess.exec' "touch /test.log" identity readExec
|
|
_ <- ChildProcess.exec' "touch /test.log" identity readExec
|
|
|
|
|
+
|
|
|
|
|
+ execCmd "pwd"
|
|
|
|
|
+ execCmd "touch /test.log"
|
|
|
|
|
+
|
|
|
|
|
+ launchAff_ spawnLs
|
|
|
|
|
+
|
|
|
pure unit
|
|
pure unit
|
|
|
|
|
|
|
|
readExec ∷ ExecResult → Effect Unit
|
|
readExec ∷ ExecResult → Effect Unit
|
|
@@ -27,3 +42,43 @@ readExec {error: Nothing, stdout, stderr} = do
|
|
|
|
|
|
|
|
readExec {error: Just err, stdout, stderr} = do
|
|
readExec {error: Just err, stdout, stderr} = do
|
|
|
log $ "error ! [" <> code err <> "], " <> message err
|
|
log $ "error ! [" <> code err <> "], " <> message err
|
|
|
|
|
+
|
|
|
|
|
+execCmd str = do
|
|
|
|
|
+ cp <- ChildProcess.exec str
|
|
|
|
|
+ exit <- exitCode cp
|
|
|
|
|
+ case exit of
|
|
|
|
|
+ Nothing -> log "exit with Nothing"
|
|
|
|
|
+ Just 0 -> log "exit with 0"
|
|
|
|
|
+ Just i -> log $ "exit with " <> show i
|
|
|
|
|
+
|
|
|
|
|
+spawnLs :: Aff Unit
|
|
|
|
|
+spawnLs = do
|
|
|
|
|
+ log "\nspawns processes ok"
|
|
|
|
|
+ ls <- liftEffect $ spawn "ls" [ "-la" ]
|
|
|
|
|
+ res <- waitSpawned ls
|
|
|
|
|
+ case res of
|
|
|
|
|
+ Right pid -> log $ "ls successfully spawned with PID: " <> show pid
|
|
|
|
|
+ Left err -> liftEffect $ throwException $ unsafeCoerce err
|
|
|
|
|
+ exit <- until ls ChildProcess.closeH \complete -> \exit -> complete exit
|
|
|
|
|
+ case exit of
|
|
|
|
|
+ Normally 0 -> do
|
|
|
|
|
+ log $ "ls exited with 0"
|
|
|
|
|
+ out <- liftEffect $ read $ stdout ls
|
|
|
|
|
+ case out of
|
|
|
|
|
+ Nothing -> log "Could not get stdout"
|
|
|
|
|
+ Just out' -> do
|
|
|
|
|
+ outStr <- liftEffect $ toString UTF8 out'
|
|
|
|
|
+ logShow outStr
|
|
|
|
|
+
|
|
|
|
|
+ Normally i -> liftEffect $ throw $ "ls had non-zero exit: " <> show i
|
|
|
|
|
+ BySignal sig -> liftEffect $ throw $ "ls exited with sig: " <> show sig
|
|
|
|
|
+
|
|
|
|
|
+until
|
|
|
|
|
+ :: forall emitter psCb jsCb a
|
|
|
|
|
+ . emitter
|
|
|
|
|
+ -> EventHandle emitter psCb jsCb
|
|
|
|
|
+ -> ((a -> Effect Unit) -> psCb)
|
|
|
|
|
+ -> Aff a
|
|
|
|
|
+until ee event cb = makeAff \done -> do
|
|
|
|
|
+ rm <- ee # once event (cb (done <<< Right))
|
|
|
|
|
+ pure $ effectCanceler rm
|