Merge branch 'relation-bipartite-registration'

4 files changed, 145 insertions, 15 deletions

diff --git a/test/Helpers.ml b/test/Helpers.ml
index 7f65007..f812a3a 100644
--- a/test/Helpers.ml
+++ b/test/Helpers.ml
@@ -51,7 +51,9 @@ module Storage = struct
                   SR.TupleSet.insert tx (Concepts.Tuple.hash tuple) tuple node )
                 (Ok SR.TupleSet.empty) tuples
             in
-            Ok {SR.schematics; tuples= SR.TupleSet.hash_of node} )
+            let relation = {SR.schematics; tuples= SR.TupleSet.hash_of node} in
+            let* _ = SI.store_blob tx (SR.encode relation) in
+            Ok relation )
       in
       SR.load conn value
 
diff --git a/test/integration/Registration.ml b/test/integration/Registration.ml
index 60f1690..693435b 100644
--- a/test/integration/Registration.ml
+++ b/test/integration/Registration.ml
@@ -6,12 +6,28 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
   module I = Kernel.Initialization.Make (S)
   module B = Kernel.Branch.Make (S)
   module M = Kernel.Multigroup.Make (S)
+  module R = Kernel.SubstantialRelation.Make (S)
+  module E = Kernel.EphemeralRelation.Make (S)
+
+  let book = Kernel.Path.("multigroup" @/ "library" @/ "relation" @/ "book" @/ this)
+  let shelf = Kernel.Path.("multigroup" @/ "library" @/ "relation" @/ "shelf" @/ this)
 
   let run conn =
     let open Utilities.Result in
     begin
       let* root = I.initialize ~evaluators:["fol", Evaluators.FOL.make ()] conn in
       let* multigroup = M.make conn in
+      let* schematics = H.SI.with_transaction conn (fun tx -> H.store_schema tx ["title"]) in
+      let* relation = R.instantiate conn ~schematics in
+      let* multigroup =
+        Kernel.Path.(assoc multigroup ("relation" @/ this) "book" (Some relation))
+      in
+      let* view =
+        E.persist conn ~name:"shelf" ~evaluator:Evaluators.FOL.name
+          ~code:Evaluators.FOL.(encode (Project (Base book, BatFingerTree.singleton "title")))
+          (BatMap.String.singleton "title" {Protocols.Schematics.domain= "string"; provenance= []})
+      in
+      let* multigroup = Kernel.Path.(assoc multigroup ("relation" @/ this) "shelf" (Some view)) in
       let* branch = B.make conn in
       let* branch' =
         Kernel.Path.(assoc branch ("multigroup" @/ this) "library" (Some multigroup))
@@ -20,15 +36,19 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     end
     |> Helpers.condition_as_failure
     |> ignore;
-    begin
-      let* root = I.initialize ~evaluators:["fol", Evaluators.FOL.make ()] conn in
-      let* _ =
-        Kernel.Path.(lookup root ("branch" @/ "master" @/ "multigroup" @/ "library" @/ this))
-      in
-      let* _ = Kernel.Path.(lookup root ("evaluator" @/ "fol" @/ this)) in
-      Ok ()
-    end
-    |> Helpers.condition_as_failure
+    let attributes =
+      begin
+        let* root = I.initialize ~evaluators:["fol", Evaluators.FOL.make ()] conn in
+        let* branch = Kernel.Path.(lookup root ("branch" @/ "master" @/ this)) in
+        let* _ = Kernel.Path.lookup branch book in
+        let* _ = Kernel.Path.(lookup root ("evaluator" @/ "fol" @/ this)) in
+        let* plan = Evaluators.FOL.(instantiate (Kernel.Path.lookup branch) (Base shelf)) in
+        let* description = Evaluators.FOL.describe plan in
+        Ok (BatMap.String.keys description |> BatList.of_enum)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check (list string) "the stored view reads the book it was defined over" ["title"] attributes
 
   let suite =
     ( "registration",
diff --git a/test/unit/evaluators/FOL.ml b/test/unit/evaluators/FOL.ml
index 046fa3f..0a3dabc 100644
--- a/test/unit/evaluators/FOL.ml
+++ b/test/unit/evaluators/FOL.ml
@@ -88,6 +88,92 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes)
       |> List.sort compare )
 
