git.iko.soy/project-m36
on master help sign in
improve error handling for "all but" attributes inversion
64571d6AgentM
ProjectM36/Attribute.hs+2
compare with master
unifiedsplit
@@ -91,6 +91,8 @@ nonMatchingAttributeNameSet a1 a2 = S.difference (S.union a1 a2) (S.intersection
91matchingAttributeNameSet :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
91matchingAttributeNameSet :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
92matchingAttributeNameSet = S.intersection
92matchingAttributeNameSet = S.intersection
93
93
94+attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
95+attributeNamesNotContained subset superset = S.filter (flip S.notMember superset) subset
94
96
95-- this is sorted so the tuples know in which order to output- the ordering is arbitrary
97-- this is sorted so the tuples know in which order to output- the ordering is arbitrary
96sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]
98sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]
ProjectM36/AttributeNames.hs+16−4
@@ -1,13 +1,25 @@
1module ProjectM36.AttributeNames where
1module ProjectM36.AttributeNames where
2import qualified ProjectM36.Attribute as A
2import qualified ProjectM36.Attribute as A
3import ProjectM36.Base
3import ProjectM36.Base
4+import ProjectM36.Error
4import qualified Data.Set as S
5import qualified Data.Set as S
5--AttributeNames is a data structure which can represent inverted projection attributes
6--AttributeNames is a data structure which can represent inverted projection attributes
6
7
7−
8+--check that the attribute names are actually in the attributes
8−projectionAttributesForAttributeNames :: Attributes -> AttributeNames -> Attributes
9+projectionAttributesForAttributeNames :: Attributes -> AttributeNames -> Either RelationalError Attributes
9−projectionAttributesForAttributeNames attrs (AttributeNames attrNameSet) = A.attributesForNames attrNameSet attrs
10+projectionAttributesForAttributeNames attrs (AttributeNames attrNameSet) = do
11+ let nonExistentAttributeNames = A.attributeNamesNotContained attrNameSet (A.attributeNameSet attrs)
12+ if not $ S.null nonExistentAttributeNames then
13+ Left $ AttributeNamesMismatchError nonExistentAttributeNames
14+ else
15+ return $ A.attributesForNames attrNameSet attrs
16+
17+projectionAttributesForAttributeNames attrs (InvertedAttributeNames unselectedAttrNameSet) = do
18+ let nonExistentAttributeNames = A.attributeNamesNotContained unselectedAttrNameSet (A.attributeNameSet attrs)
19+ if not $ S.null nonExistentAttributeNames then
20+ Left $ AttributeNamesMismatchError nonExistentAttributeNames
21+ else
10−projectionAttributesForAttributeNames attrs (InvertedAttributeNames unselectedAttrNameSet) = A.attributesForNames (A.nonMatchingAttributeNameSet unselectedAttrNameSet (A.attributeNameSet attrs)) attrs
22+ return $ A.attributesForNames (A.nonMatchingAttributeNameSet unselectedAttrNameSet (A.attributeNameSet attrs)) attrs
11
23
12attributeNameSet :: AttributeNames -> S.Set AttributeName
24attributeNameSet :: AttributeNames -> S.Set AttributeName
13attributeNameSet (AttributeNames nameSet) = nameSet
25attributeNameSet (AttributeNames nameSet) = nameSet
ProjectM36/Error.hs+2−1
@@ -1,6 +1,7 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2module ProjectM36.Error where
2module ProjectM36.Error where
3import ProjectM36.Base
3import ProjectM36.Base
4+import qualified Data.Set as S
4import qualified Data.UUID as U
5import qualified Data.UUID as U
5import Control.DeepSeq (NFData, rnf)
6import Control.DeepSeq (NFData, rnf)
6import Control.DeepSeq.Generics (genericRnf)
7import Control.DeepSeq.Generics (genericRnf)
@@ -12,7 +13,7 @@ data RelationalError = NoSuchAttributeNameError AttributeName
12 | TupleAttributeCountMismatchError Int --attribute name
13 | TupleAttributeCountMismatchError Int --attribute name
13 | TupleAttributeTypeMismatchError Attributes
14 | TupleAttributeTypeMismatchError Attributes
14 | AttributeCountMismatchError Int
15 | AttributeCountMismatchError Int
15− | AttributeNameMismatchError AttributeName
16+ | AttributeNamesMismatchError (S.Set AttributeName)
16 | AttributeNameInUseError AttributeName
17 | AttributeNameInUseError AttributeName
17 | AttributeIsNotRelationValuedError AttributeName
18 | AttributeIsNotRelationValuedError AttributeName
18 | RelVarNotDefinedError RelVarName
19 | RelVarNotDefinedError RelVarName
ProjectM36/Relation.hs+16−18
@@ -74,7 +74,7 @@ singletonValueFromRelation rel@(Relation _ tupSet) = if cardinality rel /= Count
74union :: Relation -> Relation -> Either RelationalError Relation
74union :: Relation -> Relation -> Either RelationalError Relation
75union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
75union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
76 if not (attrs1 == attrs2)
76 if not (attrs1 == attrs2)
77− then Left $ AttributeNameMismatchError (T.pack (show attrs1 ++ show attrs2))
77+ then Left $ AttributeNamesMismatchError (A.attributeNameSet (A.attributesDifference attrs1 attrs2))
78 else
78 else
79 Right $ Relation attrs1 newtuples
79 Right $ Relation attrs1 newtuples
80 where
80 where
@@ -82,22 +82,18 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
82
82
83project :: AttributeNames -> Relation -> Either RelationalError Relation
83project :: AttributeNames -> Relation -> Either RelationalError Relation
84project projectionAttrNames rel =
84project projectionAttrNames rel =
85− if not $ A.attributeNamesContained selectedAttrNames (attributeNames rel)
85+ case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of
86− then Left $ AttributeNameMismatchError ""
86+ Left err -> Left err
87− else
88− relFold folder (Right $ Relation newAttrs HS.empty) rel
87+ Right newAttrs -> relFold (folder newAttrs) (Right $ Relation newAttrs HS.empty) rel
89 where
88 where
90− selectedAttrNames = A.attributeNameSet newAttrs
91− newAttrs = AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames
92− folder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation
93− folder tupleToProject acc = case acc of
89+ folder newAttrs tupleToProject acc = case acc of
94 Left err -> Left err
90 Left err -> Left err
95− Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject selectedAttrNames tupleToProject)))
91+ Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject (A.attributeNameSet newAttrs) tupleToProject)))
96
92
97rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
93rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
98rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =
94rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =
99 if not attributeValid
95 if not attributeValid
100− then Left $ AttributeNameMismatchError ""
96+ then Left $ AttributeNamesMismatchError (S.singleton oldAttrName)
101 else if newAttributeInUse
97 else if newAttributeInUse
102 then Left $ AttributeNameInUseError newAttrName
98 then Left $ AttributeNameInUseError newAttrName
103 else
99 else
@@ -141,16 +137,18 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do
141--algorithm: self-join with image relation
137--algorithm: self-join with image relation
142group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation
138group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation
143group groupAttrNames newAttrName rel = do
139group groupAttrNames newAttrName rel = do
144− nonGroupProjection <- project nonGroupAttrNames rel
140+ let nonGroupAttrNames = AS.invertAttributeNames groupAttrNames
145− relMogrify mogrifier newAttrs nonGroupProjection
141+ nonGroupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames
146− where
147− newAttrs = A.addAttribute groupAttr (AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames)
142+ groupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames
148− groupAttr = Attribute newAttrName (RelationAtomType (AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames))
143+ let groupAttr = Attribute newAttrName (RelationAtomType groupProjectionAttributes)
149− nonGroupAttrNames = AS.invertAttributeNames groupAttrNames
150− mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)
151 matchingRelTuple tupIn = case imageRelationFor tupIn rel of
144 matchingRelTuple tupIn = case imageRelationFor tupIn rel of
152 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
145 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
153 Left _ -> undefined
146 Left _ -> undefined
147+ mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)
148+ newAttrs = A.addAttribute groupAttr nonGroupProjectionAttributes
149+ nonGroupProjection <- project nonGroupAttrNames rel
150+ relMogrify mogrifier newAttrs nonGroupProjection
151+
154
152
155--help restriction function
153--help restriction function
156--returns a subrelation of
154--returns a subrelation of
test/Relation/Basic.hs+3−2
@@ -8,6 +8,7 @@ import ProjectM36.Atom
8import qualified ProjectM36.Attribute as A
8import qualified ProjectM36.Attribute as A
9import qualified Data.HashSet as HS
9import qualified Data.HashSet as HS
10import qualified Data.Vector as V
10import qualified Data.Vector as V
11+import qualified Data.Set as S
11import System.Exit
12import System.Exit
12import ProjectM36.RelationalExpression
13import ProjectM36.RelationalExpression
13
14
@@ -38,7 +39,7 @@ validateRelation rel = do
38validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
39validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
39validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)
40validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)
40 | HS.null invalidSet = Right rel
41 | HS.null invalidSet = Right rel
41− | otherwise = Left $ AttributeNameMismatchError ""
42+ | otherwise = Left $ AttributeNamesMismatchError S.empty
42 where
43 where
43 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
44 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
44 invalidSet = HS.filter (not . nameCheck) tupMapSet
45 invalidSet = HS.filter (not . nameCheck) tupMapSet
@@ -67,7 +68,7 @@ simpleRel = case mkRelation attrs tupleSet of
67
68
68--rename tests
69--rename tests
69testRename1 :: Test
70testRename1 :: Test
70−testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNameMismatchError "")
71+testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNamesMismatchError (S.singleton "a"))
71
72
72testRename2 :: Test
73testRename2 :: Test
73testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")
74testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")