@@ -146,17 +146,23 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do
146group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
146group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
147group groupAttrNames newAttrName rel = do
147group groupAttrNames newAttrName rel = do
148 nonGroupProjection <- project nonGroupAttrNames rel
148 nonGroupProjection <- project nonGroupAttrNames rel
149− relFold folder (Right $ Relation newAttrs emptyTupleSet) nonGroupProjection
149+ relMogrify mogrifier newAttrs nonGroupProjection
151 newAttrs = A.addAttribute groupAttr (attributesForNames nonGroupAttrNames rel)
151 newAttrs = A.addAttribute groupAttr (attributesForNames nonGroupAttrNames rel)
152− groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames nonGroupAttrNames rel))
152+ groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames groupAttrNames rel))
153 nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (attributeNames rel)
153 nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (attributeNames rel)
154+ mogrifier tupIn = tupleExtend (traceShowId tupIn) (matchingRelTuple tupIn)
155+ matchingRelTuple tupIn = case imageRelationFor tupIn rel of
156+ Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
154 folder tupleIn acc = case acc of
159 folder tupleIn acc = case acc of
155 Left err -> Left err
160 Left err -> Left err
156 Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))
161 Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))
157 matchingRelTuple groupTuple = case imageRelationFor groupTuple rel of
162 matchingRelTuple groupTuple = case imageRelationFor groupTuple rel of
158 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
163 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
159 Left _ -> undefined
164 Left _ -> undefined
161--help restriction function
167--help restriction function
162--returns a subrelation of
168--returns a subrelation of
@@ -164,7 +170,7 @@ restrictEq :: RelationTuple -> Relation -> Either RelationalError Relation
164restrictEq tuple rel = restrict rfilter rel
170restrictEq tuple rel = restrict rfilter rel
166 rfilter :: RelationTuple -> Bool
172 rfilter :: RelationTuple -> Bool
167− rfilter tupleIn = tupleIntersection tuple tupleIn /= emptyTuple
173+ rfilter tupleIn = tupleIntersection tuple tupleIn == tuple
169-- unwrap relation-valued attribute
175-- unwrap relation-valued attribute
170-- return error if relval attrs and nongroup attrs overlap
176-- return error if relval attrs and nongroup attrs overlap