afbe31d · project-m36 · git.iko.soy

git.iko.soy/project-m36

Merge branch 'tuplesettolist'

Conflicts: TutorialD/Interpreter/RelationalExpr.hs

commitafbe31d18815471d6c9bf4c69a6a2b410be5a62f authorAgentM <agentm@themactionfaction.com> dateSat 19 Sep 2015, 21:14 (11 years ago) parente37332d c2dac1b

12 files changed+102−97

compare with master

unifiedsplit

ProjectM36/Base.hs+12−5 ProjectM36/Relation.hs+29−21 ProjectM36/Relation/Show/CSV.hs+1−3 ProjectM36/Relation/Show/Term.hs+1−1 ProjectM36/RelationalExpression.hs+1−1 ProjectM36/TransactionGraph.hs+2−4 ProjectM36/Tuple.hs+18−16 ProjectM36/TupleSet.hs+7−9 TutorialD/Interpreter/RelationalExpr.hs+3−5 test/Relation/Basic.hs+8−9 test/TutorialD/Interpreter.hs+19−21 test/TutorialD/Interpreter/Import/TutorialD.hs+1−2

ProjectM36/Base.hs+12−5

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

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

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

22module ProjectM36.Base where

33import qualified Data.Map as M

44import qualified Data.HashSet as HS

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

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

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

8686

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

8895

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

9097instance Hash.Hashable RelationTuple where

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

121128instance Hash.Hashable Relation where

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

123130 sortedAttrs `Hash.hashWithSalt`

124− HS.toList tupSet

131+ asList tupSet

125132 where

126133 sortedAttrs = map snd (sortedAttributesIndices attrs)

127134

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

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

280287

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

282− InvertedAttributeNames (S.Set AttributeName)

283− deriving (Eq, Show, Generic)

289+ InvertedAttributeNames (S.Set AttributeName)

290+ deriving (Eq, Show, Generic)

284291

285292instance Binary AttributeNames

286293

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 #-}

32module ProjectM36.Relation where

43import qualified Data.Set as S

54import qualified Data.HashSet as HS

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

1211import qualified ProjectM36.AttributeNames as AS

1312import ProjectM36.TupleSet

1413import ProjectM36.Error

15−import Prelude hiding (join)

1614import qualified Data.Text as T

1715import qualified Control.Parallel.Strategies as P

1816

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

4442 Left err -> Left err

4543 Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

4644

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

46+mkRelationFromTuples attrs tupleSetList = do

47+ tupSet <- mkTupleSet attrs tupleSetList

48+ mkRelation attrs tupSet

49+

4750relationTrue :: Relation

4851relationTrue = Relation A.emptyAttributes singletonTupleSet

4952

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

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

5457singletonTuple :: Relation -> Maybe RelationTuple

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

56− Just $ head $ HS.toList tupleSet

59+ Just $ head $ asList tupleSet

5760 else

5861 Nothing

5962

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

6467 else

6568 Right $ Relation attrs1 newtuples

6669 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))

6871

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

7073project projectionAttrNames rel =

7174 case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of

7275 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

7477 where

7578 folder newAttrs tupleToProject acc = case acc of

7679 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]))

7881

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

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

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

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

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

9093 newAttrs = A.renameAttributes oldAttrName newAttrName oldAttrs

91− newTupSet = HS.map tupsetmapper oldTupSet

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

9295 tupsetmapper tuple = tupleRenameAttribute oldAttrName newAttrName tuple

9396

9497--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

98101degree :: Relation -> Int

99102degree = arity

100103

101−cardinality :: Relation -> RelationCardinality

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

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

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

103106

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

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

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

173176 nonGroupAttrNames = A.attributeNameSet newAttrs

174177 folder tupleIn acc = case acc of

175178 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])

177180

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

179182attributesForRelval relvalAttrName (Relation attrs _) = do

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

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

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

188191 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))

191193

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

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

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

195197join :: Relation -> Relation -> Either RelationalError Relation

