include/parse_config.ml

@@ -36,11 +36,8 @@ let duration_value =
   many1 (lift2 (fun number unit_ -> { number; unit_ }) number unit)
 *)
 
-(*
 let read_file file = In_channel.with_open_bin file In_channel.input_all
 
-open Angstrom
-
 type item = {
   key: string;
   value: string;
@@ -49,115 +46,75 @@ type item = {
 type line =
   | Blank
   | Comment of string
-  | Section_header of string
+  | Header of string
   | Item of item
 
+open Angstrom
+
+let is_eol = function '\n' | '\r' -> true | _ -> false
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
 let whitespace = skip_while is_whitespace
-let is_eol = function '\n' | '\r' -> true | _ -> false
-let blank = whitespace >>= fun () -> return Blank
 
-let comment =
-  ( whitespace *> peek_char >>= function
-    | None -> fail "peek_char end_of_file failure"
-    | Some c ->
-        if c = '#' || c = '%' then take_while (fun c -> not (is_eol c))
-        else fail "not a comment" )
-  >>= fun s -> return (Comment s)
-
-let item_key =
+let id =
   let ident_char = function
     | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
     | _ -> false
   in
   take_while1 ident_char >>| String.lowercase_ascii
 
+let take_till_end_of_line =
+  take_till is_eol >>= fun s -> return s <* end_of_line
+
+let blank = whitespace <* end_of_line >>| fun () -> Blank
+
+let comment =
+  whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
+  Comment s
+
+let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
+
 let item_value =
   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
+    char '"' *> take_till is_eol >>= fun s ->
+    match String.ends_with ~suffix:"\"" s with
+    | false -> fail "invalid quoted value"
+    | true ->
+        let value = String.sub s 0 (String.length s - 1) in
+        return value
   in
-  whitespace *> (quoted_value <|> unquoted_value)
+  quoted_value <|> unquoted_value
 
 let item =
   lift2
     (fun key value -> Item { key; value })
-    (item_key <* whitespace <* char '=')
-    item_value
+    id
+    (whitespace *> char '=' *> whitespace *> item_value)
+  <* end_of_line
 
-let section_header =
-  char '[' *> item_key <* char ']' >>= fun s -> return (Section_header s)
-
-let lines =
-  let line = choice [ blank; comment; section_header; item ] <* end_of_line in
-  many line <* end_of_input
-
-let parse s =
-  match parse_string ~consume:Consume.All lines s with
-  | Ok v -> v
-  | Error msg -> failwith msg
+let config = many (choice [ blank; comment; header; item ]) <* end_of_input
 
 let pp_line ppf line =
   let open Fmt in
   match line with
   | Blank -> Fmt.nop ppf ()
   | Comment s -> pf ppf "#%s" s
-  | Section_header s -> pf ppf "[%s]" s
-  | Item { key; value } -> pf ppf "%s = %s" key value
-
-let pp_config ppf config =
-  let open Fmt in
-  pf ppf "%a" (list ~sep:(any "\n") pp_line) config
-
-(* --- --- *)
-
-(*
-let () =
-  let content = read_file "default.config" in
-  (*Fmt.pr "%s" content;*)
-
-  let config = parse content in
-
-  Fmt.pr "%a@." pp_config config;
-
-  ()
-  *)
-*)
-
-(* --- ff --- *)
-open Angstrom
-
-let read_file file = In_channel.with_open_bin file In_channel.input_all
-
-let raw_line =
-  take_till (function '\n' | '\r' -> true | _ -> false) >>= fun s ->
-  return s <* end_of_line
-
-let raw_line_l = many raw_line <* end_of_input
-
-let pp_raw_line ppf raw_line =
-  let open Fmt in
-  pf ppf "%s" raw_line
+  | Header s -> pf ppf "[%s]" s
+  | Item { key; value } -> (
+      match String.contains value '"' || String.contains value ' ' with
+      | false -> pf ppf "%s = %s" key value
+      | true -> pf ppf "%s = \"%s\"" key value)
 
 let pp ppf raw_line_l =
   let open Fmt in
-  pf ppf "%a" (list ~sep:(any "\n") pp_raw_line) raw_line_l
+  pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l
 
-(* Helper: parse whole input into list of lines *)
 let parse s =
-  match parse_string ~consume:All raw_line_l s with
-  | Ok ls -> ls
-  | Error msg -> failwith ("lines parse error: " ^ msg)
+  match parse_string ~consume:All config s with
+  | Error msg -> Fmt.failwith "config parse error: %s" msg
+  | Ok v -> v
 
 let () =
   let content = read_file "default.config" in