share the condition check and employee fixture across tests

3 files changed, 17 insertions, 47 deletions

diff --git a/test/unit/kernel/Branch.ml b/test/unit/kernel/Branch.ml
index 10789cd..e229ed7 100644
--- a/test/unit/kernel/Branch.ml
+++ b/test/unit/kernel/Branch.ml
@@ -238,13 +238,8 @@ let a_denial_without_end_cannot_be_installed () =
   let root = fresh [] in
   with_toys root;
   let endless = K.EphemeralRelation.of_program title (toy_program "toys:toy" "endless") in
-  match
-    K.Scope.publish root ~branch:"master" ~home:library ~denials:["endless", Some endless] []
-  with
-  | Ok () -> fail "a denial without end was installed"
-  | Error condition ->
-      check bool "the state holding it cannot be judged" true
-        (BatString.starts_with (C.Condition.to_string_hum condition) "unjudgeable-denial")
+  Helpers.refuses "the state holding it cannot be judged" "unjudgeable-denial"
+    (K.Scope.publish root ~branch:"master" ~home:library ~denials:["endless", Some endless] [])
 
 let a_denial_program_runs_once_per_judgement () =
   let root = fresh [] in
diff --git a/test/unit/kernel/EphemeralRelation.ml b/test/unit/kernel/EphemeralRelation.ml
index 9426b9a..5c85d7f 100644
--- a/test/unit/kernel/EphemeralRelation.ml
+++ b/test/unit/kernel/EphemeralRelation.ml
@@ -69,16 +69,10 @@ let decides_membership () =
   check bool "a stranger is refused" false rejects
 
 let refuses_to_scan_without_end () =
-  match Protocols.Relation.require (endless ()) with
-  | Error condition -> fail (Concepts.Condition.to_string_hum condition)
-  | Ok relation -> (
-    match Protocols.Relation.contains relation (member 9) with
-    | Error condition ->
-        check bool "it fails as undecidable instead of scanning" true
-          (BatString.starts_with
-             (Concepts.Condition.to_string_hum condition)
-             "undecidable-membership" )
-    | Ok _ -> fail "an endless relation with no test decided membership" )
+  Helpers.refuses "it fails as undecidable instead of scanning" "undecidable-membership"
+    (Result.bind
+       (Protocols.Relation.require (endless ()))
+       (fun relation -> Protocols.Relation.contains relation (member 9)) )
 
 let describes_itself () =
   let described =
diff --git a/test/unit/kernel/SubstantialRelation.ml b/test/unit/kernel/SubstantialRelation.ml
index 20eb163..c1c4bf5 100644
--- a/test/unit/kernel/SubstantialRelation.ml
+++ b/test/unit/kernel/SubstantialRelation.ml
@@ -5,12 +5,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
   module H = Helpers.Storage.Make (S) (C)
   module SR = Rnt.Kernel.SubstantialRelation.Make (S)
 
-  let alaric =
-    { Concepts.Tuple.type_= "employee";
-      attributes=
-        BatMap.String.empty
-        |> BatMap.String.add "name" (Concepts.Value.String "Alaric")
-        |> BatMap.String.add "age" (Concepts.Value.Integer 42) }
+  let alaric = Helpers.employee "Alaric" 42
 
   let contains relation tuple =
     let open Utilities.Result in
@@ -50,23 +45,13 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
          enumerated )
 
   let refuse_a_tuple_off_its_heading conn =
-    let refused name attributes =
-      match H.relation conn ["name"; "age"] [{alaric with attributes}] with
-      | Error condition -> BatString.starts_with (Concepts.Condition.to_string_hum condition) name
-      | Ok _ -> false
+    let refused message name attributes =
+      Helpers.refuses message name (H.relation conn ["name"; "age"] [{alaric with attributes}])
     in
-    check bool "a tuple lacking an attribute is refused" true
-      (refused "missing-attribute" (BatMap.String.remove "name" alaric.attributes));
-    check bool "a tuple with an attribute too many is refused" true
-      (refused "unexpected-attribute"
-         (BatMap.String.add "salary" (Concepts.Value.Integer 1) alaric.attributes) )
-
-  let employee name age =
-    { Concepts.Tuple.type_= "employee";
-      attributes=
-        BatMap.String.empty
-        |> BatMap.String.add "name" (Concepts.Value.String name)
-        |> BatMap.String.add "age" (Concepts.Value.Integer age) }
+    refused "a tuple lacking an attribute is refused" "missing-attribute"
+      (BatMap.String.remove "name" alaric.attributes);
+    refused "a tuple with an attribute too many is refused" "unexpected-attribute"
+      (BatMap.String.add "salary" (Concepts.Value.Integer 1) alaric.attributes)
 
   let look_up_by_one_attribute conn =
     let names relation attribute value =
@@ -84,7 +69,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
         let open Utilities.Result in
         let* relation =
           H.relation conn ["name"; "age"]
-            [employee "Alaric" 42; employee "Brunhild" 30; employee "Gunther" 42]
+            Helpers.[employee "Alaric" 42; employee "Brunhild" 30; employee "Gunther" 42]
         in
         let* indexed = Protocols.Indexed.require relation in
         let* aged = names relation "age" (Concepts.Value.Integer 42) in
@@ -102,13 +87,9 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       [s "Alaric"; s "Gunther"]
       aged;
     check (list Helpers.value) "a string finds the tuple holding it" [s "Brunhild"] named;
-    check (list Helpers.value) "an integer is not a prefix of a longer one" [] unaged;
-    check (list Helpers.value) "a string is not a prefix of a longer one" [] prefixed;
-    check bool "an attribute without an index is refused" true
-      ( match unindexed with
-      | Error condition ->
-          BatString.starts_with (Concepts.Condition.to_string_hum condition) "unindexed-attribute"
-      | Ok _ -> false )
+    check (list Helpers.value) "an integer finds nothing under a longer one" [] unaged;
+    check (list Helpers.value) "a string finds nothing under a longer one" [] prefixed;
+    Helpers.refuses "an attribute without an index is refused" "unindexed-attribute" unindexed
 
   let suite =
     ( "kernel/substantial-relation",