git.iko.soy/project-m36
on master help sign in
improve error handling for "all but" attributes inversion
commit64571d6015948a22fa1670b260faa3029b7cd21f authorAgentM <agentm@themactionfaction.com> dateSun 7 Jun 2015, 10:20 (11 years ago) parent6a7ede4
5 files changed+39−25
compare with master
unifiedsplit
ProjectM36/Attribute.hs+2 ProjectM36/AttributeNames.hs+16−4 ProjectM36/Error.hs+2−1 ProjectM36/Relation.hs+16−18 test/Relation/Basic.hs+3−2
ProjectM36/Attribute.hs+2
@@ -91,6 +91,8 @@ nonMatchingAttributeNameSet a1 a2 = S.difference (S.union a1 a2) (S.intersection
9191matchingAttributeNameSet :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
9292matchingAttributeNameSet = S.intersection
9393
94+attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
95+attributeNamesNotContained subset superset = S.filter (flip S.notMember superset) subset
9496
9597-- this is sorted so the tuples know in which order to output- the ordering is arbitrary
9698sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]
ProjectM36/AttributeNames.hs+16−4
@@ -1,13 +1,25 @@
11module ProjectM36.AttributeNames where
22import qualified ProjectM36.Attribute as A
33import ProjectM36.Base
4+import ProjectM36.Error
45import qualified Data.Set as S
56--AttributeNames is a data structure which can represent inverted projection attributes
67
7−
8−projectionAttributesForAttributeNames :: Attributes -> AttributeNames -> Attributes
9−projectionAttributesForAttributeNames attrs (AttributeNames attrNameSet) = A.attributesForNames attrNameSet attrs
10−projectionAttributesForAttributeNames attrs (InvertedAttributeNames unselectedAttrNameSet) = A.attributesForNames (A.nonMatchingAttributeNameSet unselectedAttrNameSet (A.attributeNameSet attrs)) attrs
8+--check that the attribute names are actually in the attributes
9+projectionAttributesForAttributeNames :: Attributes -> AttributeNames -> Either RelationalError Attributes
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
22+ return $ A.attributesForNames (A.nonMatchingAttributeNameSet unselectedAttrNameSet (A.attributeNameSet attrs)) attrs
1123
1224attributeNameSet :: AttributeNames -> S.Set AttributeName
1325attributeNameSet (AttributeNames nameSet) = nameSet
ProjectM36/Error.hs+2−1
@@ -1,6 +1,7 @@
11{-# LANGUAGE DeriveGeneric #-}
22module ProjectM36.Error where
33import ProjectM36.Base
4+import qualified Data.Set as S
45import qualified Data.UUID as U
56import Control.DeepSeq (NFData, rnf)
67import Control.DeepSeq.Generics (genericRnf)
@@ -12,7 +13,7 @@ data RelationalError = NoSuchAttributeNameError AttributeName
1213 | TupleAttributeCountMismatchError Int --attribute name
1314 | TupleAttributeTypeMismatchError Attributes
1415 | AttributeCountMismatchError Int
15− | AttributeNameMismatchError AttributeName
16+ | AttributeNamesMismatchError (S.Set AttributeName)
1617 | AttributeNameInUseError AttributeName
1718 | AttributeIsNotRelationValuedError AttributeName
1819 | RelVarNotDefinedError RelVarName
ProjectM36/Relation.hs+16−18
@@ -74,7 +74,7 @@ singletonValueFromRelation rel@(Relation _ tupSet) = if cardinality rel /= Count
7474union :: Relation -> Relation -> Either RelationalError Relation
7575union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
7676 if not (attrs1 == attrs2)
77− then Left $ AttributeNameMismatchError (T.pack (show attrs1 ++ show attrs2))
77+ then Left $ AttributeNamesMismatchError (A.attributeNameSet (A.attributesDifference attrs1 attrs2))
7878 else
7979 Right $ Relation attrs1 newtuples
8080 where
@@ -82,22 +82,18 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
8282
8383project :: AttributeNames -> Relation -> Either RelationalError Relation
8484project projectionAttrNames rel =
85− if not $ A.attributeNamesContained selectedAttrNames (attributeNames rel)
86− then Left $ AttributeNameMismatchError ""
87− else
88− relFold folder (Right $ Relation newAttrs HS.empty) rel
85+ case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of
86+ Left err -> Left err
87+ Right newAttrs -> relFold (folder newAttrs) (Right $ Relation newAttrs HS.empty) rel
8988 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
9490 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)))
9692
9793rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
9894rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =
9995 if not attributeValid
100− then Left $ AttributeNameMismatchError ""
96+ then Left $ AttributeNamesMismatchError (S.singleton oldAttrName)
10197 else if newAttributeInUse
10298 then Left $ AttributeNameInUseError newAttrName
10399 else
@@ -141,16 +137,18 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do
141137--algorithm: self-join with image relation
142138group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation
143139group groupAttrNames newAttrName rel = do
144− nonGroupProjection <- project nonGroupAttrNames rel
145− relMogrify mogrifier newAttrs nonGroupProjection
146− where
147− newAttrs = A.addAttribute groupAttr (AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames)
148− groupAttr = Attribute newAttrName (RelationAtomType (AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames))
149− nonGroupAttrNames = AS.invertAttributeNames groupAttrNames
150− mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)
140+ let nonGroupAttrNames = AS.invertAttributeNames groupAttrNames
141+ nonGroupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames
142+ groupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames
143+ let groupAttr = Attribute newAttrName (RelationAtomType groupProjectionAttributes)
151144 matchingRelTuple tupIn = case imageRelationFor tupIn rel of
152145 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
153146 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+
154152
155153--help restriction function
156154--returns a subrelation of
test/Relation/Basic.hs+3−2
@@ -8,6 +8,7 @@ import ProjectM36.Atom
88import qualified ProjectM36.Attribute as A
99import qualified Data.HashSet as HS
1010import qualified Data.Vector as V
11+import qualified Data.Set as S
1112import System.Exit
1213import ProjectM36.RelationalExpression
1314
@@ -38,7 +39,7 @@ validateRelation rel = do
3839validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
3940validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)
4041 | HS.null invalidSet = Right rel
41− | otherwise = Left $ AttributeNameMismatchError ""
42+ | otherwise = Left $ AttributeNamesMismatchError S.empty
4243 where
4344 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
4445 invalidSet = HS.filter (not . nameCheck) tupMapSet
@@ -67,7 +68,7 @@ simpleRel = case mkRelation attrs tupleSet of
6768
6869--rename tests
6970testRename1 :: 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"))
7172
7273testRename2 :: Test
7374testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")