This commit is contained in:
swrup 2025-10-13 09:05:13 +02:00
parent c366324beb
commit 5f86d848e7
2 changed files with 45 additions and 81 deletions

View file

@ -1,10 +1,17 @@
# comment 1
# foo
# barr
[currency-EUR] [currency-EUR]
enabled = NO enabled = NO
# comment 2
code= "EUR" code= "EUR"
name =euro name =euro
fractional_input_digits = 2 fractional_input_digits = 2
fractional_normal_digits =2 fractional_normal_digits =2
fractional_trailing_zero_digits= 2 fractional_trailing_zero_digits= 2
% comment 3
alt_unit_names = "{"0":"€","3":"k€"}" alt_unit_names = "{"0":"€","3":"k€"}"
# comment 1 % comment 4
# comment 2
[dummy-section]
dummy = "blah"

View file

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