src/parse_config.ml

@@ -15,9 +15,9 @@ type section = {
   items: item list;
 }
 
-let fail_with msg =
-  Fmt.epr "Configuration failure: %s.@." msg;
-  exit 1
+let fail fmt =
+  let k _ppf = exit 1 in
+  Fmt.kpf k Fmt.stderr ("Configuration failure: " ^^ fmt ^^ ".@.")
 
 let is_eol = function '\n' | '\r' -> true | _ -> false
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
@@ -55,7 +55,7 @@ module Parse_data = struct
     let quoted_value =
       char '"' *> take_till is_eol >>= fun s ->
       match String.ends_with ~suffix:"\"" s with
-      | false -> fail_with "invalid quoted value"
+      | false -> fail "invalid quoted value"
       | true ->
           let value = String.sub s 0 (String.length s - 1) in
           return value
@@ -76,7 +76,7 @@ module Parse_data = struct
       match l with
       | [] ->
           if List.is_empty item_l then section_l
-          else fail_with "invalid configuration structure"
+          else fail "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 ->
@@ -87,7 +87,7 @@ module Parse_data = struct
 
   let parse s =
     match parse_string ~consume:All config s with
-    | Error msg -> fail_with (Fmt.str "parse error `%s`" msg)
+    | Error msg -> fail "parse error `%s`" msg
     | Ok v -> fold_sections v
 end
 
@@ -130,7 +130,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_with (Fmt.str "expected integer, got `%s`" s)
+    | None -> fail "expected integer, got `%s`" s
     | Some i -> return i
 
   let duration_element =
@@ -144,7 +144,7 @@ module Parse_duration = struct
       | "hour" | "hours" -> return `Hour
       | "minute" | "minutes" -> return `Minute
       | "second" | "seconds" | "s" -> return `Second
-      | s -> fail_with (Fmt.str "expected a duration unit, got `%s`" s)
+      | s -> fail "expected a duration unit, got `%s`" s
     in
     lift2 (fun number dunit -> { number; dunit }) number dunit
 
@@ -164,9 +164,7 @@ module Parse_duration = struct
   let ptime_span_of_int64 i =
     match Ptime.Span.of_float_s (Int64.to_float i) with
     | None ->
-        fail_with
-          (Fmt.str "ptime_span_of_int64 error: `%Ld` is not a valid ptime span"
-             i)
+        fail "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i
     | Some ts -> ts
 
   let to_ptime_span t =
@@ -181,11 +179,11 @@ module Parse_duration = struct
 
   let parse s : duration_element list =
     match parse_string ~consume:All duration s with
-    | Error msg -> fail_with (Fmt.str "duration parse error `%s`" msg)
+    | Error msg -> fail "duration parse error `%s`" msg
     | Ok v -> v
 end
 
-let unwrap_res = function Error e -> fail_with (Fmt.str "`%s`." e) | Ok v -> v
+let unwrap_res = function Error e -> fail "`%s`." e | Ok v -> v
 
 let get_opt t ~section ~field =
   match List.find_opt (fun v -> v.header = section) t with
@@ -197,28 +195,26 @@ let get_opt t ~section ~field =
 
 let get t ~section ~field =
   match get_opt t ~section ~field with
-  | None -> fail_with (Fmt.str "option `[%s].%s` not found" section field)
+  | None -> fail "option `[%s].%s` not found" section field
   | Some v -> v
 
 let int s =
   match int_of_string_opt s with
-  | None -> fail_with (Fmt.str "expected int value, got `%s`" s)
+  | None -> fail "expected int value, got `%s`" s
   | Some v -> v
 
 let float s =
   match float_of_string_opt s with
-  | None -> fail_with (Fmt.str "expected float value, got `%s`" s)
+  | None -> fail "expected float value, got `%s`" s
   | Some v -> v
 
 let const_value a b =
-  match a = b with
-  | false -> fail_with (Fmt.str "unexpected value `%s`" b)
-  | true -> a
+  match a = b with false -> fail "unexpected value `%s`" b | true -> a
 
 let yes_no = function
   | "NO" -> `NO
   | "YES" -> `YES
-  | s -> fail_with (Fmt.str "expected `YES`/`NO` value, got `%s`" s)
+  | s -> fail "expected `YES`/`NO` value, got `%s`" s
 
 let uri s = Uri.of_string s
 let amount s = s |> Amount.of_string |> unwrap_res
@@ -238,7 +234,7 @@ module Parse_alt_unit_names = struct
     match
       String.starts_with ~prefix:"{" s && String.ends_with ~suffix:"}" s
     with
-    | false -> fail_with (Fmt.str "expected json, got `%s`" s)
+    | false -> fail "expected json, got `%s`" s
     | true ->
         let s = String.sub s 1 (String.length s - 2) in
         s
@@ -248,7 +244,7 @@ module Parse_alt_unit_names = struct
     match
       String.starts_with ~prefix:"\"" s && String.ends_with ~suffix:"\"" s
     with
-    | false -> fail_with (Fmt.str "expected quoted string, got `%s`" s)
+    | false -> fail "expected quoted string, got `%s`" s
     | true ->
         let s = String.sub s 1 (String.length s - 2) in
         s
@@ -259,17 +255,15 @@ module Parse_alt_unit_names = struct
     |> List.map (String.split_on_char ':')
     |> List.map (function
       | [ k; v ] -> (k, v)
-      | _ -> fail_with "invalid json key-value map")
+      | _ -> fail "invalid json key-value map")
     |> List.map (fun (k, v) ->
         let k = rm_quotes k in
         let v = rm_quotes v in
         let k =
           match int_of_string_opt k with
           | None ->
-              fail_with
-                (Fmt.str
-                   "invalid json key-value map, expected integer key, got `%s`"
-                   k)
+              fail "invalid json key-value map, expected integer key, got `%s`"
+                k
           | Some k -> k
         in
         (k, v))