afbe31d · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

Merge branch 'tuplesettolist'

afbe31dAgentM11 years ago

ProjectM36/Base.hs+12−5

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE GADTs,DeriveGeneric #-}

1+{-# LANGUAGE GADTs,DeriveGeneric,GeneralizedNewtypeDeriving #-}

2module ProjectM36.Base where

3import qualified Data.Map as M

4import qualified Data.HashSet as HS

@@ -84,7 +84,14 @@ attributesEqual attrs1 attrs2 = attrsAsSet attrs1 == attrsAsSet attrs2

84sortedAttributesIndices :: Attributes -> [(Int, Attribute)]

85sortedAttributesIndices attrs = L.sortBy (\(_, (Attribute name1 _)) (_,(Attribute name2 _)) -> compare name1 name2) $ V.toList (V.indexed attrs)

87−type RelationTupleSet = HS.HashSet RelationTuple

87+newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hash.Hashable, Show, Generic, Binary)

88+

89+instance Eq RelationTupleSet where

90+ set1 == set2 = hset set1 == hset set2

91+ where

92+ hset = HS.fromList . asList

93+

94+instance NFData RelationTupleSet where rnf = genericRnf

89--the same hash must be generated for equal tuples so that the hashset equality works

96--the same hash must be generated for equal tuples so that the hashset equality works

90instance Hash.Hashable RelationTuple where

97instance Hash.Hashable RelationTuple where

@@ -121,7 +128,7 @@ instance NFData Relation where rnf = genericRnf

121instance Hash.Hashable Relation where

128instance Hash.Hashable Relation where

122 hashWithSalt salt (Relation attrs tupSet) = salt `Hash.hashWithSalt`

129 hashWithSalt salt (Relation attrs tupSet) = salt `Hash.hashWithSalt`

123 sortedAttrs `Hash.hashWithSalt`

130 sortedAttrs `Hash.hashWithSalt`

124− HS.toList tupSet

131+ asList tupSet

125 where

132 where

126 sortedAttrs = map snd (sortedAttributesIndices attrs)

133 sortedAttrs = map snd (sortedAttributesIndices attrs)

127

134

@@ -279,8 +286,8 @@ instance Show AtomFunction where

279 showArgTypes = concat (L.intersperse "->" $ map show (atomFuncType aFunc))

286 showArgTypes = concat (L.intersperse "->" $ map show (atomFuncType aFunc))

280

287

281data AttributeNames = AttributeNames (S.Set AttributeName) |

288data AttributeNames = AttributeNames (S.Set AttributeName) |

282− InvertedAttributeNames (S.Set AttributeName)

289+ InvertedAttributeNames (S.Set AttributeName)

283− deriving (Eq, Show, Generic)

290+ deriving (Eq, Show, Generic)

284

291

285instance Binary AttributeNames

292instance Binary AttributeNames

286

293

ProjectM36/Relation.hs+29−21

@@ -1,5 +1,4 @@

1−-- this is an implementation of the Relation typeclass which creates a GADT DSL

2−{-# LANGUAGE GADTs,ExistentialQuantification,NoImplicitPrelude,OverloadedStrings #-}

1+{-# LANGUAGE GADTs,ExistentialQuantification,OverloadedStrings #-}

3module ProjectM36.Relation where

2module ProjectM36.Relation where

4import qualified Data.Set as S

3import qualified Data.Set as S

5import qualified Data.HashSet as HS

4import qualified Data.HashSet as HS

@@ -12,7 +11,6 @@ import qualified ProjectM36.Attribute as A

12import qualified ProjectM36.AttributeNames as AS

11import qualified ProjectM36.AttributeNames as AS

13import ProjectM36.TupleSet

12import ProjectM36.TupleSet

14import ProjectM36.Error

13import ProjectM36.Error

15−import Prelude hiding (join)

16import qualified Data.Text as T

14import qualified Data.Text as T

17import qualified Control.Parallel.Strategies as P

15import qualified Control.Parallel.Strategies as P

@@ -44,6 +42,11 @@ mkRelation attrs tupleSet = do

44 Left err -> Left err

42 Left err -> Left err

45 Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

43 Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

45+mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation

46+mkRelationFromTuples attrs tupleSetList = do

47+ tupSet <- mkTupleSet attrs tupleSetList

48+ mkRelation attrs tupSet

49+

47relationTrue :: Relation

50relationTrue :: Relation

48relationTrue = Relation A.emptyAttributes singletonTupleSet

51relationTrue = Relation A.emptyAttributes singletonTupleSet

@@ -53,7 +56,7 @@ relationFalse = Relation A.emptyAttributes emptyTupleSet

53--if the relation contains one tuple, return it, otherwise Nothing

56--if the relation contains one tuple, return it, otherwise Nothing

54singletonTuple :: Relation -> Maybe RelationTuple

57singletonTuple :: Relation -> Maybe RelationTuple

55singletonTuple rel@(Relation _ tupleSet) = if cardinality rel == Countable 1 then

58singletonTuple rel@(Relation _ tupleSet) = if cardinality rel == Countable 1 then

56− Just $ head $ HS.toList tupleSet

59+ Just $ head $ asList tupleSet

57 else

60 else

58 Nothing

61 Nothing

@@ -64,17 +67,17 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

64 else

67 else

65 Right $ Relation attrs1 newtuples

68 Right $ Relation attrs1 newtuples

66 where

69 where

67− newtuples = HS.union tupSet1 (HS.map (reorderTuple attrs1) tupSet2)

70+ newtuples = RelationTupleSet $ HS.toList . HS.fromList $ (asList tupSet1) ++ (map (reorderTuple attrs1) (asList tupSet2))

69project :: AttributeNames -> Relation -> Either RelationalError Relation

72project :: AttributeNames -> Relation -> Either RelationalError Relation

70project projectionAttrNames rel =

73project projectionAttrNames rel =

71 case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of

74 case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of

72 Left err -> Left err

75 Left err -> Left err

73− Right newAttrs -> relFold (folder newAttrs) (Right $ Relation newAttrs HS.empty) rel

76+ Right newAttrs -> relFold (folder newAttrs) (Right $ Relation newAttrs emptyTupleSet) rel

74 where

77 where

75 folder newAttrs tupleToProject acc = case acc of

78 folder newAttrs tupleToProject acc = case acc of

76 Left err -> Left err

79 Left err -> Left err

77− Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject (A.attributeNameSet newAttrs) tupleToProject)))