196198join (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

199199 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

200205 return $ Relation newAttrs newTupSet

201206

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

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

204209relMap mapper (Relation attrs tupleSet) = do

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

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

210+ case forM (asList tupleSet) typeMapCheck of

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

207212 Left err -> Left err

208213 where

209214 typeMapCheck tupleIn = do

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

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

214219

215220relMogrify :: (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)

217225

218226relFold :: (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)

220228

221229--image relation as defined by CJ Date

222230--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

247255matrixRelation attributeCount tupleCount = do

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

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

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

251− mkRelation attrs tupleSet

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

259+ mkRelationFromTuples attrs tuples

252260

253261--used by sum atom function

254262relationSum :: Relation -> Atom

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

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

55import ProjectM36.Tuple

66import qualified Data.HashSet as HS

77import qualified Data.ByteString.Lazy as BS

8−import qualified Data.ByteString as BSS

98import qualified Data.Vector as V

109import ProjectM36.Error

1110import qualified Data.Text.Encoding as TE

12−import qualified Data.Text as T

1311

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

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

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

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

1917 Left $ TupleAttributeCountMismatchError 0

2018 else

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

19+ Right $ encodeByName bsAttrNames (asList tupleSet)

2220 where

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

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

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

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

8585 oAttrs = orderedAttributeNames rel

8686 header = oAttrs

8787 body :: [[Cell]]

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

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

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

9090 Left _ -> "?"

9191 Right atom -> showAtom atom

ProjectM36/RelationalExpression.hs+1−1

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

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

228228 False -> setRelVar relVarName emptyRelation

229229 where

230− emptyRelation = Relation attrs HS.empty

230+ emptyRelation = Relation attrs emptyTupleSet

231231

232232evalContextExpr (Undefine relVarName) = do

233233 deleteRelVar relVarName

ProjectM36/TransactionGraph.hs+2−4

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

66import ProjectM36.Relation

77import ProjectM36.TupleSet

88import ProjectM36.Tuple

9−import qualified Data.HashSet as HS

109import qualified Data.Vector as V

1110import qualified ProjectM36.Attribute as A

1211import qualified Data.UUID as U

1312import qualified Data.Set as S

1413import qualified Data.Map as M

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

1614import Control.Monad

1715import qualified Data.Text as T

1816

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

239237 mkRelation attrs emptyTupleSet

240238 else do

241239 parentTransSet <- parentTransactions trans graph

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

243− mkRelation attrs tupleSet

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

241+ mkRelationFromTuples attrs tuples

244242 where

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

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

ProjectM36/Tuple.hs+18−16

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

77import qualified Data.Map as M

88import qualified Data.Set as S

9−import qualified Data.HashSet as HS

109import qualified Data.Vector as V

1110import Data.Either (rights)

11+import Control.Monad

1212

1313emptyTuple :: RelationTuple

1414emptyTuple = RelationTuple V.empty V.empty

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

8282 where

8383 mapper = mkRelationTuple attrs

8484

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

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

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

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

87+singleTupleSetJoin joinAttrs tup tupSet = do

88+ foldM tupleJoiner [] (asList tupSet)

8789 where

88− tupleJoiner tuple2 accumulator = case joinedTuple of

89− Nothing -> accumulator

90− Just relTuple -> HS.insert relTuple accumulator

91− where joinedTuple = singleTupleJoin tup tuple2

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

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

92+ Right Nothing -> Right accumulator

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

94+ Left err -> Left err

9295

9396{-

9497singleTupleSetJoin :: RelationTuple -> RelationTupleSet -> RelationTupleSet

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

97100 mapper tup2 = singleTupleJoin tup1 tup2

98101-}

99102

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

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

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

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

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

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

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

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

105108 then

106− Nothing

109+ return $ Nothing

107110 else

108− Just $ RelationTuple newAttrs newVec

111+ return $ Just $ RelationTuple joinedAttrs newVec

109112 where

110113 keysIntersection = V.map attributeName attrsIntersection

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

112− newAttrs = vectorUnion tupAttrs1 tupAttrs2

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

114− --search both tuples for the

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

116+ --search both tuples for the attribute

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

116118

117119--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

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

183185 Left $ TupleAttributeCountMismatchError 0

184186 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))

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

187189 else

188190 Right $ tuple

ProjectM36/TupleSet.hs+7−9

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

88import Data.Either

1010emptyTupleSet :: RelationTupleSet

11−emptyTupleSet = HS.empty

11+emptyTupleSet = RelationTupleSet []

1212

