@@ -2,13 +2,15 @@
22module ProjectM36.IsomorphicSchema where
33import ProjectM36.Base
44import ProjectM36.Error
5+import ProjectM36.RelationalExpression
56import Data.Maybe
67import Control.Monad
8+import Control.Monad.State
79import GHC.Generics
810import Data.Binary
911import qualified Data.Map as M
1012import qualified Data.Set as S
11−import Debug.Trace
13+--import Debug.Trace
1214-- isomorphic schemas offer bi-directional functors between two schemas
1315
1416--TODO: note that renaming a relvar should alter any stored isomorphisms as well
@@ -84,6 +86,16 @@ processDatabaseContextExprInSchema schema@(Schema morphs) dbExpr = do
8486 validRelVarNames = isomorphsInRelVarNames morphs
8587 foldM processDbExpr dbExpr morphs
8688
89+-- re-evaluate- it's not possible to display an incdep that may be for a foreign key to a relvar which is not available in the subschema!
90+-- weird compromise: allow inclusion dependencies failures not in the subschema to be propagated- in the worst case, only the inclusion dependency's name is leaked.
91+ {-
92+-- | Convert inclusion dependencies for display in a specific schema.
93+applySchemaToInclusionDependencies :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies
94+applySchemaToInclusionDependencies (Schema morphs) incDeps =
95+ let incDepMorph incDep = --check that the mentioned relvars are in fact in the current schema
96+ M.update incDepMorph incDeps
97+ -}
98+
8799
88100-- | Morph a relational expression in one schema to another isomorphic schema.
89101relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)
@@ -197,6 +209,22 @@ applyInclusionDependenciesSchemaIsoMorphs :: SchemaIsomorphs -> InclusionDepende
197209--add inc deps for restriction with some automatic name
198210applyInclusionDependenciesSchemaIsoMorphs morphs incDeps = undefined
199211
212+relationVariablesInSchema :: Schema -> DatabaseContext -> Either RelationalError RelationVariables
213+relationVariablesInSchema schema@(Schema morphs) context = if null morphs then --main schema
214+ pure (relationVariables context)
215+ else
216+ foldM transform M.empty morphs
217+ where
218+ transform newRvMap morph = do
219+ let rvNames = isomorphInRelVarNames morph
220+ rvAssocs <- mapM (\rv -> do
221+ expr' <- processRelationalExprInSchema schema (RelationVariable rv ())
222+ rel <- evalState (evalRelationalExpr expr') context
223+ pure (rv, rel)) rvNames
224+ pure (M.union newRvMap (M.fromList rvAssocs))
225+
226+
227+
200228{-
201229proposal
202230data DatabaseContext =