80+ Right acc2 -> union acc2 (Relation newAttrs (RelationTupleSet [tupleProject (A.attributeNameSet newAttrs) tupleToProject]))

79rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

82rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

80rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

83rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

@@ -88,7 +91,7 @@ rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

88 newAttributeInUse = A.attributeNamesContained (S.singleton newAttrName) (attributeNames rel)

91 newAttributeInUse = A.attributeNamesContained (S.singleton newAttrName) (attributeNames rel)

89 attributeValid = A.attributeNamesContained (S.singleton oldAttrName) (attributeNames rel)

92 attributeValid = A.attributeNamesContained (S.singleton oldAttrName) (attributeNames rel)

90 newAttrs = A.renameAttributes oldAttrName newAttrName oldAttrs

93 newAttrs = A.renameAttributes oldAttrName newAttrName oldAttrs

91− newTupSet = HS.map tupsetmapper oldTupSet

94+ newTupSet = RelationTupleSet $ map tupsetmapper (asList oldTupSet)

92 tupsetmapper tuple = tupleRenameAttribute oldAttrName newAttrName tuple

95 tupsetmapper tuple = tupleRenameAttribute oldAttrName newAttrName tuple

94--the algebra should return a relation of one attribute and one row with the arity

97--the algebra should return a relation of one attribute and one row with the arity

@@ -98,8 +101,8 @@ arity (Relation attrs _) = A.arity attrs

98degree :: Relation -> Int

101degree :: Relation -> Int

99degree = arity

102degree = arity

100

103

101−cardinality :: Relation -> RelationCardinality

104+cardinality :: Relation -> RelationCardinality --we need to detect infinite tuple sets- perhaps with a flag

102−cardinality (Relation _ tupSet) = Countable (HS.size tupSet)

105+cardinality (Relation _ tupSet) = Countable (length (asList tupSet))

103

106

104--find tuples where the atoms in the relation which are NOT in the AttributeNameSet are equal

107--find tuples where the atoms in the relation which are NOT in the AttributeNameSet are equal

105-- create a relation for each tuple where the attributes NOT in the AttributeNameSet are equal

108-- create a relation for each tuple where the attributes NOT in the AttributeNameSet are equal

@@ -173,7 +176,7 @@ tupleUngroup relvalAttrName newAttrs tuple = do

173 nonGroupAttrNames = A.attributeNameSet newAttrs

176 nonGroupAttrNames = A.attributeNameSet newAttrs

174 folder tupleIn acc = case acc of

177 folder tupleIn acc = case acc of

175 Left err -> Left err

178 Left err -> Left err

176− Right accRel -> union accRel $ Relation newAttrs (HS.singleton (tupleExtend nonGroupTupleProjection tupleIn))

179+ Right accRel -> union accRel $ Relation newAttrs (RelationTupleSet [tupleExtend nonGroupTupleProjection tupleIn])

177

180

178attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes

181attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes

179attributesForRelval relvalAttrName (Relation attrs _) = do

182attributesForRelval relvalAttrName (Relation attrs _) = do

@@ -186,24 +189,26 @@ restrict :: (RelationTuple -> Bool) -> Relation -> Either RelationalError Relati

186--restrict rfilter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter rfilter tupset

189--restrict rfilter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter rfilter tupset

187restrict rfilter (Relation attrs tupset) = Right $ Relation attrs processedTupSet

190restrict rfilter (Relation attrs tupset) = Right $ Relation attrs processedTupSet

188 where

191 where

189− tupSetList = HS.toList tupset

190− processedTupSet = HS.fromList ((filter rfilter tupSetList) `P.using` (P.parListChunk 1000 P.rdeepseq))

192+ processedTupSet = RelationTupleSet ((filter rfilter (asList tupset)) `P.using` (P.parListChunk 1000 P.rdeepseq))

191

193

192--joins on columns with the same name- use rename to avoid this- base case: cartesian product

