From 80b0e6fa676afaefbd3a6dc9edeab073343f0a2b Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Thu, 1 Oct 2026 00:53:12 -0300 Subject: fix multigroup deriving and tests --- test/integration/Registration.ml | 38 +++++++++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 9 deletions(-) (limited to 'test/integration') 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", -- cgit v1.2.3