git.iko.soy/project-m36
on master help sign in
fix type of ExistingRelation

getting the type of an existing relation could return tuples resolves #216

commit7177c9ef911598357bdc233ac536cfcb4f23d9f2 authorAgentM <agentm@themactionfaction.com> dateTue 28 Aug 2018, 23:35 (8 years ago) parent580c7bc
4 files changed+20−8
compare with master
unifiedsplit
src/lib/ProjectM36/IsomorphicSchema.hs+4−5 src/lib/ProjectM36/Relation.hs+4 src/lib/ProjectM36/RelationalExpression.hs+4−1 test/Relation/Basic.hs+8−2
src/lib/ProjectM36/IsomorphicSchema.hs+4−5
@@ -16,7 +16,6 @@ import qualified Data.Set as S
1616import qualified Data.List as L
1717import qualified Data.Text as T
1818import Data.Monoid
19−--import Debug.Trace
2019-- isomorphic schemas offer bi-directional functors between two schemas
2120
2221--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
304303
305304-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.
306305createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies
307−createIncDepsForIsomorph sname (IsoRestrict _ predi (rvTrue, rvFalse)) = let
306+createIncDepsForIsomorph sname (IsoRestrict origRv predi (rvTrue, rvFalse)) = let
308307 newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)
309− incDepName b = "schema" <> "_" <> sname <> "_" <> T.pack (show b) in
310− M.fromList [(incDepName True, newIncDep predi rvTrue),
311− (incDepName False, newIncDep (NotPredicate predi) rvFalse)]
308+ incDepName b = "schema" <> "_" <> sname <> "_" <> b in
309+ M.fromList [(incDepName (origRv <> "_true"), newIncDep predi rvTrue),
310+ (incDepName (origRv <> "_false"), newIncDep (NotPredicate predi) rvFalse)]
312311createIncDepsForIsomorph _ _ = M.empty
313312
314313-- 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
6464mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))
6565 where
6666 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
6771
6872mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation
6973mkRelationFromTuples attrs tupleSetList = do
src/lib/ProjectM36/RelationalExpression.hs+4−1
@@ -663,7 +663,10 @@ typeForRelationalExpr expr = do
663663 --replace the relationVariables context element with a cloned set of relation devoid of tuples
664664 let context' = contextWithEmptyTupleSets context
665665 rstate' = setStateElemsContext rstate context'
666− pure (runReader (evalRelationalExpr expr) rstate')
666+ --evalRelationalExpr could still return an existing relation with tuples, so strip them
667+ pure $ case runReader (evalRelationalExpr expr) rstate' of
668+ Left err -> Left err
669+ Right typeRel -> Right (relationWithEmptyTupleSet typeRel)
667670
668671--returns a database context with all tuples removed
669672--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
2525 testRelation "products" productsRel,
2626 testRelation "supplierProducts" supplierProductsRel,
2727 testMkRelationFromExprsBadAttrs,
28− testDuplicateAttributes
28+ testDuplicateAttributes,
29+ testExistingRelationType
2930 ]
3031
3132main :: IO ()
@@ -103,4 +104,9 @@ testDuplicateAttributes :: Test
103104testDuplicateAttributes = TestCase $ do
104105 let eRel = mkRelation attrs emptyTupleSet
105106 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