194--joins on columns with the same name- use rename to avoid this- base case: cartesian product

193--after changing from string atoms, there needs to be a type-checking step!

195--after changing from string atoms, there needs to be a type-checking step!

194--this is a "nested loop" scan as described by the postgresql documentation

196--this is a "nested loop" scan as described by the postgresql documentation

195join :: Relation -> Relation -> Either RelationalError Relation

197join :: Relation -> Relation -> Either RelationalError Relation

196join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

198join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

197− let newTupSet = HS.foldr tupleSetJoiner emptyTupleSet tupSet1

198− tupleSetJoiner tuple1 accumulator = HS.union (singleTupleSetJoin tuple1 tupSet2) accumulator

199 newAttrs <- A.joinAttributes attrs1 attrs2

200+ let tupleSetJoiner accumulator tuple1 = do

201+ joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2

202+ return $ joinedTupSet ++ accumulator

203+ newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)

204+ newTupSet <- mkTupleSet newAttrs newTupSetList

200 return $ Relation newAttrs newTupSet

205 return $ Relation newAttrs newTupSet

201

206

202--a map should NOT change the structure of a relation, so attributes should be constant

207--a map should NOT change the structure of a relation, so attributes should be constant

203relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation

208relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation

204relMap mapper (Relation attrs tupleSet) = do

209relMap mapper (Relation attrs tupleSet) = do

205− case forM (HS.toList tupleSet) typeMapCheck of

210+ case forM (asList tupleSet) typeMapCheck of

206− Right remappedTupleSet -> Right $ Relation attrs $ HS.fromList remappedTupleSet

211+ Right remappedTupleSet -> mkRelation attrs (RelationTupleSet remappedTupleSet)

207 Left err -> Left err

212 Left err -> Left err

208 where

213 where

209 typeMapCheck tupleIn = do

214 typeMapCheck tupleIn = do

@@ -213,10 +218,13 @@ relMap mapper (Relation attrs tupleSet) = do

213 else Left $ TupleAttributeTypeMismatchError (A.attributesDifference (tupleAttributes tupleIn) attrs)

218 else Left $ TupleAttributeTypeMismatchError (A.attributesDifference (tupleAttributes tupleIn) attrs)

214

219

215relMogrify :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

220relMogrify :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

216−relMogrify mapper newAttributes (Relation _ tupSet) = mkRelation newAttributes (HS.map mapper tupSet)

221+relMogrify mapper newAttributes (Relation _ tupSet) = do

222+ mkRelationFromTuples newAttributes newTuples

223+ where

224+ newTuples = map mapper (asList tupSet)

217

225

218relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a

226relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a

219−relFold folder acc (Relation _ tupleSet) = HS.foldr folder acc tupleSet

227+relFold folder acc (Relation _ tupleSet) = foldr folder acc (asList tupleSet)

220

228

221--image relation as defined by CJ Date

229--image relation as defined by CJ Date

222--given tupleA and relationB, return restricted relation where tuple attributes are not the attribues in tupleA but are attributes in relationB and match the tuple's value

230--given tupleA and relationB, return restricted relation where tuple attributes are not the attribues in tupleA but are attributes in relationB and match the tuple's value

@@ -247,8 +255,8 @@ matrixRelation :: Int -> Int -> Either RelationalError Relation

247matrixRelation attributeCount tupleCount = do

255matrixRelation attributeCount tupleCount = do

248 let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]

256 let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]

249 tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom tupleX))

257 tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom tupleX))

250− tupleSet = HS.fromList $ map (\c -> tuple c) [0 .. tupleCount]

258+ tuples = map (\c -> tuple c) [0 .. tupleCount]

251− mkRelation attrs tupleSet

259+ mkRelationFromTuples attrs tuples

252

260

253--used by sum atom function

261--used by sum atom function

254relationSum :: Relation -> Atom

262relationSum :: Relation -> Atom

ProjectM36/Relation/Show/CSV.hs+1−3

@@ -5,11 +5,9 @@ import Data.Csv

5import ProjectM36.Tuple

6import qualified Data.HashSet as HS

7import qualified Data.ByteString.Lazy as BS

8−import qualified Data.ByteString as BSS

9import qualified Data.Vector as V

8import qualified Data.Vector as V

10import ProjectM36.Error

9import ProjectM36.Error

11import qualified Data.Text.Encoding as TE

10import qualified Data.Text.Encoding as TE

12−import qualified Data.Text as T

14--spit out error for relations without attributes (since relTrue and relFalse cannot be distinguished then as CSV) and for relations with relation-valued attributes

12--spit out error for relations without attributes (since relTrue and relFalse cannot be distinguished then as CSV) and for relations with relation-valued attributes

15relationAsCSV :: Relation -> Either RelationalError BS.ByteString

13relationAsCSV :: Relation -> Either RelationalError BS.ByteString

@@ -18,7 +16,7 @@ relationAsCSV (Relation attrs tupleSet) = if relValAttrs /= [] then --check for

18 else if V.length attrs == 0 then --check that there is at least one attribute

16 else if V.length attrs == 0 then --check that there is at least one attribute

19 Left $ TupleAttributeCountMismatchError 0

