diff --git a/include/parse_config.ml b/include/parse_config.ml index 59ab359b..599f4231 100644 --- a/include/parse_config.ml +++ b/include/parse_config.ml @@ -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)