Merge pull request #600 from mnxn/handle-childprocess-error

handle childprocess error

src/bindings/node/node.ml

@@ -205,7 +205,8 @@ module ChildProcess = struct
     val on : t -> string -> Ojs.t -> unit [@@js.call]]
 
   let on t = function
-    | `Close f -> on t "close" @@ [%js.of: code:int -> signal:string -> unit] f
+    | `Close f ->
+      on t "close" @@ [%js.of: code:int -> ?signal:string -> unit -> unit] f
     | `Disconnect f -> on t "disconnect" @@ [%js.of: unit -> unit] f
     | `Error f -> on t "error" @@ [%js.of: err:JsError.t -> unit] f
     | `Exit f -> on t "exit" @@ [%js.of: code:int -> signal:string -> unit] f
@@ -223,6 +224,7 @@ module ChildProcess = struct
     | Stdout of string
     | Stderr of string
     | Closed
+    | ProcessError of JsError.t
 
   let handle_child_process ?logger ?stdin cp resolve =
     let log = Option.value logger ~default:ignore in
@@ -253,7 +255,10 @@ module ChildProcess = struct
     in
     Stream.Readable.on (get_stderr cp) (`Data on_stderr);
 
-    let close ~code ~signal:_ =
+    let error ~err = log (ProcessError err) in
+    on cp (`Error error);
+
+    let close ~code ?signal:_ () =
       log Closed;
       resolve
         { exitCode = code

src/bindings/node/node.mli

@@ -149,6 +149,7 @@ module ChildProcess : sig
     | Stdout of string
     | Stderr of string
     | Closed
+    | ProcessError of JsError.t
 
   val exec :
        ?logger:(event -> unit)

src/cmd.ml

@@ -88,6 +88,7 @@ let run ?cwd ?env ?stdin cmd =
     | Stderr data ->
       Vscode.OutputChannel.append output ~value:data
     | Closed -> Vscode.OutputChannel.appendLine output ~value:""
+    | ProcessError err -> log_value "process error" (Node.JsError.t_to_js err)
   in
   let options = ChildProcess.Options.create ?cwd ?env () in
   match cmd with
@@ -98,7 +99,7 @@ let run ?cwd ?env ?stdin cmd =
 
 let log ?(result : ChildProcess.return option) (t : t) =
   let open Jsonoo.Encode in
-  let message =
+  let fields =
     match result with
     | None -> []
     | Some result ->
@@ -110,16 +111,16 @@ let log ?(result : ChildProcess.return option) (t : t) =
             ] )
       ]
   in
-  let message =
+  let fields =
     match t with
     | Spawn { bin; args } ->
       ("bin", string (Path.to_string bin))
-      :: ("args", list string args) :: message
-    | Shell command_line -> ("shell", string command_line) :: message
+      :: ("args", list string args) :: fields
+    | Shell command_line -> ("shell", string command_line) :: fields
   in
   match result with
-  | None -> log_json "external command" message
-  | Some _ -> log_json "external command (finished)" message
+  | None -> log_fields "external command" fields
+  | Some _ -> log_fields "external command (finished)" fields
 
 let output ?cwd ?env ?stdin (t : t) =
   let open Promise.Syntax in

src/import.ml

@@ -48,10 +48,15 @@ let log fmt =
   let write line = OutputChannel.appendLine output_channel ~value:line in
   Printf.ksprintf write fmt
 
-let log_json msg (fields : (string * Jsonoo.t) list) =
-  let json = Jsonoo.Encode.object_ fields |> Jsonoo.stringify ~spaces:2 in
+let log_json msg (json : Jsonoo.t) =
+  let json_str = Jsonoo.stringify ~spaces:2 json in
   let (lazy output_channel) = Output.extension_output_channel in
-  OutputChannel.appendLine output_channel ~value:(msg ^ " " ^ json ^ "\n")
+  OutputChannel.appendLine output_channel ~value:(msg ^ " " ^ json_str ^ "\n")
+
+let log_fields msg (fields : (string * Jsonoo.t) list) =
+  log_json msg (Jsonoo.Encode.object_ fields)
+
+let log_value msg (js_val : Ojs.t) = log_json msg (Jsonoo.t_of_js js_val)
 
 (** given a file uri, opens the file if it exists; otherwise, creates the file
     in "draft" mode (doesn't save it on disk)