17 Left $ TupleAttributeCountMismatchError 0

20 else

18 else

21− Right $ encodeByName bsAttrNames (HS.toList tupleSet)

19+ Right $ encodeByName bsAttrNames (asList tupleSet)

22 where

20 where

23 relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs

21 relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs

24 bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

22 bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

ProjectM36/Relation/Show/Term.hs+1−1

@@ -85,7 +85,7 @@ relationAsTable rel@(Relation _ tupleSet) = (header, body)

85 oAttrs = orderedAttributeNames rel

86 header = oAttrs

87 body :: [[Cell]]

88− body = HS.foldl' tupleFolder [] tupleSet

88+ body = L.foldl' tupleFolder [] (asList tupleSet)

89 tupleFolder acc tuple = acc ++ [map (\attrName -> case atomForAttributeName attrName tuple of

90 Left _ -> "?"

91 Right atom -> showAtom atom

ProjectM36/RelationalExpression.hs+1−1

@@ -227,7 +227,7 @@ evalContextExpr (Define relVarName attrs) = do

227 True -> return (Just (RelVarAlreadyDefinedError relVarName))

228 False -> setRelVar relVarName emptyRelation

229 where

230− emptyRelation = Relation attrs HS.empty

230+ emptyRelation = Relation attrs emptyTupleSet

231

232evalContextExpr (Undefine relVarName) = do

233 deleteRelVar relVarName

ProjectM36/TransactionGraph.hs+2−4

@@ -6,13 +6,11 @@ import ProjectM36.Transaction

6import ProjectM36.Relation

7import ProjectM36.TupleSet

8import ProjectM36.Tuple

9−import qualified Data.HashSet as HS

10import qualified Data.Vector as V

9import qualified Data.Vector as V

11import qualified ProjectM36.Attribute as A

10import qualified ProjectM36.Attribute as A

12import qualified Data.UUID as U

11import qualified Data.UUID as U

13import qualified Data.Set as S

12import qualified Data.Set as S

14import qualified Data.Map as M

13import qualified Data.Map as M

15−import Control.Applicative ((<$>))

16import Control.Monad

14import Control.Monad

17import qualified Data.Text as T

15import qualified Data.Text as T

@@ -239,8 +237,8 @@ transactionParentsRelation trans graph = do

239 mkRelation attrs emptyTupleSet

237 mkRelation attrs emptyTupleSet

240 else do

238 else do

241 parentTransSet <- parentTransactions trans graph

239 parentTransSet <- parentTransactions trans graph

242− let tupleSet = HS.fromList $ map trans2tuple (S.toList parentTransSet)

240+ let tuples = map trans2tuple (S.toList parentTransSet)

243− mkRelation attrs tupleSet

241+ mkRelationFromTuples attrs tuples

244 where

242 where

245 attrs = A.attributesFromList [Attribute "id" StringAtomType]

243 attrs = A.attributesFromList [Attribute "id" StringAtomType]

246 trans2tuple trans2 = mkRelationTuple attrs $ V.singleton (StringAtom (T.pack (show $ transactionUUID trans2)))

244 trans2tuple trans2 = mkRelationTuple attrs $ V.singleton (StringAtom (T.pack (show $ transactionUUID trans2)))

ProjectM36/Tuple.hs+18−16

@@ -6,9 +6,9 @@ import ProjectM36.Atom

7import qualified Data.Map as M

8import qualified Data.Set as S

9−import qualified Data.HashSet as HS

10import qualified Data.Vector as V

9import qualified Data.Vector as V

11import Data.Either (rights)

10import Data.Either (rights)

11+import Control.Monad

13emptyTuple :: RelationTuple

14emptyTuple = RelationTuple V.empty V.empty

@@ -82,13 +82,16 @@ mkRelationTuples attrs atomsVec = map mapper atomsVec

82 where

83 mapper = mkRelationTuple attrs

85+--return error if attribute names match but their types do not

85−singleTupleSetJoin :: RelationTuple -> RelationTupleSet -> RelationTupleSet

86+singleTupleSetJoin :: Attributes -> RelationTuple -> RelationTupleSet -> Either RelationalError [RelationTuple]

86−singleTupleSetJoin tup tupSet = HS.foldr tupleJoiner HS.empty tupSet --get rid of this fold here

87+singleTupleSetJoin joinAttrs tup tupSet = do

88+ foldM tupleJoiner [] (asList tupSet)

87 where

89 where

88− tupleJoiner tuple2 accumulator = case joinedTuple of

90+ tupleJoiner :: [RelationTuple] -> RelationTuple -> Either RelationalError [RelationTuple]

91+ tupleJoiner accumulator tuple2 = case singleTupleJoin joinAttrs tup tuple2 of

89− Nothing -> accumulator

92+ Right Nothing -> Right accumulator

90− Just relTuple -> HS.insert relTuple accumulator

93+ Right (Just relTuple) -> Right $ relTuple : accumulator

91− where joinedTuple = singleTupleJoin tup tuple2

94+ Left err -> Left err

93{-

96{-

94singleTupleSetJoin :: RelationTuple -> RelationTupleSet -> RelationTupleSet

97singleTupleSetJoin :: RelationTuple -> RelationTupleSet -> RelationTupleSet

@@ -97,21 +100,20 @@ singleTupleSetJoin tup1 tupSet = HS.union

97 mapper tup2 = singleTupleJoin tup1 tup2

100 mapper tup2 = singleTupleJoin tup1 tup2

98-}

101-}

102

100−-- the keys/values don't need to be resorted

101-- if the keys share some keys and values, then merge the tuples

103-- if the keys share some keys and values, then merge the tuples

104+-- if there are shared attributes, if they match, create a new tuple from the atoms of both tuples based on the attribute ordering argument

102−singleTupleJoin :: RelationTuple -> RelationTuple -> Maybe RelationTuple

105+singleTupleJoin :: Attributes -> RelationTuple -> RelationTuple -> Either RelationalError (Maybe RelationTuple)

103−singleTupleJoin tup1@(RelationTuple tupAttrs1 _) tup2@(RelationTuple tupAttrs2 _) = if

106+singleTupleJoin joinedAttrs tup1@(RelationTuple tupAttrs1 _) tup2@(RelationTuple tupAttrs2 _) = if

104 V.null keysIntersection || atomsForAttributeNames keysIntersection tup1 /= atomsForAttributeNames keysIntersection tup2

107 V.null keysIntersection || atomsForAttributeNames keysIntersection tup1 /= atomsForAttributeNames keysIntersection tup2

105 then

108 then

106− Nothing

109+ return $ Nothing

107 else

110 else

108− Just $ RelationTuple newAttrs newVec

111+ return $ Just $ RelationTuple joinedAttrs newVec

109 where

112 where

110 keysIntersection = V.map attributeName attrsIntersection

113 keysIntersection = V.map attributeName attrsIntersection

111 attrsIntersection = V.filter (flip V.elem $ tupAttrs1) tupAttrs2

114 attrsIntersection = V.filter (flip V.elem $ tupAttrs1) tupAttrs2

112− newAttrs = vectorUnion tupAttrs1 tupAttrs2

113− newVec = V.map (findAtomForAttributeName . attributeName) newAttrs

115+ newVec = V.map (findAtomForAttributeName . attributeName) joinedAttrs

114− --search both tuples for the

116+ --search both tuples for the attribute

115 findAtomForAttributeName attrName = head $ rights $ fmap (atomForAttributeName attrName) [tup1, tup2]

117 findAtomForAttributeName attrName = head $ rights $ fmap (atomForAttributeName attrName) [tup1, tup2]

116

118

117--same consideration as Data.List.union- duplicates in v1 are not de-duped

119--same consideration as Data.List.union- duplicates in v1 are not de-duped

@@ -182,7 +184,7 @@ verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs

182 if V.length attrs /= V.length tupleTypes then

184 if V.length attrs /= V.length tupleTypes then

183 Left $ TupleAttributeCountMismatchError 0

185 Left $ TupleAttributeCountMismatchError 0

184 else if attrsTypes /= tupleTypes then

186 else if attrsTypes /= tupleTypes then

185− --Left $ traceShow (show attrsTypes ++ "gonk" ++ show tupleTypes ++ "done") $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

187+ -- Left $ traceShow (show attrsTypes ++ "gonk" ++ show tupleTypes ++ "done") $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

186 Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

188 Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

187 else

189 else

188 Right $ tuple

190 Right $ tuple

ProjectM36/TupleSet.hs+7−9

@@ -8,30 +8,28 @@ import qualified Control.Parallel.Strategies as P

8import Data.Either

10emptyTupleSet :: RelationTupleSet

11−emptyTupleSet = HS.empty

11+emptyTupleSet = RelationTupleSet []

13singletonTupleSet :: RelationTupleSet

14−singletonTupleSet = HS.singleton emptyTuple

14+singletonTupleSet = RelationTupleSet [emptyTuple]

16--ensure that all maps have the same keys and key count

18verifyTupleSet :: Attributes -> RelationTupleSet -> Either RelationalError RelationTupleSet

19verifyTupleSet attrs tupleSet = do

20 --check that all tuples have the same attributes and that the atom types match

21− let tupleList = (map (verifyTuple attrs) (HS.toList tupleSet)) `P.using` P.parListChunk chunkSize P.r0

21+ let tupleList = (map (verifyTuple attrs) (asList tupleSet)) `P.using` P.parListChunk chunkSize P.r0

22− chunkSize = HS.size tupleSet `div` 24

22+ chunkSize = ((length . asList) tupleSet) `div` 24

23 --let tupleList = P.parMap P.rdeepseq (verifyTuple attrs) (HS.toList tupleSet)

24 if length (lefts tupleList) > 0 then

25 Left $ head (lefts tupleList)

26 else

27− return $ HS.fromList (rights tupleList)

27+ return $ RelationTupleSet (rights tupleList)

29mkTupleSet :: Attributes -> [RelationTuple] -> Either RelationalError RelationTupleSet

30mkTupleSet attrs tuples = verifyTupleSet attrs tupSet

31 where

32− tupSet = HS.fromList tuples

32+ tupSet = RelationTupleSet $ (HS.toList . HS.fromList) tuples

34mkTupleSetFromList :: Attributes -> [[Atom]] -> Either RelationalError RelationTupleSet

35−mkTupleSetFromList attrs atomMatrix = verifyTupleSet attrs tupSet

36− where

37− tupSet = HS.fromList $ map (\atomList -> mkRelationTuple attrs (V.fromList atomList)) atomMatrix

35+mkTupleSetFromList attrs atomMatrix = mkTupleSet attrs $ map (\atomList -> mkRelationTuple attrs (V.fromList atomList)) atomMatrix

TutorialD/Interpreter/RelationalExpr.hs+3−5

@@ -9,14 +9,12 @@ import qualified ProjectM36.Attribute as A

9import ProjectM36.TupleSet

10import ProjectM36.Tuple

11import ProjectM36.Relation

12−import qualified Data.HashSet as HS

13import ProjectM36.Atom

12import ProjectM36.Atom

14import qualified Data.Vector as V

13import qualified Data.Vector as V

15import qualified Data.Set as S

14import qualified Data.Set as S

16−import Control.Applicative (liftA, (<*), (*>), (<$>))

17import Data.Functor.Identity (Identity)

15import Data.Functor.Identity (Identity)

18import Data.Time.Format

16import Data.Time.Format

19−--import System.Locale

17+import Control.Applicative (liftA)

21atomTypeP :: Parser AtomType

19atomTypeP :: Parser AtomType

22atomTypeP = (reserved "char" *> return StringAtomType) <|>

20atomTypeP = (reserved "char" *> return StringAtomType) <|>

@@ -175,7 +173,7 @@ restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm

175 [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]

173 [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]

176 ]

174 ]

