@@ -4,6 +4,8 @@ import ProjectM36.Base
44import ProjectM36.Error
55import ProjectM36.MiscUtils
66import ProjectM36.RelationalExpression
7+import ProjectM36.Relation
8+import qualified ProjectM36.AttributeNames as AN
79import Control.Monad
810import Control.Monad.State
911import GHC.Generics
@@ -11,7 +13,9 @@ import Data.Binary
1113import qualified Data.Map as M
1214import qualified Data.Set as S
1315import qualified Data.List as L
14−import Debug.Trace
16+import qualified Data.Text as T
17+import Data.Monoid
18+-- import Debug.Trace
1519-- isomorphic schemas offer bi-directional functors between two schemas
1620
1721--TODO: note that renaming a relvar should alter any stored isomorphisms as well
@@ -280,18 +284,35 @@ validate morph underlyingRvNames = if S.size invalidRvNames > 0 then
280284 invalidRvNames = S.difference morphRvNames underlyingRvNames
281285-}
282286
283−-- the second argument really should be a database context in the future so we can morph other context items
284−evalSchemaExpr :: SchemaExpr -> DatabaseContext -> Subschemas -> Either RelationalError Subschemas
285−evalSchemaExpr (AddSubschema sname morphs) context sschemas = if M.member sname sschemas then
286− Left (SubschemaNameInUseError sname)
287− else case valid of
288− Just err -> Left (SchemaCreationError err)
289− Nothing -> pure (M.insert sname newSchema sschemas)
287+-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.
288+createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies
289+createIncDepsForIsomorph sname (IsoRestrict _ predi (rvTrue, rvFalse)) = let
290+ newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)
291+ incDepName b = "schema" <> "_" <> sname <> "_" <> T.pack (show b) in
292+ M.fromList [(incDepName True, newIncDep predi rvTrue),
293+ (incDepName False, newIncDep (NotPredicate predi) rvFalse)]
294+createIncDepsForIsomorph _ _ = M.empty
295+
296+-- in the case of IsoRestrict, the database context should be updated with the restriction so that if the restriction does not hold, then the schema cannot be created
297+evalSchemaExpr :: SchemaExpr -> DatabaseContext -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext)
298+evalSchemaExpr (AddSubschema sname morphs) context sschemas = do
299+ if M.member sname sschemas then
300+ Left (SubschemaNameInUseError sname)
301+ else case valid of
302+ Just err -> Left (SchemaCreationError err)
303+ Nothing ->
304+ let newSchemas = M.insert sname newSchema sschemas
305+ moreIncDeps = foldr (\morph acc -> M.union acc (createIncDepsForIsomorph sname morph)) M.empty morphs
306+ incDepExprs = MultipleExpr (map (uncurry AddInclusionDependency) (M.toList moreIncDeps))
307+ in
308+ case runState (evalContextExpr incDepExprs) context of
309+ (Just err, _) -> Left err
310+ (Nothing, newContext) -> pure (newSchemas, newContext)
290311 where
291312 newSchema = Schema morphs
292313 valid = validateSchema newSchema context
293−evalSchemaExpr (RemoveSubschema sname) _ sschemas = if M.member sname sschemas then
294− pure (M.delete sname sschemas)
314+evalSchemaExpr (RemoveSubschema sname) context sschemas = if M.member sname sschemas then
315+ pure (M.delete sname sschemas, context)
295316 else
296317 Left (SubschemaNameNotInUseError sname)
297318