fol evaluator

2 files changed, 102 insertions, 20 deletions

diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
new file mode 100644
index 0000000..32f09f5
--- /dev/null
+++ b/test/unit/evaluators/FOL.ml
@@ -0,0 +1,71 @@
+open Rnt
+
+module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct
+  open Alcotest
+
+  module H = Helpers.Storage.Make (S) (C)
+  module SR = Rnt.Kernel.SubstantialRelation.Make (S)
+
+  let hash s =
+    Concepts.Blob.blob_of_bytes (Bytes.of_string s) |> Concepts.Hash.hash_of_blob
+
+  let alaric =
+    { Concepts.Tuple.type_ = "employee";
+      attributes =
+        BatMap.String.empty
+        |> BatMap.String.add "name" (Concepts.Value.String "Alaric") }
+
+  let not_a_program () =
+    Concepts.Condition.condition "not-a-program"
+      "A handle was expected to carry the program protocol and did not" Concepts.Condition.empty
+
+  let scan_a_base_relation conn =
+    let scanned =
+      begin
+        let open Utilities.Result in
+        let* tx = S.start conn in
+        let* relation = SR.empty tx ~schematics:(hash "schema") () in
+        let* relation =
+          SR.assert_tuple tx relation (Concepts.Tuple.Representation.to_blob alaric)
+        in
+        let* () = S.commit tx in
+        let* employee = SR.wrap conn relation in
+        let root =
+          Kernel.Prototype.mixture
+            [ Kernel.Prototype.Directory.of_properties
+                ["employee", employee; "fol", Rnt.Evaluators.FOL.make ()] ]
+        in
+        let context = Runtime.Context.over ~snapshot:(hash "snapshot") ~root () in
+        let* found = Runtime.Context.resolve context "fol" in
+        let* evaluator = Option.to_result ~none:(not_a_program ()) found in
+        let* interpreter =
+          Rnt.Evaluators.FOL.Program.from evaluator
+          |> Option.to_result ~none:(not_a_program ())
+        in
+        let* cursor =
+          Rnt.Evaluators.FOL.Program.invoke interpreter
+            ~program:(Rnt.Evaluators.FOL.Base "employee") context
+        in
+        let* scan = Protocols.Cursor.require cursor in
+        let* tuples = Protocols.Cursor.drain scan () in
+        Protocols.Handle.release cursor;
+        Ok (BatFingerTree.to_list tuples)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check int "one tuple scanned" 1 (List.length scanned);
+    check bool "the tuple that was asserted" true
+      (List.for_all
+         (fun tuple ->
+           Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash alaric))
+         scanned)
+
+  let suite prefix =
+    ( "fol/" ^ prefix,
+      [test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test")]
+    )
+end
+
+module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
+
+let suites () = [LMDB.suite "lmdb"]
diff --git a/test/unit/kernel/SubstantialRelation.ml b/test/unit/kernel/SubstantialRelation.ml
index e113a8c..9d60685 100644
--- a/test/unit/kernel/SubstantialRelation.ml
+++ b/test/unit/kernel/SubstantialRelation.ml
@@ -6,37 +6,48 @@ 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 blob s = Concepts.Blob.blob_of_bytes (Bytes.of_string s)
-  let hash s = blob s |> Concepts.Hash.hash_of_blob
+  let hash s =
+    Concepts.Blob.blob_of_bytes (Bytes.of_string s) |> Concepts.Hash.hash_of_blob
 
-  let assert_and_load conn =
-    let tuple = blob "tuple/alaric" in
-    let original_contains, updated_contains, loaded_contains =
+  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 assert_and_enumerate conn =
+    let tuple = Concepts.Tuple.Representation.to_blob alaric in
+    let before, after, enumerated =
       begin
         let open Utilities.Result in
         let* tx = S.start conn in
-        let* original = SR.empty tx ~schematics:(hash "schema") () in
-        let* original_contains = SR.contains_tuple tx original tuple in
-        let* updated = SR.assert_tuple tx original tuple in
-        let* updated_contains = SR.contains_tuple tx updated tuple in
-        let* stored = SR.store tx updated in
+        let* relation = SR.empty tx ~schematics:(hash "schema") () in
+        let* before = SR.contains_tuple tx relation tuple in
+        let* relation = SR.assert_tuple tx relation tuple in
+        let* after = SR.contains_tuple tx relation tuple in
         let* () = S.commit tx in
-        let* tx = S.start conn in
-        let* loaded = SR.load_value tx stored in
-        let* loaded_contains = SR.contains_tuple tx loaded tuple in
-        let* () = S.abort tx in
-        Ok (original_contains, updated_contains, loaded_contains)
+        let* cursor = SR.enumerate conn relation in
+        let* scan = Protocols.Cursor.require cursor in
+        let* enumerated = Protocols.Cursor.drain scan () in
+        Protocols.Handle.release cursor;
+        Ok (before, after, BatFingerTree.to_list enumerated)
       end
       |> Helpers.condition_as_failure
     in
-    check bool "original" false original_contains;
-    check bool "updated" true updated_contains;
-    check bool "loaded" true loaded_contains
+    check bool "absent before assertion" false before;
+    check bool "present after assertion" true after;
+    check int "one tuple enumerated" 1 (List.length enumerated);
+    check bool "the tuple that was asserted" true
+      (List.for_all
+         (fun tuple ->
+           Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash alaric))
+         enumerated)
 
   let suite prefix =
     ( "substantial-relation/" ^ prefix,
-      [ test_case "assert-and-load" `Quick
-          (H.with_connection assert_and_load "substantial-relation-test") ] )
+      [ test_case "assert-and-enumerate" `Quick
+          (H.with_connection assert_and_enumerate "substantial-relation-test") ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)