177 predicateTerm = parens restrictionPredicateP

175 predicateTerm = parens restrictionPredicateP

178− <|> try restrictionAtomExprP

176+ <|> try restrictionAtomExprP

179 <|> try restrictionAttributeEqualityP

177 <|> try restrictionAttributeEqualityP

180 <|> try relationalBooleanExprP

178 <|> try relationalBooleanExprP

181

179

@@ -286,7 +284,7 @@ relationP = do

286 Right rel -> return rel

284 Right rel -> return rel

287 else do

285 else do

288 tuples <- braces (sepBy tupleP comma)

286 tuples <- braces (sepBy tupleP comma)

289− case mkRelation (tupleAttributes (head tuples)) (HS.fromList tuples) of

287+ case mkRelationFromTuples (tupleAttributes (head tuples)) tuples of

290 Left err -> fail (show err)

288 Left err -> fail (show err)

291 Right rel -> return rel

289 Right rel -> return rel

292

290

test/Relation/Basic.hs+8−9

@@ -6,7 +6,6 @@ import ProjectM36.Error

6import ProjectM36.Tuple

7import ProjectM36.Atom

8import qualified ProjectM36.Attribute as A

9−import qualified Data.HashSet as HS

10import qualified Data.Vector as V

9import qualified Data.Vector as V

