better parse_config

This commit is contained in:
swrup 2025-11-20 19:02:28 +01:00
parent f55a6eb4a5
commit 51e5a06cb0

View file

@ -6,7 +6,6 @@
(* TODO
- do all config section
- parse alt_unit_names json pair
- better failure handling/error msg
*)
open Angstrom
@ -21,6 +20,10 @@ type section = {
items: item list;
}
let fail_with msg =
Fmt.epr "Failed to parse configuration: %s." msg;
exit 1
let is_eol = function '\n' | '\r' -> true | _ -> false
let is_whitespace = function ' ' | '\t' -> true | _ -> false
let whitespace = skip_while is_whitespace
@ -57,7 +60,7 @@ module Parse_file = struct
let quoted_value =
char '"' *> take_till is_eol >>= fun s ->
match String.ends_with ~suffix:"\"" s with
| false -> fail "invalid quoted value"
| false -> fail_with "invalid quoted value"
| true ->
let value = String.sub s 0 (String.length s - 1) in
return value
@ -78,7 +81,7 @@ module Parse_file = struct
match l with
| [] ->
if List.is_empty item_l then section_l
else Fmt.failwith "invalid config structure"
else fail_with "invalid configuration structure"
| Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
| Item item :: tl -> loop section_l (item :: item_l) tl
| Header header :: tl ->
@ -89,7 +92,7 @@ module Parse_file = struct
let parse_content s =
match parse_string ~consume:All config s with
| Error msg -> Fmt.failwith "config parse error: %s" msg
| Error msg -> fail_with (Fmt.str "parse error `%s`" msg)
| Ok v -> fold_sections v
end
@ -132,7 +135,7 @@ module Parse_duration = struct
let integer =
take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
match int_of_string_opt s with
| None -> fail "not an integer"
| None -> fail_with (Fmt.str "expected integer, got `%s`" s)
| Some i -> return i
let duration_element =
@ -146,7 +149,7 @@ module Parse_duration = struct
| "hour" | "hours" -> return `Hour
| "minute" | "minutes" -> return `Minute
| "second" | "seconds" | "s" -> return `Second
| _ -> fail "not a valid duration unit"
| s -> fail_with (Fmt.str "expected a duration unit, got `%s`" s)
in
lift2 (fun number dunit -> { number; dunit }) number dunit
@ -166,8 +169,9 @@ module Parse_duration = struct
let ptime_span_of_int64 i =
match Ptime.Span.of_float_s (Int64.to_float i) with
| None ->
Fmt.failwith
"ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i
fail_with
(Fmt.str "ptime_span_of_int64 error: `%Ld` is not a valid ptime span"
i)
| Some ts -> ts
let to_ptime_span t =
@ -182,13 +186,11 @@ module Parse_duration = struct
let parse s : duration_element list =
match parse_string ~consume:All duration s with
| Error msg -> Fmt.failwith "duration parse error: %s" msg
| Error msg -> fail_with (Fmt.str "duration parse error `%s`" msg)
| Ok v -> v
end
let unwrap_res = function
| Error e -> Fmt.failwith "Config failure: `%s`." e
| Ok v -> v
let unwrap_res = function Error e -> fail_with (Fmt.str "`%s`." e) | Ok v -> v
let get_opt t ~section ~field =
match List.find_opt (fun v -> v.header = section) t with
@ -200,29 +202,28 @@ let get_opt t ~section ~field =
let get t ~section ~field =
match get_opt t ~section ~field with
| None ->
Fmt.failwith "Config failure, option `[%s].%s` not found." section field
| None -> fail_with (Fmt.str "option `[%s].%s` not found" section field)
| Some v -> v
let int v =
match int_of_string_opt v with
| None -> Fmt.failwith "expected int value, got `%s`." v
| None -> fail_with (Fmt.str "expected int value, got `%s`" v)
| Some v -> v
let float v =
match float_of_string_opt v with
| None -> Fmt.failwith "expected float value, got `%s`." v
| None -> fail_with (Fmt.str "expected float value, got `%s`" v)
| Some v -> v
let const_value a b =
match a = b with
| false -> Fmt.failwith "unexpected value `%s`." b
| false -> fail_with (Fmt.str "unexpected value `%s`" b)
| true -> a
let yes_no = function
| "NO" -> `NO
| "YES" -> `YES
| s -> Fmt.failwith "invalid value `%s`, expected `NO` or `YES`." s
| s -> fail_with (Fmt.str "expected `YES`/`NO` value, got `%s`" s)
let amount v = v |> Amount.of_string |> unwrap_res
let duration v = Parse_duration.(v |> parse |> to_ptime_span)