share the condition check and employee fixture across tests

1 files changed, 12 insertions, 33 deletions

diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index ce8a2cd..1e3c316 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -9,11 +9,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       attributes= BatMap.String.empty |> BatMap.String.add "name" (Concepts.Value.String "Alaric")
     }
 
-  let employee name age =
-    { Concepts.Tuple.type_= "employee";
-      attributes=
-        BatMap.String.of_list ["name", Concepts.Value.String name; "age", Concepts.Value.Integer age]
-    }
+  let employee = Helpers.employee
 
   let named name =
     { Concepts.Tuple.type_= "employee";
@@ -152,7 +148,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (bindings projected)
 
   let refuse_a_program_that_reads_itself conn =
-    let expanded =
+    Helpers.refuses "the expansion stopped at the cycle" "cyclic-program"
       begin
         let open Utilities.Result in
         let stored_path = Kernel.Path.("stored" @/ this) in
@@ -160,12 +156,6 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
         let* root = namespace ["stored", stored] in
         Rnt.Evaluators.FOL.(instantiate root (Base stored_path))
       end
-    in
-    check bool "the expansion stopped at the cycle" true
-      ( match expanded with
-      | Error condition ->
-          BatString.starts_with (Concepts.Condition.to_string_hum condition) "cyclic-program"
-      | Ok _ -> false )
 
   let shape modes =
     List.map
@@ -363,19 +353,15 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       (bindings found)
 
   let refuse_a_restriction_on_a_missing_attribute conn =
-    let refused term =
-      match
-        let open Utilities.Result in
-        let* relation = H.relation conn ["name"; "age"] staff in
-        eval (directory ["employee", relation]) term
-      with
-      | Error condition ->
-          BatString.starts_with (Concepts.Condition.to_string_hum condition) "unknown-attribute"
-      | Ok result -> Protocols.Handle.release result; false
+    let refused message term =
+      Helpers.refuses message "unknown-attribute"
+        (Result.bind
+           (H.relation conn ["name"; "age"] staff)
+           (fun relation -> eval (directory ["employee", relation]) term) )
     in
-    check bool "an attribute the relation lacks" true
-      (refused (F.Where (employees, BatMap.String.singleton "salary" (Concepts.Value.Integer 1))));
-    check bool "an attribute projected away" true (refused (F.Where (names, aged 42)))
+    refused "an attribute the relation lacks"
+      (F.Where (employees, BatMap.String.singleton "salary" (Concepts.Value.Integer 1)));
+    refused "an attribute projected away" (F.Where (names, aged 42))
 
   let counter ?(produced = ref 0) ?(closed = ref false) () =
     let description =
@@ -412,7 +398,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check bool "and was closed with its consumer" true !closed
 
   let an_endless_projection_cannot_decide () =
-    let asked =
+    Helpers.refuses "it fails as undecidable instead of reading without end"
+      "undecidable-membership"
       begin
         let open Utilities.Result in
         let* result = values (counter ()) in
@@ -421,14 +408,6 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           { Concepts.Tuple.type_= "counter";
             attributes= BatMap.String.singleton "value" (Concepts.Value.Integer 7) }
       end
-    in
-    check bool "it fails as undecidable instead of reading without end" true
-      ( match asked with
-      | Error condition ->
-          BatString.starts_with
-            (Concepts.Condition.to_string_hum condition)
-            "undecidable-membership"
-      | Ok _ -> false )
 
   let a_result_owns_the_relations_of_its_plan () =
     let released = ref false in