11import qualified Data.Set as S

10import qualified Data.Set as S

12import System.Exit

11import System.Exit

@@ -37,20 +36,20 @@ validateRelation rel = do

37 validateAttrTypesMatchTupleAttrTypes rel

36 validateAttrTypesMatchTupleAttrTypes rel

39validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation

38validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation

40−validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)

39+validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupSet)

41− | HS.null invalidSet = Right rel

40+ | null invalidSet = Right rel

42 | otherwise = Left $ AttributeNamesMismatchError S.empty

41 | otherwise = Left $ AttributeNamesMismatchError S.empty

43 where

42 where

44 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple

43 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple

45− invalidSet = HS.filter (not . nameCheck) tupMapSet

44+ invalidSet = filter (not . nameCheck) (asList tupSet)

47validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation

46validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation

48−validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = HS.foldr (\tuple acc ->

47+validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = foldr (\tuple acc ->

49 if (tupleAttributes tuple) == attrs && tupleAtomCheck tuple then

48 if (tupleAttributes tuple) == attrs && tupleAtomCheck tuple then

50 acc

49 acc

51 else

50 else

52 Left $ TupleAttributeTypeMismatchError A.emptyAttributes

51 Left $ TupleAttributeTypeMismatchError A.emptyAttributes

53− ) (Right rel) tupSet

52+ ) (Right rel) (asList tupSet)

54 where

53 where

55 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)

54 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)

56 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of

55 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of

@@ -64,7 +63,7 @@ simpleRel = case mkRelation attrs tupleSet of

64 Left _ -> undefined

63 Left _ -> undefined

65 where

64 where

66 attrs = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" StringAtomType]

65 attrs = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" StringAtomType]

67− tupleSet = HS.singleton $ mkRelationTuple attrs (V.fromList [StringAtom "spam", StringAtom "spam2"])

66+ tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [StringAtom "spam", StringAtom "spam2"])]

69--rename tests

68--rename tests

70testRename1 :: Test

69testRename1 :: Test

@@ -79,6 +78,6 @@ testMkRelation1 :: Test

79testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTypeMismatchError A.emptyAttributes) (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types

78testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTypeMismatchError A.emptyAttributes) (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types

80 where

79 where

81 testAttrs = A.attributesFromList [Attribute "a" StringAtomType]

80 testAttrs = A.attributesFromList [Attribute "a" StringAtomType]

82− testTupSet = HS.fromList [mkRelationTuple testAttrs $ V.fromList [StringAtom "v"],

81+ testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [StringAtom "v"],

83− mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]

82+ mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]

test/TutorialD/Interpreter.hs+19−21

@@ -12,7 +12,6 @@ import ProjectM36.Base

12import ProjectM36.TransactionGraph

13import ProjectM36.Client

14import qualified ProjectM36.Attribute as A

15−import qualified Data.HashSet as HS

16import qualified Data.Map as M

15import qualified Data.Map as M

17import System.Exit

16import System.Exit

18import Data.Maybe (isJust)

17import Data.Maybe (isJust)

@@ -33,7 +32,7 @@ main = do

33 ("x:=relation{a int}", mkRelation simpleAAttributes emptyTupleSet),

32 ("x:=relation{a int}", mkRelation simpleAAttributes emptyTupleSet),

34 ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),

33 ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),

35 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes emptyTupleSet),

34 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes emptyTupleSet),

36− ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ HS.singleton ((RelationTuple simpleCAttributes) (V.fromList [StringAtom "spam", IntAtom 5]))),

35+ ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ RelationTupleSet [(RelationTuple simpleCAttributes) (V.fromList [StringAtom "spam", IntAtom 5])]),

37 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),

36 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),

38 ("x:=y; x:=true", Left $ RelVarNotDefinedError "y"),

37 ("x:=y; x:=true", Left $ RelVarNotDefinedError "y"),

39 ("x:=true where true", Right relationTrue),

38 ("x:=true where true", Right relationTrue),

@@ -45,15 +44,15 @@ main = do

45 ("x:=true=true", Right relationTrue),

44 ("x:=true=true", Right relationTrue),

46 ("x:=true=false", Right relationFalse),

45 ("x:=true=false", Right relationFalse),

47 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),

46 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),

48− ("x:=relation {b int, a char}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelation simpleCAttributes (HS.fromList [RelationTuple simpleCAttributes $ V.fromList [StringAtom "spam", IntAtom 5]])),

47+ ("x:=relation {b int, a char}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList [StringAtom "spam", IntAtom 5]]),

49 -- test nested relation constructor

48 -- test nested relation constructor

50− ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ HS.singleton $ RelationTuple nestedRelationAttributes (V.fromList [IntAtom 5, RelationAtom (Relation simpleAAttributes (HS.singleton $ RelationTuple simpleAAttributes $ V.fromList [IntAtom 6]))])),

49+ ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ RelationTupleSet [RelationTuple nestedRelationAttributes (V.fromList [IntAtom 5, RelationAtom (Relation simpleAAttributes $ RelationTupleSet [RelationTuple simpleAAttributes $ V.fromList [IntAtom 6]])])]),

51− ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ HS.singleton $ RelationTuple simpleCAttributes (V.fromList [StringAtom "spam", IntAtom 5])),

50+ ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [StringAtom "spam", IntAtom 5])]),

52− ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ HS.singleton $ RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 5])),

51+ ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ RelationTupleSet [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 5])]),

53− ("x:=relation{tuple{a 5}} : {b:=6}", mkRelation simpleDAttributes $ HS.singleton $ RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 6])),

52+ ("x:=relation{tuple{a 5}} : {b:=6}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 6])]),

54− ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelation simpleDAttributes $ HS.singleton $ RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 10])),

53+ ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 10])]),

55 ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 IntAtomType StringAtomType)),

54 ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 IntAtomType StringAtomType)),

56− ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelation simpleDAttributes $ HS.singleton $ RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 12]))

55+ ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 12])])

57 ]

56 ]

58 simpleAAttributes = A.attributesFromList [Attribute "a" IntAtomType]

57 simpleAAttributes = A.attributesFromList [Attribute "a" IntAtomType]

59 simpleBAttributes = A.attributesFromList [Attribute "d" IntAtomType]

58 simpleBAttributes = A.attributesFromList [Attribute "d" IntAtomType]

@@ -67,29 +66,28 @@ main = do

67 dateExampleRelTests = [("x:=S where true", Right suppliersRel),

66 dateExampleRelTests = [("x:=S where true", Right suppliersRel),

68 ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ StringAtom "London")) suppliersRel),

67 ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ StringAtom "London")) suppliersRel),

69 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),

68 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),

70− ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [ Attribute "STATUS" IntAtomType]) (HS.singleton $ mkRelationTuple (A.attributesFromList [Attribute "STATUS" IntAtomType]) (V.fromList [IntAtom 50]))),

69+ ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [ Attribute "STATUS" IntAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "STATUS" IntAtomType]) (V.fromList [IntAtom 50])])),

71 --atom function tests

70 --atom function tests

72 ("x:=((S : {STATUS2 := add(10,@STATUS)}) where STATUS2=add(10,@STATUS)){CITY,S#,SNAME,STATUS}", Right suppliersRel),

71 ("x:=((S : {STATUS2 := add(10,@STATUS)}) where STATUS2=add(10,@STATUS)){CITY,S#,SNAME,STATUS}", Right suppliersRel),

