Migrate to eventH-style event API (#43)

* Add dep on event-emitter; update node deps

* Migrate event handlers

* Update tests

* Add changelog entry

* Add entry for 'spawn' event

Author: JordanMartinez

CHANGELOG.md

@@ -5,8 +5,24 @@ Notable changes to this project are documented in this file. The format is based
 ## [Unreleased]
 
 Breaking changes:
+- Migrate `onEvent`-style event handlers to `eventH`-style (#43 by @JordanMartinez)
+
+  ```purs
+  -- Before
+  onExit cp case _ of
+    Normally exitCode -> ...
+    BySignal signal -> ...
+
+  -- After
+  cp # on_ exitH case _ of
+    Normally exitCode -> ...
+    BySignal signal -> ...
+  ```
+  See https://pursuit.purescript.org/packages/purescript-node-event-emitter/3.0.0/docs/Node.EventEmitter for more details.
+
 
 New features:
+- Added event handler for `spawn` event (#43 by @JordanMartinez)
 
 Bugfixes:
 

bower.json

@@ -17,11 +17,12 @@
   ],
   "dependencies": {
     "purescript-exceptions": "^6.0.0",
+    "purescript-node-event-emitter": "https://github.com/purescript-node/purescript-node-event-emitter.git#^3.0.0",
     "purescript-foreign": "^7.0.0",
     "purescript-foreign-object": "^4.0.0",
     "purescript-functions": "^6.0.0",
-    "purescript-node-fs": "^8.0.0",
-    "purescript-node-streams": "^7.0.0",
+    "purescript-node-fs": "^9.0.0",
+    "purescript-node-streams": "^8.0.0",
     "purescript-nullable": "^6.0.0",
     "purescript-posix-types": "^6.0.0",
     "purescript-unsafe-coerce": "^6.0.0"

src/Node/ChildProcess.js

@@ -46,50 +46,6 @@ export function fork(cmd) {
   return args => () => cp_fork(cmd, args);
 }
 
-export function mkOnExit(mkChildExit) {
-  return function onExit(cp) {
-    return cb => () => {
-      cp.on("exit", (code, signal) => {
-        cb(mkChildExit(code)(signal))();
-      });
-    };
-  };
-}
-
-export function mkOnClose(mkChildExit) {
-  return function onClose(cp) {
-    return cb => () => {
-      cp.on("close", (code, signal) => {
-        cb(mkChildExit(code)(signal))();
-      });
-    };
-  };
-}
-
-export function onDisconnect(cp) {
-  return cb => () => {
-    cp.on("disconnect", cb);
-  };
-}
-
-export function mkOnMessage(nothing) {
-  return just => (function onMessage(cp) {
-    return cb => () => {
-      cp.on("message", (mess, sendHandle) => {
-        cb(mess, sendHandle ? just(sendHandle) : nothing)();
-      });
-    };
-  });
-}
-
-export function onError(cp) {
-  return cb => () => {
-    cp.on("error", err => {
-      cb(err)();
-    });
-  };
-}
-
 const _undefined = undefined;
 export { _undefined as undefined };
 import process from "process";

src/Node/ChildProcess.purs

@@ -14,6 +14,13 @@
 module Node.ChildProcess
   ( Handle
   , ChildProcess
+  , toEventEmitter
+  , closeH
+  , disconnectH
+  , errorH
+  , exitH
+  , messageH
+  , spawnH
   , stdin
   , stdout
   , stderr
@@ -25,11 +32,6 @@ module Node.ChildProcess
   , Error
   , toStandardError
   , Exit(..)
-  , onExit
-  , onClose
-  , onDisconnect
-  , onMessage
-  , onError
   , spawn
   , SpawnOptions
   , defaultSpawnOptions
@@ -51,31 +53,64 @@ module Node.ChildProcess
 
 import Prelude
 
-import Control.Alt ((<|>))
 import Data.Function.Uncurried (Fn2, runFn2)
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
-import Data.Nullable (Nullable, toNullable, toMaybe)
+import Data.Nullable (Nullable, toMaybe, toNullable)
 import Data.Posix (Pid, Gid, Uid)
 import Data.Posix.Signal (Signal)
 import Data.Posix.Signal as Signal
 import Effect (Effect)
 import Effect.Exception as Exception
-import Effect.Exception.Unsafe (unsafeThrow)
+import Effect.Uncurried (EffectFn2, mkEffectFn1, mkEffectFn2)
 import Foreign (Foreign)
 import Foreign.Object (Object)
 import Node.Buffer (Buffer)
 import Node.Encoding (Encoding, encodingToNode)
+import Node.EventEmitter (EventEmitter, EventHandle(..))
+import Node.EventEmitter.UtilTypes (EventHandle0, EventHandle1)
 import Node.FS as FS
-import Node.Stream (Readable, Writable, Stream)
+import Node.Stream (Readable, Stream, Writable)
+import Partial.Unsafe (unsafeCrashWith)
 import Unsafe.Coerce (unsafeCoerce)
 
 -- | A handle for inter-process communication (IPC).
 foreign import data Handle :: Type
 
 -- | Opaque type returned by `spawn`, `fork` and `exec`.
 -- | Needed as input for most methods in this module.
+-- |
+-- | `ChildProcess` extends `EventEmitter`
 newtype ChildProcess = ChildProcess ChildProcessRec
 
+toEventEmitter :: ChildProcess -> EventEmitter
+toEventEmitter = unsafeCoerce
+
+closeH :: EventHandle ChildProcess (Exit -> Effect Unit) (EffectFn2 (Nullable Int) (Nullable String) Unit)
+closeH = EventHandle "close" \cb -> mkEffectFn2 \code signal ->
+  case toMaybe code, toMaybe signal >>= Signal.fromString of
+    Just c, _ -> cb $ Normally c
+    _, Just s -> cb $ BySignal s
+    _, _ -> unsafeCrashWith $ "Impossible. 'close' event did not get an exit code or kill signal: " <> show code <> "; " <> show signal
+
+disconnectH :: EventHandle0 ChildProcess
+disconnectH = EventHandle "disconnect" identity
+
+errorH :: EventHandle1 ChildProcess Error
+errorH = EventHandle "error" mkEffectFn1
+
+exitH :: EventHandle ChildProcess (Exit -> Effect Unit) (EffectFn2 (Nullable Int) (Nullable String) Unit)
+exitH = EventHandle "exitH" \cb -> mkEffectFn2 \code signal ->
+  case toMaybe code, toMaybe signal >>= Signal.fromString of
+    Just c, _ -> cb $ Normally c
+    _, Just s -> cb $ BySignal s
+    _, _ -> unsafeCrashWith $ "Impossible. 'exit' event did not get an exit code or kill signal: " <> show code <> "; " <> show signal
+
+messageH :: EventHandle ChildProcess (Foreign -> Maybe Handle -> Effect Unit) (EffectFn2 Foreign (Nullable Handle) Unit)
+messageH = EventHandle "message" \cb -> mkEffectFn2 \a b -> cb a $ toMaybe b
+
+spawnH :: EventHandle0 ChildProcess
+spawnH = EventHandle "spawn" identity
+
 runChildProcess :: ChildProcess -> ChildProcessRec
 runChildProcess (ChildProcess r) = r
 
@@ -165,68 +200,6 @@ instance showExit :: Show Exit where
   show (Normally x) = "Normally " <> show x
   show (BySignal sig) = "BySignal " <> show sig
 
-mkExit :: Nullable Int -> Nullable String -> Exit
-mkExit code signal =
-  case fromCode code <|> fromSignal signal of
-    Just e -> e
-    Nothing -> unsafeThrow "Node.ChildProcess.mkExit: Invalid arguments"
-  where
-  fromCode = toMaybe >>> map Normally
-  fromSignal = toMaybe >=> Signal.fromString >>> map BySignal
-
--- | Handle the `"exit"` signal.
-onExit
-  :: ChildProcess
-  -> (Exit -> Effect Unit)
-  -> Effect Unit
-onExit = mkOnExit mkExit
-
-foreign import mkOnExit
-  :: (Nullable Int -> Nullable String -> Exit)
-  -> ChildProcess
-  -> (Exit -> Effect Unit)
-  -> Effect Unit
-
--- | Handle the `"close"` signal.
-onClose
-  :: ChildProcess
-  -> (Exit -> Effect Unit)
-  -> Effect Unit
-onClose = mkOnClose mkExit
-
-foreign import mkOnClose
-  :: (Nullable Int -> Nullable String -> Exit)
-  -> ChildProcess
-  -> (Exit -> Effect Unit)
-  -> Effect Unit
-
--- | Handle the `"message"` signal.
-onMessage
-  :: ChildProcess
-  -> (Foreign -> Maybe Handle -> Effect Unit)
-  -> Effect Unit
-onMessage = mkOnMessage Nothing Just
-
-foreign import mkOnMessage
-  :: forall a
-   . Maybe a
-  -> (a -> Maybe a)
-  -> ChildProcess
-  -> (Foreign -> Maybe Handle -> Effect Unit)
-  -> Effect Unit
-
--- | Handle the `"disconnect"` signal.
-foreign import onDisconnect
-  :: ChildProcess
-  -> Effect Unit
-  -> Effect Unit
-
--- | Handle the `"error"` signal.
-foreign import onError
-  :: ChildProcess
-  -> (Error -> Effect Unit)
-  -> Effect Unit
-
 -- | Spawn a child process. Note that, in the event that a child process could
 -- | not be spawned (for example, if the executable was not found) this will
 -- | not throw an error. Instead, the `ChildProcess` will be created anyway,

test/Main.purs

@@ -7,10 +7,11 @@ import Data.Posix.Signal (Signal(..))
 import Effect (Effect)
 import Effect.Console (log)
 import Node.Buffer as Buffer
-import Node.ChildProcess (Exit(..), defaultExecOptions, exec, defaultExecSyncOptions, execSync, onError, defaultSpawnOptions, spawn, stdout, onExit, kill)
+import Node.ChildProcess (Exit(..), defaultExecOptions, defaultExecSyncOptions, defaultSpawnOptions, errorH, exec, execSync, exitH, kill, spawn, stdout)
 import Node.Encoding (Encoding(UTF8))
 import Node.Encoding as NE
-import Node.Stream (onData)
+import Node.EventEmitter (on_)
+import Node.Stream (dataH)
 
 main :: Effect Unit
 main = do
@@ -24,7 +25,7 @@ main = do
   log "doesn't perform effects too early"
   spawn "ls" [ "-la" ] defaultSpawnOptions >>= \ls -> do
     let _ = kill SIGTERM ls
-    onExit ls \exit ->
+    ls # on_ exitH \exit ->
       case exit of
         Normally 0 ->
           log "All good!"
@@ -34,7 +35,7 @@ main = do
   log "kills processes"
   spawn "ls" [ "-la" ] defaultSpawnOptions >>= \ls -> do
     _ <- kill SIGTERM ls
-    onExit ls \exit ->
+    ls # on_ exitH \exit ->
       case exit of
         BySignal SIGTERM ->
           log "All good!"
@@ -47,14 +48,15 @@ main = do
 spawnLs :: Effect Unit
 spawnLs = do
   ls <- spawn "ls" [ "-la" ] defaultSpawnOptions
-  onExit ls \exit ->
+  ls # on_ exitH \exit ->
     log $ "ls exited: " <> show exit
-  onData (stdout ls) (Buffer.toString UTF8 >=> log)
+  (stdout ls) # on_ dataH (Buffer.toString UTF8 >=> log)
 
 nonExistentExecutable :: Effect Unit -> Effect Unit
 nonExistentExecutable done = do
   ch <- spawn "this-does-not-exist" [] defaultSpawnOptions
-  onError ch (\err -> log err.code *> done)
+  ch # on_ errorH \err ->
+    log err.code *> done
 
 execLs :: Effect Unit
 execLs = do