From b4daecc6c4c417f472b0d6653a23dc7722e037fc Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 13 Oct 2025 08:19:38 +0200 Subject: [PATCH] --- include/parse_config.ml | 116 +++++++++++++++++++++++++--------------- 1 file changed, 74 insertions(+), 42 deletions(-) diff --git a/include/parse_config.ml b/include/parse_config.ml index f9140392..45fba881 100644 --- a/include/parse_config.ml +++ b/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 = { - name: string; - items: item list; -} - -type config = section list +type line = + | Blank + | Comment of string + | Section_header of string + | Item of item 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 - | None -> fail "peek_char end_of_file failure" - | Some c -> - if c = '#' || c = '%' then - skip_while (fun c -> not (is_eol c)) *> end_of_line - else fail "not a 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 skip_ignored = skip_many (choice [ comment; blank_line ]) - -let identifier = +let item_key = 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 }) - (identifier <* whitespace <* char '=') - value + (fun key value -> Item { key; value }) + (item_key <* whitespace <* char '=') + item_value -let section_header = char '[' *> identifier <* char ']' +let section_header = + char '[' *> item_key <* char ']' >>= fun s -> return (Section_header s) -let section = - lift2 - (fun name items -> { name; items }) - (skip_ignored *> section_header) - (many (skip_ignored *> item)) +let lines = + let line = choice [ blank; comment; section_header; item ] <* end_of_line in + many line <* end_of_input -let config : config Angstrom.t = - many_till (section <* skip_ignored) end_of_input - -let parse_config s = - match parse_string ~consume:Consume.All config s with +let parse s = + match parse_string ~consume:Consume.All lines 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 - -let pp_config ppf (cfg : config) = - let open Fmt in - pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg + 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 + +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; ()