7177c9e · project-m36 · git.iko.soy

src/lib/ProjectM36/IsomorphicSchema.hs+4−5

compare with master

unifiedsplit

@@ -16,7 +16,6 @@ import qualified Data.Set as S

16import qualified Data.List as L

17import qualified Data.Text as T

18import Data.Monoid

19−--import Debug.Trace

20-- isomorphic schemas offer bi-directional functors between two schemas

19-- isomorphic schemas offer bi-directional functors between two schemas

21

20

22--TODO: note that renaming a relvar should alter any stored isomorphisms as well

21--TODO: note that renaming a relvar should alter any stored isomorphisms as well

@@ -304,11 +303,11 @@ validate morph underlyingRvNames = if S.size invalidRvNames > 0 then

304

303

305-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.

304-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.

306createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies

305createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies

307−createIncDepsForIsomorph sname (IsoRestrict _ predi (rvTrue, rvFalse)) = let

306+createIncDepsForIsomorph sname (IsoRestrict origRv predi (rvTrue, rvFalse)) = let

308 newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)

307 newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)

309− incDepName b = "schema" <> "_" <> sname <> "_" <> T.pack (show b) in

308+ incDepName b = "schema" <> "_" <> sname <> "_" <> b in

310− M.fromList [(incDepName True, newIncDep predi rvTrue),

309+ M.fromList [(incDepName (origRv <> "_true"), newIncDep predi rvTrue),

311− (incDepName False, newIncDep (NotPredicate predi) rvFalse)]

310+ (incDepName (origRv <> "_false"), newIncDep (NotPredicate predi) rvFalse)]

312createIncDepsForIsomorph _ _ = M.empty

311createIncDepsForIsomorph _ _ = M.empty

313

312

314-- 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

313-- 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

src/lib/ProjectM36/Relation.hs+4

@@ -64,6 +64,10 @@ mkRelationDeferVerify :: Attributes -> RelationTupleSet -> Either RelationalErro

64mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))

65 where

66 tupleFilter tuple = isRight (verifyTuple attrs tuple)

67+

68+--return a relation of the same type except without any tuples

69+relationWithEmptyTupleSet :: Relation -> Relation

70+relationWithEmptyTupleSet (Relation attrs _) = emptyRelationWithAttrs attrs

67

71

68mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation

72mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation

69mkRelationFromTuples attrs tupleSetList = do

73mkRelationFromTuples attrs tupleSetList = do

src/lib/ProjectM36/RelationalExpression.hs+4−1

@@ -663,7 +663,10 @@ typeForRelationalExpr expr = do

663 --replace the relationVariables context element with a cloned set of relation devoid of tuples

664 let context' = contextWithEmptyTupleSets context

665 rstate' = setStateElemsContext rstate context'

666+ --evalRelationalExpr could still return an existing relation with tuples, so strip them

666− pure (runReader (evalRelationalExpr expr) rstate')

667+ pure $ case runReader (evalRelationalExpr expr) rstate' of

668+ Left err -> Left err

669+ Right typeRel -> Right (relationWithEmptyTupleSet typeRel)

667

670

668--returns a database context with all tuples removed

671--returns a database context with all tuples removed

669--this is useful for type checking and optimization

672--this is useful for type checking and optimization

test/Relation/Basic.hs+8−2

@@ -25,7 +25,8 @@ testList = TestList [testRelation "relationTrue" relationTrue, testRelation "rel

25 testRelation "products" productsRel,

26 testRelation "supplierProducts" supplierProductsRel,

27 testMkRelationFromExprsBadAttrs,

28− testDuplicateAttributes

28+ testDuplicateAttributes,

29+ testExistingRelationType

29 ]

30 ]

30

31

31main :: IO ()

32main :: IO ()

@@ -103,4 +104,9 @@ testDuplicateAttributes :: Test

103testDuplicateAttributes = TestCase $ do

104testDuplicateAttributes = TestCase $ do

104 let eRel = mkRelation attrs emptyTupleSet

105 let eRel = mkRelation attrs emptyTupleSet

105 attrs = attributesFromList [Attribute "a" IntAtomType, Attribute "a" TextAtomType]

106 attrs = attributesFromList [Attribute "a" IntAtomType, Attribute "a" TextAtomType]

106− assertEqual "duplicate attribute names" (Left (DuplicateAttributeNamesError (S.singleton "a"))) eRel

107+ assertEqual "duplicate attribute names" (Left (DuplicateAttributeNamesError (S.singleton "a"))) eRel

108+

109+testExistingRelationType :: Test

110+testExistingRelationType = TestCase $ do

111+ let typeResult = runReader (typeForRelationalExpr (ExistingRelation relationTrue)) (RelationalExprStateElems DBC.empty)

112+ assertEqual "ExistingRelation with tuples type" (Right relationFalse) typeResult