fix multigroup deriving and tests

1 files changed, 29 insertions, 9 deletions

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