git.iko.soy/project-m36
on master help sign in
WIP relationVariablesInSchema working
0f9da75AgentM
src/lib/ProjectM36/Client.hs+4−2
compare with master
unifiedsplit
@@ -634,10 +634,12 @@ transactionGraphAsRelation sessionId conn@(RemoteProcessConnection _ _) = remote
634relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
634relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
635relationVariablesAsRelation sessionId (InProcessConnection _ _ sessions _ _) = do
635relationVariablesAsRelation sessionId (InProcessConnection _ _ sessions _ _) = do
636 atomically $ do
636 atomically $ do
637− eSession <- sessionForSessionId sessionId sessions
637+ eSession <- sessionAndSchema sessionId sessions
638 case eSession of
638 case eSession of
639 Left err -> pure (Left err)
639 Left err -> pure (Left err)
640+ Right (session, schema) -> case Schema.relationVariablesInSchema schema (Sess.concreteDatabaseContext session) of
641+ Left err -> pure (Left err)
640− Right session -> pure $ R.relationVariablesAsRelation (relationVariables (Sess.concreteDatabaseContext session))
642+ Right relvars -> pure $ R.relationVariablesAsRelation relvars
641
643
642relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)
644relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)
643
645
src/lib/ProjectM36/IsomorphicSchema.hs+29−1
@@ -2,13 +2,15 @@
2module ProjectM36.IsomorphicSchema where
2module ProjectM36.IsomorphicSchema where
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.Error
4import ProjectM36.Error
5+import ProjectM36.RelationalExpression
5import Data.Maybe
6import Data.Maybe
6import Control.Monad
7import Control.Monad
8+import Control.Monad.State
7import GHC.Generics
9import GHC.Generics
8import Data.Binary
10import Data.Binary
9import qualified Data.Map as M
11import qualified Data.Map as M
10import qualified Data.Set as S
12import qualified Data.Set as S
11−import Debug.Trace
13+--import Debug.Trace
12-- isomorphic schemas offer bi-directional functors between two schemas
14-- isomorphic schemas offer bi-directional functors between two schemas
13
15
14--TODO: note that renaming a relvar should alter any stored isomorphisms as well
16--TODO: note that renaming a relvar should alter any stored isomorphisms as well
@@ -84,6 +86,16 @@ processDatabaseContextExprInSchema schema@(Schema morphs) dbExpr = do
84 validRelVarNames = isomorphsInRelVarNames morphs
86 validRelVarNames = isomorphsInRelVarNames morphs
85 foldM processDbExpr dbExpr morphs
87 foldM processDbExpr dbExpr morphs
86
88
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+
87
99
88-- | Morph a relational expression in one schema to another isomorphic schema.
100-- | Morph a relational expression in one schema to another isomorphic schema.
89relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)
101relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)
@@ -197,6 +209,22 @@ applyInclusionDependenciesSchemaIsoMorphs :: SchemaIsomorphs -> InclusionDepende
197--add inc deps for restriction with some automatic name
209--add inc deps for restriction with some automatic name
198applyInclusionDependenciesSchemaIsoMorphs morphs incDeps = undefined
210applyInclusionDependenciesSchemaIsoMorphs morphs incDeps = undefined
199
211
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+
200{-
228{-
201proposal
229proposal
202data DatabaseContext =
230data DatabaseContext =