include/parse_config.ml

@@ -39,7 +39,17 @@ let read_file file = In_channel.with_open_bin file In_channel.input_all
 
 open Angstrom
 
-(* --- Utilities --- *)
+type item = {
+  key: string;
+  value: string;
+}
+
+type section = {
+  name: string;
+  items: item list;
+}
+
+type config = section list
 
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
 let whitespace = skip_while is_whitespace
@@ -53,100 +63,75 @@ let comment =
 
 let skip_ignored = skip_many (choice [ comment; blank_line ])
 
-(* --- Identifiers --- *)
-
-let ident_char = function
-  | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
-  | _ -> false
-
-let identifier = take_while1 ident_char >>| String.lowercase_ascii
+let identifier =
+  let ident_char = function
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
+    | _ -> false
+  in
+  take_while1 ident_char >>| String.lowercase_ascii
 
 (* --- Values --- *)
 
-(*
-let quoted_value =
-  char '"' *> take_till is_eol >>= fun line_rest ->
-  match String.rindex_opt line_rest '"' with
-  | None -> fail "unterminated quoted value"
-  | Some i ->
-      let value = String.sub line_rest 0 i in
-      (* consume up to and including the closing quote *)
-      let len = String.length line_rest in
-      let remaining_len = len - i - 1 in
-      advance (len - remaining_len) *> return value
-      *)
-
-let unquoted_value = take_while1 (fun c -> not (is_whitespace c || is_eol c))
-
 let value =
-  whitespace
-  *>
-  (*quoted_value <|> *)
-  unquoted_value
-  <* skip_ignored
+  let unquoted_value =
+    take_while1 (fun c -> not (is_whitespace c || is_eol c))
+  in
+  let quoted_value =
+    char '"' *> take_till is_eol >>= fun line_rest ->
+    match String.rindex_opt line_rest '"' with
+    | None -> fail "unterminated quoted value"
+    | Some i ->
+        let value = String.sub line_rest 0 i in
+        (* consume up to and including the closing quote *)
+        let len = String.length line_rest in
+        let remaining_len = len - i - 1 in
+        advance (len - remaining_len) *> return value
+  in
+  whitespace *> (quoted_value <|> unquoted_value) <* skip_ignored
 
-(* --- Option line --- *)
-
-type option_entry = {
-  key: string;
-  value: string;
-}
-
-let option_line =
+let item =
   lift2
     (fun key value -> { key; value })
     (identifier <* whitespace <* char '=')
     value
 
-(* --- Section --- *)
-
-type section = {
-  name: string;
-  options: option_entry list;
-}
-
 let section_header = char '[' *> identifier <* char ']'
 
-let section_parser =
+let section =
   lift2
-    (fun name options -> { name; options })
+    (fun name items -> { name; items })
     (section_header <* skip_ignored)
-    (many (option_line <* skip_ignored))
+    (many (item <* skip_ignored))
 
-(* --- Whole config file --- *)
-
-type config = section list
-
-let config_parser : config Angstrom.t =
-  skip_ignored *> many section_parser <* skip_ignored <* end_of_input
+let config : config Angstrom.t =
+  skip_ignored *> many section <* skip_ignored <* end_of_input
 
 let parse_config s =
-  match parse_string ~consume:Consume.All config_parser s with
+  match parse_string ~consume:Consume.All config s with
   | Ok v -> v
   | Error msg -> failwith msg
 
-(* --- Pretty printer --- *)
+(* --- pp --- *)
 
-(* Pretty-printer for an option: key = value *)
-let pp_option ppf (opt : option_entry) =
+let pp_item ppf { key; value } =
   let open Fmt in
-  pf ppf "%s = %s" opt.key opt.value
+  pf ppf "%s = %s" key value
 
-(* Pretty-printer for a section *)
 let pp_section ppf (sec : section) =
   let open Fmt in
-  pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_option) sec.options
+  pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_item) sec.items
 
-(* Pretty-printer for the entire config *)
 let pp_config ppf (cfg : config) =
   let open Fmt in
   pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg
 
+(* --- --- *)
+
 let () =
   let content = read_file "default.config" in
-  (*Fmt.pr "%s@." content;*)
 
   let config = parse_config content in
 
   Fmt.pr "%a" pp_config config;
+
   ()