OCaml: Handle some edge cases; refactor parser, main.ml; add config fetcher

ocaml/lib/parsers/argument.ml

@@ -1,40 +1,30 @@
-let interpret (past : Schema.schema) (input : string list) : Schema.schema =
-    let present : Schema.schema =
-        { past with output = { past.output with main = "" } }
-    in
+let interpret (past : Schema.schema) (arguments : string list) : Schema.schema =
 
     let say (message : string) : Schema.schema =
-        { present with output = { present.output with main = message } }
+        { past with output = { past.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
     *)
-    match input with
+    match arguments with
     | "pkg" :: tail -> System.Package.merge past tail
     | "os" :: _ -> say System.Os.identify
     | "user" :: _ -> say (System.Process.Reader.read [||] "whoami").output
     | "echo" :: tail -> say (String.concat " " tail)
     | ("version" | "-v" | "--version") :: _ ->
-        say (Schema.format_version present.meta.version)
-    | ("help" | "-h" | "--help") :: _ -> say present.meta.help.long
+        say (Schema.format_version past.meta.version)
+    | ("help" | "-h" | "--help") :: _ -> say past.meta.help.long
     | head :: _ ->
         {
-          present with
+          past with
           output =
             {
-              present.output with
+              past.output with
               main =
-                "Unknown command: " ^ head ^ "\n" ^ present.meta.help.short;
+                "Unknown command: " ^ head ^ "\n" ^ past.meta.help.short;
             };
-          meta = { present.meta with status = 1 };
+          meta = { past.meta with status = 1 };
         }
-    | _ -> present
+    | _ -> past

ocaml/lib/parsers/config/fetcher.ml

@@ -0,0 +1,14 @@
+let fetch ?clean (origin: Schema.schema): Schema.schema =
+    let config = Lexer.read origin.meta.defaults.paths.configuration
+    |> Lexer.scan
+    |> List.concat
+    |> Parser.parse
+    in
+
+    if Option.value clean ~default:false then {
+        Schema.origin with input = {
+            origin.input with configuration = {
+                origin.input.configuration with main = config
+            }
+        }
+    } else Parser.apply origin config

ocaml/lib/parsers/config/lexer.ml

@@ -10,19 +10,26 @@ type token =
     | Unknown of char
     | End
 
+    (*
+        TODO: This module's functions rely too much on matching a string, so
+        there are no exhaustion checks and it's entirely up to the human to
+        not overlook a variant, possibly leading to unhandled cases. Either
+        refactor, add tests that will fail if a variant is unhandled, or both
+    *)
+
 let lex_keyword (literal: string): token =
     match literal with
     | "su_command" -> Key SuCommand
+    | "su_command_quoted" -> Key SuCommandQuoted
     | _ -> Key Unknown
 
 let lex_keyvalue (literal: string): token = Value literal
 
-exception Malformed_source of string
-
 let string_of_token (token: token): string =
     match token with
     | Key k -> (match k with
         | SuCommand -> "[ KEY: su_command ]"
+        | SuCommandQuoted -> "[ KEY: su_command_quoted ]"
         | Unknown -> "[ UNKNOWN KEY ]")
     | Equal -> "[ OP: equal ]"
     | Value v -> "[ VAL: " ^ v ^ " ]"
@@ -66,6 +73,7 @@ let lex (chars: char list) (position: int): token * int =
         | c -> Unknown c, position + 1
 
 let read (path: string): char lists =
+    if not $ System.File.can_read path then [[]] else
     let lines = System.File.read path
     |> String.split_on_char '\n'
     |> List.map String.trim in
@@ -89,4 +97,6 @@ let scan_line (input: char list): token list =
     reverse $ to_tokens input 0 []
 
 let scan (char_lists: char lists): token lists =
-    rmap (scan_line) char_lists $: [End]
+    let tokens = rmap (scan_line) char_lists $: [End] in
+    elog $ string_of_tokens tokens;
+    tokens

ocaml/lib/parsers/config/lexer.mli

@@ -12,5 +12,4 @@ type token =
 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
+val string_of_token : token -> string

ocaml/lib/parsers/config/parser.ml

@@ -1,41 +1,83 @@
 (* open Utilities.Aliases *)
 open Lexer
+open Utilities.Aliases
 
-type schema = Schema.schema
-type token = Lexer.token
-type config = Schema.main
-
-let default_config: config = Schema.origin.input.configuration.main
+let default_config: Schema.main = 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 =
+let parse_boolean (key: key) (value: string): Schema.default_bool =
+    match value with
+    | "true" -> true
+    | "false" -> false
+    | _ -> raise $ Malformed_source
+        (Schema.string_of_key key ^ " must be either true or false")
+
+let update_and_log ?message config key (value: string) : Schema.main =
+    let message = match message with
+        | Some s -> " (" ^ s  ^ ")"
+        | None -> ""
+    in
+    elog $ "[c.parser.update] " ^ Schema.string_of_key key ^ " <- " ^ value ^ message;
+    config
+
+let update (past_config: Schema.main) key (value: string): Schema.main =
+    let default = Schema.origin.input.configuration.main in
     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 default = Schema.origin.input.configuration.main in
+        let as_list = String.split_on_char ' ' value in
+        (* user set su_command, but not if it's quoted -> default to unquoted *)
 
-let parse tokens =
+        elog $ "value -> '" ^ value ^ "' <> '" ^
+            String.concat " " default.su_command ^ "' <- default";
+        elog $ "past_config.su_command_quoted -> '" ^
+            str_dbool past_config.su_command_quoted ^ "' == '" ^
+            str_dbool default.su_command_quoted ^ "' <- default";
+
+        if value <> String.concat " " default.su_command &&
+            past_config.su_command_quoted == default.su_command_quoted
+        then
+            update_and_log {
+                past_config with su_command = as_list;
+                su_command_quoted = false
+            } key value ~message:("Defaulting to unquoted: set su_command_quoted to true if your su command needs quoting"
+                )
+        else
+            update_and_log { past_config with su_command = as_list } key value ~message:("both su_command and su_command_quoted set by user")
+
+
+    | SuCommandQuoted -> (
+        if past_config.su_command == default.su_command then
+            update_and_log { past_config with su_command_quoted = true }
+                key "true" ~message: ("configuration value ignored: " ^
+                "su_command is the default and 'su' requires quoting")
+        else
+            let parsed_boolean = parse_boolean key value in
+            update_and_log
+                { past_config with su_command_quoted = parsed_boolean }
+                key (str_dbool parsed_boolean))
+    | Unknown ->
+        update_and_log past_config key value
+
+let parse tokens: Schema.main =
     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 ^ "'"; *)
+            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 ^ "'"; *)
+            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; *)
+                | 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
@@ -43,13 +85,14 @@ let parse tokens =
     in
     parse_tokens tokens default_config None
 
-let apply (origin: Schema.schema) (config: config): Schema.schema =
+let apply (origin: Schema.schema) (config: Schema.main): 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" ^
-    ""
+let string_of_config (config: Schema.main): string =
+    (* TODO: extract, use pattern matching for exhaustion checks *)
+    "su_command = " ^ String.concat " " config.su_command ^ "\n" ^
+    "su_command_quoted = " ^ str_dbool config.su_command_quoted

ocaml/lib/parsers/config/parser.mli

@@ -1,7 +1,3 @@
-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
+val parse : Lexer.token list -> Schema.main
+val apply : Schema.schema -> Schema.main -> Schema.schema
+val string_of_config : Schema.main -> string