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
+        fail_with
-          "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i
+          (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
+let unwrap_res = function Error e -> fail_with (Fmt.str "`%s`." e) | Ok v -> v
-  | Error e -> Fmt.failwith "Config failure: `%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 ->
+  | None -> fail_with (Fmt.str "option `[%s].%s` not found" section field)
-      Fmt.failwith "Config failure, 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)