1313singletonTupleSet :: RelationTupleSet

14−singletonTupleSet = HS.singleton emptyTuple

14+singletonTupleSet = RelationTupleSet [emptyTuple]

1515

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

1717

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

1919verifyTupleSet attrs tupleSet = do

2020 --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

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

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

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

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

2424 if length (lefts tupleList) > 0 then

2525 Left $ head (lefts tupleList)

2626 else

27− return $ HS.fromList (rights tupleList)

27+ return $ RelationTupleSet (rights tupleList)

2828

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

3030mkTupleSet attrs tuples = verifyTupleSet attrs tupSet

3131 where

32− tupSet = HS.fromList tuples

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

3333

3434mkTupleSetFromList :: 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

99import ProjectM36.TupleSet

1010import ProjectM36.Tuple

1111import ProjectM36.Relation

12−import qualified Data.HashSet as HS

1312import ProjectM36.Atom

1413import qualified Data.Vector as V

1514import qualified Data.Set as S

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

1715import Data.Functor.Identity (Identity)

1816import Data.Time.Format

19−--import System.Locale

17+import Control.Applicative (liftA)

2018

2119atomTypeP :: Parser AtomType

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

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

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

176174 ]

177175 predicateTerm = parens restrictionPredicateP

178− <|> try restrictionAtomExprP

176+ <|> try restrictionAtomExprP

179177 <|> try restrictionAttributeEqualityP

180178 <|> try relationalBooleanExprP

181179

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

286284 Right rel -> return rel

287285 else do

288286 tuples <- braces (sepBy tupleP comma)

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

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

290288 Left err -> fail (show err)

291289 Right rel -> return rel

292290

test/Relation/Basic.hs+8−9

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

66import ProjectM36.Tuple

77import ProjectM36.Atom

88import qualified ProjectM36.Attribute as A

9−import qualified Data.HashSet as HS

109import qualified Data.Vector as V

1110import qualified Data.Set as S

1211import System.Exit

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

3736 validateAttrTypesMatchTupleAttrTypes rel

3837

3938validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation

40−validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)

41− | HS.null invalidSet = Right rel

39+validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupSet)

40+ | null invalidSet = Right rel

4241 | otherwise = Left $ AttributeNamesMismatchError S.empty

4342 where

4443 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple

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

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

4645

4746validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation

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

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

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

5049 acc

5150 else

5251 Left $ TupleAttributeTypeMismatchError A.emptyAttributes

53− ) (Right rel) tupSet

52+ ) (Right rel) (asList tupSet)

5453 where

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

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

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

6463 Left _ -> undefined

6564 where

6665 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"])]

6867

6968--rename tests

7069testRename1 :: Test

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

7978testMkRelation1 = 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

8079 where

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

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

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

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

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

8483

test/TutorialD/Interpreter.hs+19−21

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

1212import ProjectM36.TransactionGraph

1313import ProjectM36.Client

1414import qualified ProjectM36.Attribute as A

15−import qualified Data.HashSet as HS

1615import qualified Data.Map as M

1716import System.Exit

1817import Data.Maybe (isJust)

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

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

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

3534 ("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])]),

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

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

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

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

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

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

4746 ("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]]),

4948 -- 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]))])),

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])),

52− ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ HS.singleton $ 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])),

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

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]])])]),

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])]),

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

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

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

5554 ("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])])

5756 ]

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

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

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

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

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

6968 ("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])])),

7170 --atom function tests

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

7372 ("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])])),

7574 --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)])),

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

7877 ("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)])),

7978 ("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)])),

8079 ("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

82− ("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"],

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

85− ("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"]]),

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

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

80+ --boolean function restriction

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

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

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

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

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

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

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

8988 --test key syntax

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

9190 ("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−

9391 ]

9492

9593

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

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

33import ProjectM36.Base

44import qualified ProjectM36.Attribute as A

55import TutorialD.Interpreter.Import.TutorialD

6−import qualified Data.HashSet as HS

76import System.Exit

87import System.IO.Temp

98import qualified ProjectM36.DatabaseContext as DC

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

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

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

2322 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"]]))]

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

2625 imported <- importTutorialD tempPath DC.empty

2726 assertEqual "import tutd" (Right expectedExpr) imported