73 ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ StringAtom "Blake") then updateTuple (M.singleton "CITY" (StringAtom "Boston")) tuple else tuple) suppliersRel),

72 ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ StringAtom "Blake") then updateTuple (M.singleton "CITY" (StringAtom "Boston")) tuple else tuple) suppliersRel),

74− ("x:=relation{tuple{a 5}} : {b:=S}", mkRelation extendTestAttributes (HS.singleton $ mkRelationTuple extendTestAttributes (V.fromList [IntAtom 5, RelationAtom suppliersRel]))),

73+ ("x:=relation{tuple{a 5}} : {b:=S}", mkRelation extendTestAttributes (RelationTupleSet [mkRelationTuple extendTestAttributes (V.fromList [IntAtom 5, RelationAtom suppliersRel])])),

75 --relatom function tests

74 --relatom function tests

76− ("x:=((S group ({CITY} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (HS.singleton $ mkRelationTuple groupCountAttrs (V.singleton $ IntAtom 1))),

75+ ("x:=((S group ({CITY} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ IntAtom 1)])),

77 ("x:=(SP group ({S#} as y)) ungroup y", Right supplierProductsRel),

76 ("x:=(SP group ({S#} as y)) ungroup y", Right supplierProductsRel),

78 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

77 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

79 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

78 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

80 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

79 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

81− --boolean function restriction

80+ --boolean function restriction

82− ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

81+ ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

83− ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S3", StringAtom "Blake", IntAtom 30, StringAtom "Paris"],

82+ ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S3", StringAtom "Blake", IntAtom 30, StringAtom "Paris"],

84− [StringAtom "S5", StringAtom "Adams", IntAtom 30, StringAtom "Athens"]]),

83+ [StringAtom "S5", StringAtom "Adams", IntAtom 30, StringAtom "Athens"]]),

85− ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError IntAtomType BoolAtomType),

84+ ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError IntAtomType BoolAtomType),

86− ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

85+ ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

87− --test "all but" attribute inversion syntax

86+ --test "all but" attribute inversion syntax

88− ("x:=S{all but S#} = S{CITY,SNAME,STATUS}", Right $ relationTrue),

87+ ("x:=S{all but S#} = S{CITY,SNAME,STATUS}", Right $ relationTrue),

89 --test key syntax

88 --test key syntax

90 ("x:=S; key testconstraint {S#,CITY} x; insert x relation{tuple{CITY \"London\", S# \"S1\", SNAME \"gonk\", STATUS 50}}", Left (InclusionDependencyCheckError "testconstraint")),

89 ("x:=S; key testconstraint {S#,CITY} x; insert x relation{tuple{CITY \"London\", S# \"S1\", SNAME \"gonk\", STATUS 50}}", Left (InclusionDependencyCheckError "testconstraint")),

91 ("y:=S; key testconstraint {S#} y; insert y relation{tuple{CITY \"London\", S# \"S6\", SNAME \"gonk\", STATUS 50}}; x:=y{S#} = S{S#} union relation{tuple{S# \"S6\"}}", Right $ relationTrue)

90 ("y:=S; key testconstraint {S#} y; insert y relation{tuple{CITY \"London\", S# \"S6\", SNAME \"gonk\", STATUS 50}}; x:=y{S#} = S{S#} union relation{tuple{S# \"S6\"}}", Right $ relationTrue)

92−

93 ]

91 ]

test/TutorialD/Interpreter/Import/TutorialD.hs+1−2

@@ -3,7 +3,6 @@ import Test.HUnit

3import ProjectM36.Base

4import qualified ProjectM36.Attribute as A

5import TutorialD.Interpreter.Import.TutorialD

6−import qualified Data.HashSet as HS

7import System.Exit

6import System.Exit

8import System.IO.Temp

7import System.IO.Temp

9import qualified ProjectM36.DatabaseContext as DC

8import qualified ProjectM36.DatabaseContext as DC

@@ -21,7 +20,7 @@ testTutdImport = TestCase $ do

21 withSystemTempFile "m.tutd" $ \tempPath handle -> do

20 withSystemTempFile "m.tutd" $ \tempPath handle -> do

22 hPutStrLn handle "x:=relation{tuple{a 5,b \"spam\"}}"

21 hPutStrLn handle "x:=relation{tuple{a 5,b \"spam\"}}"

23 hClose handle

22 hClose handle

24− let expectedExpr = MultipleExpr [Assign "x" (ExistingRelation (Relation expectedAttrs $ HS.singleton (RelationTuple expectedAttrs $ V.fromList [IntAtom 5, StringAtom "spam"])))]

23+ let expectedExpr = MultipleExpr [Assign "x" (ExistingRelation (Relation expectedAttrs $ RelationTupleSet [RelationTuple expectedAttrs $ V.fromList [IntAtom 5, StringAtom "spam"]]))]

25 expectedAttrs = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" StringAtomType]

24 expectedAttrs = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" StringAtomType]

26 imported <- importTutorialD tempPath DC.empty

25 imported <- importTutorialD tempPath DC.empty

27 assertEqual "import tutd" (Right expectedExpr) imported

26 assertEqual "import tutd" (Right expectedExpr) imported