OCaml: Add separate logging channels and a dedicated 'command' type

ocaml/lib/parsers/argument.ml

@@ -1,9 +1,9 @@
 let interpret (past: Schema.schema) (input: string list): Schema.schema =
 
-    let future = { past with output = { message = "" } } in
+    let future: Schema.schema = { past with output = { past.output with main = "" } } in
 
-    let say (message: string) =
-        { future with output = { message = message } } in
+    let say (message: string): Schema.schema =
+        { future with output = { future.output with main = message }} in
 
     (*
        TODO: return a schema with orders, instead of calling side-effects
@@ -20,7 +20,7 @@ let interpret (past: Schema.schema) (input: string list): Schema.schema =
     | head :: _ ->
         { future with
             output = {
-                message =
+                future.output with main =
                     ("Unrecognized command: " ^ head ^ "\n"
                         ^ future.meta.help.short)
             };

ocaml/lib/schema/schema.ml

@@ -4,12 +4,12 @@ type version = { major: int; minor: int; patch: int }
 type help = { short: string; long: string }
 type meta = { version: version; help: help; status: int }
 
-type output = { message: string; }
+type output = { main: string; log: string }
 
 type os = Unknown | FreeBSD | Void | Alpine
-type host = { os: os; name: string; }
+type host = { os: os; name: string }
 
-type schema = { meta: meta; output: output; host: host; }
+type schema = { meta: meta; output: output; host: host }
 
 let seed: schema = {
     meta = {
@@ -25,7 +25,10 @@ let seed: schema = {
         status = 0;
     };
     output = {
-        message = "";
+        (* could be lists of strings or lists of a dedicated type with message,
+           log level, time and origin in code (e.g. module and function) *)
+        main = "";
+        log = "";
     };
     host = {
         os = Unknown;

ocaml/lib/system/package.ml

@@ -1,15 +1,30 @@
-let merge (schema: Schema.schema) (packages: string list) =
+let merge (schema: Schema.schema) (packages: string list): Schema.schema =
 
     match packages with
-    | [] -> { schema with output = { message = "No packages provided" } }
+    | [] -> { schema with output = {
+        schema.output with main = "No packages provided" }
+    }
     | _ ->
 
-    let in_targets = List.flatten [["doas"; "apk"; "-i"; "add"]; packages] and
-        out_targets = List.flatten [["doas"; "apk"; "-i"; "del"]; packages] in
+        let commands: Process.Command.command list = [
+            {
+                name = "doas";
+                arguments = ["doas"; "apk"; "-i"; "add"] @ packages;
+                status = Unevaluated;
+            };
+            {
+                name = "doas";
+                arguments = ["doas"; "apk"; "-i"; "del"] @ packages;
+                status = Unevaluated;
+            }
+        ] in
 
-        Process.Fork.run "doas" in_targets;
-        Process.Fork.run "doas" out_targets;
+        let ran = Process.Fork.run_many commands in
+        let formatted_ran = Process.Command.format_many ran in
 
-        { schema with output = {
-            message = "Done: " ^ (String.concat "\n" packages)
-        }}
+        {
+            schema with output = {
+                schema.output with log =
+                    "Done:\n" ^ (String.concat "\n" formatted_ran)
+            }
+        }

ocaml/lib/system/process/command.ml

@@ -0,0 +1,13 @@
+open Utilities.Aliases
+
+type status = Exit of int | Unevaluated
+type command = { name: string; arguments: string list; status: status }
+
+let format (command: command): string =
+    command.name ^
+    " with arguments: " ^ (String.concat " " command.arguments) ^
+    " and result " ^ match command.status with
+    | Exit n -> str_int n
+    | Unevaluated -> "Not evaluated"
+
+let format_many (commands: command list): string list = List.map format commands

ocaml/lib/system/process/fork.ml

@@ -1,11 +1,9 @@
-open Utilities.Aliases
-
-let run (command: string) (arguments: string list) =
+let run (command: Command.command): Command.command =
     match Unix.fork () with
-    | 0 -> Unix.execvp command (Array.of_list arguments)
+    | 0 -> Unix.execvp command.name (Array.of_list command.arguments)
     | pid -> let (_, status) = Unix.waitpid [] pid in
         match status with
-        | Unix.WEXITED 0 -> ()
-        | Unix.WEXITED n -> print ("Process exited with code " ^ str_int n)
-        | Unix.WSIGNALED n -> print ("Process terminated by signal " ^ str_int n)
-        | Unix.WSTOPPED n -> print ("Process stopped by signal " ^ str_int n)
+        | WSTOPPED n | WSIGNALED n | WEXITED n -> { command with status = Exit n }
+
+let run_many (commands: Command.command list): Command.command list =
+    List.map run commands

ocaml/lib/utilities/aliases.ml

@@ -1,2 +1,3 @@
 let str_int = string_of_int
 let print = print_endline
+let elog = Log.elog

ocaml/lib/utilities/log.ml

@@ -0,0 +1 @@
+let elog message = prerr_endline @@ " [log] " ^ message