1 files changed, 94 insertions, 25 deletions

diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index 404e7a4..046fa3f 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -3,7 +3,6 @@ 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 alaric =
     { Concepts.Tuple.type_= "employee";
@@ -14,20 +13,31 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     Concepts.Condition.condition "not-a-directory"
       "A handle was expected to carry the directory protocol and did not" Concepts.Condition.empty
 
-  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 missing name =
+    Concepts.Condition.condition "missing" "A name was expected in the directory and was absent"
+      Concepts.Condition.("name" |=| Concepts.Value.String name)
+
+  let employee name age =
+    { Concepts.Tuple.type_= "employee";
+      attributes=
+        BatMap.String.of_list ["name", Concepts.Value.String name; "age", Concepts.Value.Integer age]
+    }
+
+  let drain result =
+    let open Utilities.Result in
+    let* enumerable = Protocols.Enumerable.require result in
+    let* cursor = Protocols.Enumerable.enumerate enumerable in
+    let* scan = Protocols.Cursor.require cursor in
+    let* tuples = Protocols.Cursor.drain scan () in
+    Protocols.Handle.release cursor;
+    Protocols.Handle.release result;
+    Ok (BatFingerTree.to_list tuples)
 
   let scan_a_base_relation conn =
     let scanned =
       begin
         let open Utilities.Result in
-        let* tx = S.start conn in
-        let* schematics = H.store_schema tx ["name"] in
-        let* relation = SR.empty tx ~schematics () in
-        let* relation = SR.assert_tuple tx relation alaric in
-        let* () = S.commit tx in
-        let* employee = SR.wrap conn relation in
+        let* employee = H.relation conn ["name"] [alaric] in
         let root =
           Kernel.Prototype.mixture
             [ Kernel.Prototype.Directory.of_properties
@@ -37,17 +47,12 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
           Protocols.Directory.from root |> Option.to_result ~none:(not_a_directory ())
         in
         let* found = Protocols.Directory.find directory "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 ())
+        let* evaluator = Option.to_result ~none:(missing "fol") found in
+        let* evaluator = Protocols.Evaluator.require evaluator in
+        let* result =
+          Rnt.Evaluators.FOL.(program (Base employee)) |> Protocols.Evaluator.invoke evaluator
         in
-        let* cursor =
-          Rnt.Evaluators.FOL.Program.invoke interpreter (Rnt.Evaluators.FOL.Base employee)
-        in
-        let* scan = Protocols.Cursor.require cursor in
-        let* tuples = Protocols.Cursor.drain scan () in
-        Protocols.Handle.release cursor;
-        Ok (BatFingerTree.to_list tuples)
+        drain result
       end
       |> Helpers.condition_as_failure
     in
@@ -58,12 +63,76 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
            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")]
-    )
+  let project_away_an_attribute conn =
+    let projected =
+      begin
+        let open Utilities.Result in
+        let* employees =
+          H.relation conn ["name"; "age"]
+            [employee "Alaric" 42; employee "Alaric" 30; employee "Brunhild" 42]
+        in
+        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+        let* result =
+          Rnt.Evaluators.FOL.(program (Project (Base employees, BatFingerTree.singleton "name")))
+          |> Protocols.Evaluator.invoke evaluator
+        in
+        drain result
+      end
+      |> Helpers.condition_as_failure
+    in
+    check
+      (list (list (pair string Helpers.value)))
+      "each name once, and nothing else"
+      [["name", Concepts.Value.String "Alaric"]; ["name", Concepts.Value.String "Brunhild"]]
+      ( projected
+      |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes)
+      |> List.sort compare )
+
+  let pull_one_tuple_at_a_time () =
+    let produced = ref 0 and closed = ref false in
+    let description =
+      BatMap.String.singleton "value" {Protocols.Schematics.domain= "integer"; provenance= []}
+    in
+    let rec count ~yield n =
+      incr produced;
+      yield
+        { Concepts.Tuple.type_= "counter";
+          attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) };
+      count ~yield (n + 1)
+    in
+    let source =
+      Kernel.EphemeralRelation.instantiate description
+        {Kernel.EphemeralRelation.schematics= `Temporary description}
+        (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
+    in
+    let first =
+      begin
+        let open Utilities.Result in
+        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+        let* result =
+          Rnt.Evaluators.FOL.(program (Project (Base source, BatFingerTree.singleton "value")))
+          |> Protocols.Evaluator.invoke evaluator
+        in
+        let* enumerable = Protocols.Enumerable.require result in
+        let* cursor = Protocols.Enumerable.enumerate enumerable in
+        let* scan = Protocols.Cursor.require cursor in
+        let* first = Protocols.Cursor.next scan in
+        Protocols.Handle.release cursor; Protocols.Handle.release result; Ok first
+      end
+      |> Helpers.condition_as_failure
+    in
+    check bool "a tuple came through" true (Option.is_some first);
+    check int "the source produced only that tuple" 1 !produced;
+    check bool "and was closed with its consumer" true !closed
+
+  let suite =
+    ( "evaluators/fol",
+      [ test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test");
+        test_case "project-away-an-attribute" `Quick
+          (H.with_connection project_away_an_attribute "fol-test");
+        test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
 
-let suites () = [LMDB.suite "lmdb"]
+let suites () = [LMDB.suite]