@@ -146,17 +146,23 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do
146146group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
147147group groupAttrNames newAttrName rel = do
148148 nonGroupProjection <- project nonGroupAttrNames rel
149− relFold folder (Right $ Relation newAttrs emptyTupleSet) nonGroupProjection
149+ relMogrify mogrifier newAttrs nonGroupProjection
150150 where
151151 newAttrs = A.addAttribute groupAttr (attributesForNames nonGroupAttrNames rel)
152− groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames nonGroupAttrNames rel))
152+ groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames groupAttrNames rel))
153153 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))
157+ Left _ -> undefined
158+{-
154159 folder tupleIn acc = case acc of
155160 Left err -> Left err
156161 Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))
157162 matchingRelTuple groupTuple = case imageRelationFor groupTuple rel of
158163 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
159164 Left _ -> undefined
165+-}
160166
161167--help restriction function
162168--returns a subrelation of
@@ -164,7 +170,7 @@ restrictEq :: RelationTuple -> Relation -> Either RelationalError Relation
164170restrictEq tuple rel = restrict rfilter rel
165171 where
166172 rfilter :: RelationTuple -> Bool
167− rfilter tupleIn = tupleIntersection tuple tupleIn /= emptyTuple
173+ rfilter tupleIn = tupleIntersection tuple tupleIn == tuple
168174
169175-- unwrap relation-valued attribute
170176-- return error if relval attrs and nongroup attrs overlap