Format

1 files changed, 53 insertions, 51 deletions

diff --git a/lib/configuration.ml b/lib/configuration.ml
index 12a3681..af1635f 100644
--- a/lib/configuration.ml
+++ b/lib/configuration.ml
@@ -6,34 +6,50 @@ end
 
 module Error = struct
   open Condition
-  let unknown_section key = condition "unknown-section" "Unknown configuration section"
-                              ("key" |=| (of_string key))
-  let duplicate_section key = condition "duplicate-section" "Duplicate configuration section"
-                                ("key" |=| (of_string key))
-  let empty_section key = condition "empty-section" "Empty configuration section (expected a tagged value)"
-                            ("key" |=| (of_string key))
-  let multiple_values_in_section key = condition "multiple-values-in-section" "Configuration section contains multiple values (expected exactly one)"
-                                         ("key" |=| (of_string key))
-  let invalid_toplevel toplevel = condition "invalid-toplevel" "Configuration must be a (server ...) s-expression"
-                                    ("expression" |=| (of_sexp toplevel))
-  let malformed_section expr = condition "malformed-section" "Section must be a (tag ...) s-expression"
-                                 ("expression" |=| (of_sexp expr))
-  let missing_section name = condition "missing-section" "Missing section in configuration"
-                               ("name" |=| (of_string name))
-  let invalid_tag section tag valid_options = condition "invalid-tag" "Invalid tag for section"
-                                                ("section" |=| (of_string section) &
-                                                 "tag" |=| (of_string tag) &
-                                                 "valid-options" |=| (of_list of_string valid_options))
-  let failed_to_load_file path msg = condition "failed-to-load-file" "Failed to load configuration file"
-                                       ("path" |=| (of_string path) &
-                                        "message" |=| (of_string msg))
-  let syntax_error path msg = condition "syntax-error" "Failed to parse configuration file"
-                                ("path" |=| (of_string path) &
-                                 "message" |=| (of_string msg))
+
+  let unknown_section key =
+    condition "unknown-section" "Unknown configuration section" ("key" |=| of_string key)
+
+  let duplicate_section key =
+    condition "duplicate-section" "Duplicate configuration section" ("key" |=| of_string key)
+
+  let empty_section key =
+    condition "empty-section" "Empty configuration section (expected a tagged value)"
+      ("key" |=| of_string key)
+
+  let multiple_values_in_section key =
+    condition "multiple-values-in-section"
+      "Configuration section contains multiple values (expected exactly one)"
+      ("key" |=| of_string key)
+
+  let invalid_toplevel toplevel =
+    condition "invalid-toplevel" "Configuration must be a (server ...) s-expression"
+      ("expression" |=| of_sexp toplevel)
+
+  let malformed_section expr =
+    condition "malformed-section" "Section must be a (tag ...) s-expression"
+      ("expression" |=| of_sexp expr)
+
+  let missing_section name =
+    condition "missing-section" "Missing section in configuration" ("name" |=| of_string name)
+
+  let invalid_tag section tag valid_options =
+    condition "invalid-tag" "Invalid tag for section"
+      ( "section" |=| of_string section
+      & "tag" |=| of_string tag
+      & "valid-options" |=| of_list of_string valid_options )
+
+  let failed_to_load_file path msg =
+    condition "failed-to-load-file" "Failed to load configuration file"
+      ("path" |=| of_string path & "message" |=| of_string msg)
+
+  let syntax_error path msg =
+    condition "syntax-error" "Failed to parse configuration file"
+      ("path" |=| of_string path & "message" |=| of_string msg)
 end
 
-type t = Sexplib.Sexp.t Utilities.StringMap.t
 (** Section name -> raw sexp subtree. *)
+type t = Sexplib.Sexp.t Utilities.StringMap.t
 
 let find_section (key : string) (config : t) : Sexplib.Sexp.t option =
   Utilities.StringMap.find_opt key config
