listener working under RNT with a minimal drl

1 files changed, 12 insertions, 17 deletions

diff --git a/lib/configuration.ml b/lib/configuration.ml
index 420dff6..6f45de0 100644
--- a/lib/configuration.ml
+++ b/lib/configuration.ml
@@ -5,14 +5,13 @@ module type CONFIGURABLE = sig
 end
 
 module Error = struct
-  (*
   open Condition
 
   let unknown_section key =
-    condition "unknown-section" "Unknown configuration section" ("key" |=| of_string key)
+    condition "unknown-section" "Unknown configuration section" ("key" |=| Value.String key)
 
   let duplicate_section key =
-    condition "duplicate-section" "Duplicate configuration section" ("key" |=| of_string key)
+    condition "duplicate-section" "Duplicate configuration section" ("key" |=| Value.String key)
 
   let empty_section key =
     condition "empty-section" "Empty configuration section (expected a tagged value)"
@@ -25,11 +24,11 @@ module Error = struct
 
   let invalid_toplevel toplevel =
     condition "invalid-toplevel" "Configuration must be a (server ...) s-expression"
-      ("expression" |=| of_sexp toplevel)
+      ("expression" |=| Value.String (Sexplib.Sexp.to_string toplevel))
 
   let malformed_section expr =
     condition "malformed-section" "Section must be a (tag ...) s-expression"
-      ("expression" |=| of_sexp expr)
+      ("expression" |=| Value.String (Sexplib.Sexp.to_string expr))
 
   let missing_section name =
     condition "missing-section" "Missing section in configuration" ("name" |=| Value.String name)
@@ -38,7 +37,7 @@ module Error = struct
     condition "invalid-tag" "Invalid tag for section"
       ( "section" |=| Value.String section
       & "tag" |=| Value.String tag
-      & "valid-options" |=| of_list Value.String valid_options )
+      & "valid-options" |=| Value.String (String.concat " " valid_options) )
 
   let failed_to_load_file path msg =
     condition "failed-to-load-file" "Failed to load configuration file"
@@ -46,19 +45,15 @@ module Error = struct
 
   let syntax_error path msg =
     condition "syntax-error" "Failed to parse configuration file"
-    ("path" |=| Value.String path & "message" |=| Value.String msg)
- *)
-
+      ("path" |=| Value.String path & "message" |=| Value.String msg)
 end
 
-(*
-
 (** 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
-(
+
 (** Check that [key] is expected and not duplicate, then add it. *)
 let insert_section ~expected acc key body =
   let ( let* ) = Result.bind in
@@ -74,7 +69,7 @@ let insert_section ~expected acc key body =
   | _ -> 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 =
+let parse_server ~expected_keys (sexp : Sexplib.Sexp.t) : (t, Condition.condition) result =
   let open Sexplib.Sexp in
   match sexp with
   | List (Atom "server" :: sections) ->
@@ -91,14 +86,15 @@ let parse_server ~expected_keys (sexp : Sexplib.Sexp.t) : (t, Condition.t) resul
   | _ -> Error (Error.invalid_toplevel sexp)
 
 (** Read a file from disk and run [parse_server] on it. *)
-let load ~expected_keys (path : string) : (t, Condition.t) result =
+let load ~expected_keys (path : string) : (t, Condition.condition) 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)
 
 (** [(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.condition) result =
   let open Sexplib.Sexp in
   match sexp with
   | List (Atom tag :: body) -> Ok (tag, List body)
@@ -106,7 +102,7 @@ let extract_tagged_section (sexp : Sexplib.Sexp.t) : (string * Sexplib.Sexp.t, C
 
 (** Look up a section by name, extract its tag, and check the tag is allowed. *)
 let require_section ~(name : string) ~(valid_tags : string list) (config : t) :
-    (string * Sexplib.Sexp.t, Condition.t) result =
+    (string * Sexplib.Sexp.t, Condition.condition) result =
   let ( let* ) = Result.bind in
   let* sexp = find_section name config |> Option.to_result ~none:(Error.missing_section name) in
   let* tag, body = extract_tagged_section sexp in
@@ -114,4 +110,3 @@ let require_section ~(name : string) ~(valid_tags : string list) (config : t) :
     if List.mem tag valid_tags then Ok () else Error (Error.invalid_tag name tag valid_tags)
   in
   Ok (tag, body)
- *)