better parse_config
This commit is contained in:
parent
f55a6eb4a5
commit
51e5a06cb0
1 changed files with 19 additions and 18 deletions
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue