share the condition check and employee fixture across tests

1 files changed, 11 insertions, 30 deletions

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",