@@ -42,20 +58,15 @@ let find_section (key : string) (config : t) : Sexplib.Sexp.t option =
 let insert_section ~expected acc key body =
   let ( let* ) = Result.bind in
   let* () =
-    if Utilities.StringSet.mem key expected then Ok ()
-    else Error (Error.unknown_section key)
+    if Utilities.StringSet.mem key expected then Ok () else Error (Error.unknown_section key)
   in
   let* () =
-    if Utilities.StringMap.mem key acc then
-      Error (Error.duplicate_section key)
-    else Ok ()
+    if Utilities.StringMap.mem key acc then Error (Error.duplicate_section key) else Ok ()
   in
   match body with
-  | [ subtree ] -> Ok (Utilities.StringMap.add key subtree acc)
-  | [] ->
-     Error (Error.empty_section key)
-  | _ ->
-     Error (Error.multiple_values_in_section key)
+  | [subtree] -> Ok (Utilities.StringMap.add key subtree acc)
+  | [] -> Error (Error.empty_section key)
+  | _ -> Error (Error.multiple_values_in_section key)
 
 (** [(server ...)] sexp -> section map. Rejects unknown/duplicate keys. *)
 let parse_server ~expected_keys (sexp : Sexplib.Sexp.t) : (t, Condition.t) result =
@@ -63,16 +74,13 @@ let parse_server ~expected_keys (sexp : Sexplib.Sexp.t) : (t, Condition.t) resul
   match sexp with
   | List (Atom "server" :: sections) ->
       let expected =
-        List.fold_right Utilities.StringSet.add expected_keys
-          Utilities.StringSet.empty
+        List.fold_right Utilities.StringSet.add expected_keys Utilities.StringSet.empty
       in
       let rec go acc = function
         | [] -> Ok acc
         | List (Atom key :: body) :: rest ->
-            Result.bind (insert_section ~expected acc key body) (fun acc ->
-                go acc rest)
-        | bad :: _ ->
-            Error (Error.malformed_section bad)
+            Result.bind (insert_section ~expected acc key body) (fun acc -> go acc rest)
+        | bad :: _ -> Error (Error.malformed_section bad)
       in
       go Utilities.StringMap.empty sections
   | _ -> Error (Error.invalid_toplevel sexp)
@@ -81,14 +89,11 @@ let parse_server ~expected_keys (sexp : Sexplib.Sexp.t) : (t, Condition.t) resul
 let load ~expected_keys (path : string) : (t, Condition.t) result =
   match Sexplib.Sexp.load_sexp path with
   | sexp -> parse_server ~expected_keys sexp
-  | exception Sys_error msg ->
-     Error (Error.failed_to_load_file path msg)
-  | exception Failure msg ->
-     Error (Error.syntax_error path msg)
+  | exception Sys_error msg -> Error (Error.failed_to_load_file path msg)
+  | exception Failure msg -> Error (Error.syntax_error path msg)
 
 (** [(tag field1 ...)] -> [(tag, List [field1; ...])]. *)
-let extract_tagged_section (sexp : Sexplib.Sexp.t) :
-    (string * Sexplib.Sexp.t, Condition.t) result =
+let extract_tagged_section (sexp : Sexplib.Sexp.t) : (string * Sexplib.Sexp.t, Condition.t) result =
   let open Sexplib.Sexp in
   match sexp with
   | List (Atom tag :: body) -> Ok (tag, List body)
@@ -98,10 +103,7 @@ let extract_tagged_section (sexp : Sexplib.Sexp.t) :
 let require_section ~(name : string) ~(valid_tags : string list) (config : t) :
     (string * Sexplib.Sexp.t, Condition.t) result =
   let ( let* ) = Result.bind in
-  let* sexp =
-    find_section name config
-    |> Option.to_result ~none:(Error.missing_section name)
-  in
+  let* sexp = find_section name config |> Option.to_result ~none:(Error.missing_section name) in
   let* tag, body = extract_tagged_section sexp in
   let* () =
     if List.mem tag valid_tags then Ok () else Error (Error.invalid_tag name tag valid_tags)