+  let instantiate_a_program conn =
+    let projected =
+      begin
+        let open Utilities.Result in
+        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let root = Kernel.Prototype.(mixture [Directory.of_properties ["employee", employees]]) in
+        let* plan =
+          Rnt.Evaluators.FOL.(
+            instantiate (Kernel.Path.lookup root)
+              (Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name")) )
+        in
+        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+        let* result = Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator in
+        drain result
+      end
+      |> Helpers.condition_as_failure
+    in
+    check
+      (list (list (pair string Helpers.value)))
+      "the program ran over the relation its path resolved to"
+      [["name", Concepts.Value.String "Alaric"]]
+      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+
+  module E = Kernel.EphemeralRelation.Make (S)
+
+  let store conn term =
+    E.persist conn ~name:"view" ~evaluator:Rnt.Evaluators.FOL.name
+      ~code:(Rnt.Evaluators.FOL.encode term)
+      (BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []})
+
+  let namespace entries =
+    let open Utilities.Result in
+    let root = Kernel.Namespace.make () in
+    let* registry = Protocols.Handle.require Protocols.Registry.from root in
+    let* _ =
+      List.fold_left
+        (fun registered (name, handle) ->
+          let* _ = registered in
+          Protocols.Registry.update registry name None (Some handle) )
+        (Ok true) entries
+    in
+    Ok root
+
+  let expand_a_stored_program conn =
+    let projected =
+      begin
+        let open Utilities.Result in
+        let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
+        let* view =
+          store conn
+            Rnt.Evaluators.FOL.(
+              Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
+        in
+        let* root = namespace ["employee", employees; "view", view] in
+        let* plan =
+          Rnt.Evaluators.FOL.(
+            instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
+        in
+        let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
+        let* result = Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator in
+        drain result
+      end
+      |> Helpers.condition_as_failure
+    in
+    check
+      (list (list (pair string Helpers.value)))
+      "the stored program ran in place of its name"
+      [["name", Concepts.Value.String "Alaric"]]
+      (projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
+
+  let refuse_a_program_that_reads_itself conn =
+    let expanded =
+      begin
+        let open Utilities.Result in
+        let* view = store conn Rnt.Evaluators.FOL.(Base Kernel.Path.("view" @/ this)) in
+        let* root = namespace ["view", view] in
+        Rnt.Evaluators.FOL.(
+          instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
+      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 pull_one_tuple_at_a_time () =
     let produced = ref 0 and closed = ref false in
     let description =
@@ -102,7 +188,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     in
     let source =
       Kernel.EphemeralRelation.instantiate description
-        {Kernel.EphemeralRelation.schematics= `Temporary description}
+        {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
         (fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
     in
     let first =
@@ -130,6 +216,12 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
       [ 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 "instantiate-a-program" `Quick
+          (H.with_connection instantiate_a_program "fol-test");
+        test_case "expand-a-stored-program" `Quick
+          (H.with_connection expand_a_stored_program "fol-test");
+        test_case "refuse-a-program-that-reads-itself" `Quick
+          (H.with_connection refuse_a_program_that_reads_itself "fol-test");
         test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] )
 end
 
diff --git a/test/unit/kernel/EphemeralRelation.ml b/test/unit/kernel/EphemeralRelation.ml
index 95ce56d..7f113ef 100644
--- a/test/unit/kernel/EphemeralRelation.ml
+++ b/test/unit/kernel/EphemeralRelation.ml
@@ -12,10 +12,11 @@ let description =
     { Protocols.Schematics.domain= "integer";
       provenance= [{Protocols.Schematics.source= ["example"]; attribute= "value"}] }
 
-let over ?inputs members =
-  Ephemeral.instantiate ?inputs description
-    {Ephemeral.schematics= `Temporary description}
-    (fun () -> Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())))
+let temporary = {Ephemeral.name= None; schematics= `Temporary description; program= None}
+
+let over ?inputs ?(value = temporary) members =
+  Ephemeral.instantiate ?inputs description value (fun () ->
+      Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())) )
 
 let values tuples =
   BatFingerTree.to_list tuples
@@ -78,6 +79,20 @@ let describes_itself () =
                 ^ origin.Protocols.Schematics.attribute ) ) )
   | _ -> fail "an ephemeral relation describes itself as a relation"
 
+let addressed_once_persisted () =
+  let persisted code =
+    { Ephemeral.name= Some "example";
+      schematics= `Persisted (Concepts.Hash.hash_of_int 1);
+      program= Some {Ephemeral.evaluator= "fol"; code= Concepts.Hash.hash_of_int code} }
+  in
+  let address value =
+    Protocols.Addressable.from (over ~value []) |> Option.map Protocols.Addressable.address
+  in
+  check bool "a temporary relation has no address" true (Option.is_none (address temporary));
+  check bool "a persisted one has" true (Option.is_some (address (persisted 2)));
+  check bool "and its program is part of it" false
+    (Option.equal Concepts.Hash.hash_equals (address (persisted 2)) (address (persisted 3)))
+
 let releasing_releases_its_inputs () =
   let released = ref false in
   let input =
@@ -99,4 +114,5 @@ let suites () =
       [ test_case "enumerates-every-member" `Quick enumerates_every_member;
         test_case "decides-membership" `Quick decides_membership;
         test_case "describes-itself" `Quick describes_itself;
+        test_case "addressed-once-persisted" `Quick addressed_once_persisted;
         test_case "releasing-releases-its-inputs" `Quick releasing_releases_its_inputs ] ) ]