diff --git a/default.config b/default.config index 030410fe..7f586cae 100644 --- a/default.config +++ b/default.config @@ -1,10 +1,17 @@ +# comment 1 +# foo +# barr [currency-EUR] enabled = NO + # comment 2 code= "EUR" name =euro fractional_input_digits = 2 fractional_normal_digits =2 fractional_trailing_zero_digits= 2 + % comment 3 alt_unit_names = "{"0":"€","3":"k€"}" -# comment 1 -# comment 2 +% comment 4 + +[dummy-section] +dummy = "blah" diff --git a/include/parse_config.ml b/include/parse_config.ml index 45fba881..6f9330dc 100644 --- a/include/parse_config.ml +++ b/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