OCaml: Implement configuration parser, bind lexer tokens with schema

ocaml/lib/parsers/argument.ml

@@ -1,12 +1,19 @@
 let interpret (past : Schema.schema) (input : string list) : Schema.schema =
-    let future : Schema.schema =
+    let present : Schema.schema =
         { past with output = { past.output with main = "" } }
     in
 
     let say (message : string) : Schema.schema =
-        { future with output = { future.output with main = message } }
+        { present with output = { present.output with main = message } }
     in
 
+    let configured_present = System.Process.Command.check_su_command present in
+
+    (* poor legibility, but otherwise flagged as non-exhaustive *)
+    match configured_present.meta.status with
+    | n when n <> 0 -> configured_present
+    | _ ->
+
     (*
        TODO: return a schema with orders, instead of calling side-effects
        directly, making this more of a parser and less of a glorified switch
@@ -17,17 +24,17 @@ let interpret (past : Schema.schema) (input : string list) : Schema.schema =
     | "user" :: _ -> say (System.Process.Reader.read [||] "whoami").output
     | "echo" :: tail -> say (String.concat " " tail)
     | ("version" | "-v" | "--version") :: _ ->
-        say (Schema.format_version future.meta.version)
-    | ("help" | "-h" | "--help") :: _ -> say future.meta.help.long
+        say (Schema.format_version present.meta.version)
+    | ("help" | "-h" | "--help") :: _ -> say present.meta.help.long
     | head :: _ ->
         {
-          future with
+          present with
           output =
             {
-              future.output with
+              present.output with
               main =
-                "Unrecognized command: " ^ head ^ "\n" ^ future.meta.help.short;
+                "Unknown command: " ^ head ^ "\n" ^ present.meta.help.short;
             };
-          meta = { future.meta with status = 1 };
+          meta = { present.meta with status = 1 };
         }
-    | _ -> future
+    | _ -> present

ocaml/lib/parsers/config/lexer.ml

@@ -1,6 +1,6 @@
 open Utilities.Aliases
 
-type key = SuCommand | Unknown
+type key = Schema.configuration_key
 type token =
     | Key of key
     | Equal

ocaml/lib/parsers/config/lexer.mli

@@ -1,4 +1,16 @@
-type token
+type key = Schema.configuration_key
+
+type token =
+    | Key of key
+    | Equal
+    | Value of string
+    | Space
+    | LineBreak
+    | Unknown of char
+    | End
+
 val read : string -> char list list
 val scan : char list list -> token list list
 val string_of_tokens : token list list -> string
+
+exception Malformed_source of string

ocaml/lib/parsers/config/parser.ml

@@ -0,0 +1,55 @@
+(* open Utilities.Aliases *)
+open Lexer
+
+type schema = Schema.schema
+type token = Lexer.token
+type config = Schema.main
+
+let default_config: config = Schema.origin.input.configuration.main
+
+(*
+    TODO: The `elog` calls in this module's functions cause cram tests
+    to fail. Separate logging levels can be implemented to solve this.
+*)
+
+let update config key value: config =
+    match key with
+    | Schema.SuCommand ->
+        (* elog $ "[c.parser.update] Setting value '" ^ value ^ "'"; *)
+        { config with Schema.su_command = value }
+    | Unknown ->
+        (* elog $ "[c.parser.update] Dropping value: unknown key"; *)
+        config
+
+let parse tokens =
+    let rec parse_tokens tokens config ready_key =
+        match tokens with
+        | [] -> config
+        | Key key :: tail ->
+            (* elog $ "[c.parser.parse ] Picked key '" ^ *)
+            (*     Schema.string_of_key key ^ "'"; *)
+            parse_tokens tail config (Some key)
+        | Value value :: tail ->
+            (* elog $ "[c.parser.parse ] Picked value '" ^ value ^ "'"; *)
+            (match ready_key with
+                | Some key -> parse_tokens tail (update config key value) None
+                | None -> raise (Malformed_source "Value lacks preceding key"))
+        | Unknown _char :: tail ->
+            (* elog $ "[c.parser.parse ] Dropping unknown token " ^ str_char char; *)
+            parse_tokens tail config ready_key
+        | (Space|Equal|LineBreak|End) :: tail ->
+            parse_tokens tail config ready_key
+
+    in
+    parse_tokens tokens default_config None
+
+let apply (origin: Schema.schema) (config: config): Schema.schema =
+    { origin with input = {
+        origin.input with configuration = {
+            origin.input.configuration with main = config
+        }
+    }}
+
+let string_of_config (config: config): string =
+    "su_command = " ^ config.su_command ^ "\n" ^
+    ""

ocaml/lib/parsers/config/parser.mli

@@ -0,0 +1,7 @@
+type token = Lexer.token
+type schema = Schema.schema
+type config = Schema.main
+
+val parse : token list -> config
+val apply : schema -> config -> schema
+val string_of_config : config -> string