wip: remake parser

include/parse_config.ml

@@ -36,6 +36,7 @@ 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
@@ -45,36 +46,33 @@ type item = {
   value: string;
 }
 
-type section = {
+type line =
-  name: string;
+  | Blank
-  items: item list;
+  | Comment of string
-}
+  | Section_header of string
-
+  | Item of item
-type config = section list
 
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
 let whitespace = skip_while is_whitespace
-let blank_line = whitespace *> end_of_line
 let is_eol = function '\n' | '\r' -> true | _ -> false
+let blank = whitespace >>= fun () -> return Blank
 
 let comment =
-  whitespace *> peek_char >>= function
+  ( whitespace *> peek_char >>= function
     | None -> fail "peek_char end_of_file failure"
     | Some c ->
-      if c = '#' || c = '%' then
+        if c = '#' || c = '%' then take_while (fun c -> not (is_eol c))
-        skip_while (fun c -> not (is_eol c)) *> end_of_line
+        else fail "not a comment" )
-      else fail "not a comment"
+  >>= fun s -> return (Comment s)
 
-let skip_ignored = skip_many (choice [ comment; blank_line ])
+let item_key =
-
-let identifier =
   let ident_char = function
     | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
     | _ -> false
   in
   take_while1 ident_char >>| String.lowercase_ascii
 
-let value =
+let item_value =
   let unquoted_value =
     take_while1 (fun c -> not (is_whitespace c || is_eol c))
   in
@@ -89,50 +87,84 @@ let value =
         let remaining_len = len - i - 1 in
         advance (len - remaining_len) *> return value
   in
-  whitespace *> (quoted_value <|> unquoted_value) <* skip_ignored
+  whitespace *> (quoted_value <|> unquoted_value)
 
 let item =
   lift2
-    (fun key value -> { key; value })
+    (fun key value -> Item { key; value })
-    (identifier <* whitespace <* char '=')
+    (item_key <* whitespace <* char '=')
-    value
+    item_value
 
-let section_header = char '[' *> identifier <* char ']'
+let section_header =
+  char '[' *> item_key <* char ']' >>= fun s -> return (Section_header s)
 
-let section =
+let lines =
-  lift2
+  let line = choice [ blank; comment; section_header; item ] <* end_of_line in
-    (fun name items -> { name; items })
+  many line <* end_of_input
-    (skip_ignored *> section_header)
-    (many (skip_ignored *> item))
 
-let config : config Angstrom.t =
+let parse s =
-  many_till (section <* skip_ignored) end_of_input
+  match parse_string ~consume:Consume.All lines s with
-
-let parse_config s =
-  match parse_string ~consume:Consume.All config s with
   | Ok v -> v
   | Error msg -> failwith msg
 
-let pp_item ppf { key; value } =
+let pp_line ppf line =
   let open Fmt in
-  pf ppf "%s = %s" key value
+  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_section ppf (sec : section) =
+let pp_config ppf config =
   let open Fmt in
-  pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_item) sec.items
+  pf ppf "%a" (list ~sep:(any "\n") pp_line) 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 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
+
+let pp ppf raw_line_l =
+  let open Fmt in
+  pf ppf "%a" (list ~sep:(any "\n") pp_raw_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)
+
 let () =
   let content = read_file "default.config" in
   (*Fmt.pr "%s" content;*)
 
-  let config = parse_config content in
+  let config = parse content in
 
-  Fmt.pr "%a" pp_config config;
+  Fmt.pr "%a@." pp config;
 
   ()