a318000 · project-m36 · git.iko.soy

git.iko.soy/project-m36

introduce "key" syntax for TutorialD with backing support via inclusion dependencies

all tests pass

commita3180004ca45740b0dbfd4078dca18a85ae13b12 authorAgentM <agentm@themactionfaction.com> dateFri 12 Jun 2015, 13:08 (11 years ago) parent5866ddb

12 files changed+163−78

compare with master

unifiedsplit

ProjectM36/Base.hs+6−10 ProjectM36/Error.hs+1 ProjectM36/Key.hs+33 ProjectM36/Relation.hs+5−5 ProjectM36/RelationalExpression.hs+39−16 ProjectM36/StaticOptimizer.hs+5−1 TutorialD/Interpreter/Base.hs−7 TutorialD/Interpreter/DatabaseExpr.hs+14−1 TutorialD/Interpreter/RODatabaseContextOperator.hs+7−6 TutorialD/Interpreter/RelationalExpr.hs+35−22 project-m36.cabal+1 test/TutorialD/Interpreter.hs+17−10

ProjectM36/Base.hs+6−10

@@ -112,25 +112,20 @@ data RelationalExpr where

112112 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

113113 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

114114 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

115+ NotEquals :: RelationalExpr -> RelationalExpr -> RelationalExpr

115116 Extend :: TupleExpr -> RelationalExpr -> RelationalExpr

116117 --Summarize :: AtomExpr -> AttributeName -> RelationalExpr -> RelationalExpr -> RelationalExpr -- a special case of Extend

117118 deriving (Show,Eq)

118119

119120data DatabaseContext = DatabaseContext {

120− inclusionDependencies :: HS.HashSet InclusionDependency,

121− relationVariables :: M.Map RelVarName Relation,

121+ inclusionDependencies :: M.Map IncDepName InclusionDependency,

122+ relationVariables :: M.Map RelVarName Relation,

122123 atomFunctions :: AtomFunctions

123124 } deriving (Show)

124125

125126type IncDepName = StringType

126127

127−data InclusionDependency = InclusionDependency IncDepName RelationalExpr RelationalExpr deriving (Show)

128−

129−instance Hash.Hashable InclusionDependency where

130− hashWithSalt salt dep = Hash.hashWithSalt salt (show dep)

131−

132−instance Eq InclusionDependency where

133− (==) (InclusionDependency nameA _ _) (InclusionDependency nameB _ _) = nameA == nameB

128+data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq)

134129

135130--Database context expressions modify the database context while relational expressions do not

136131data DatabaseExpr where

@@ -140,7 +135,8 @@ data DatabaseExpr where

140135 Insert :: RelVarName -> RelationalExpr -> DatabaseExpr

141136 Delete :: RelVarName -> RestrictionPredicateExpr -> DatabaseExpr

142137 Update :: RelVarName -> M.Map AttributeName Atom -> RestrictionPredicateExpr -> DatabaseExpr -- needs restriction support

143− AddInclusionDependency :: InclusionDependency -> DatabaseExpr

138+ AddInclusionDependency :: IncDepName -> InclusionDependency -> DatabaseExpr

139+ RemoveInclusionDependency :: IncDepName -> DatabaseExpr

144140 MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

145141 deriving (Show,Eq)

146142

ProjectM36/Error.hs+1

@@ -20,6 +20,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

2020 | RelVarAlreadyDefinedError RelVarName

2121 | RelVarAssignmentTypeMismatchError Attributes Attributes --expected, found

2222 | InclusionDependencyCheckError IncDepName

23+ | InclusionDepedencyNameInUseError IncDepName

2324 | ParseError T.Text

2425 | PredicateExpressionError T.Text

2526 | NoSuchTransactionError U.UUID

ProjectM36/Key.hsnew file+33

@@ -0,0 +1,33 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module ProjectM36.Key where

3+import ProjectM36.Base

4+import ProjectM36.Relation

5+import qualified Data.Set as S

7+{-

8+keys can be implemented using inclusion dependencies as well: the count of the projection of the keys' attributes must be equal to the count of the tuples- p. 120 Database in Depth

10+example:

11+:showexpr ((relation{tuple{}}:{a:=S}):{b:=count(@a)}){b}

12+┌─┐

13+│b│

14+├─┤

15+│5│

16+└─┘

17+((relation{tuple{}}:{a:=S{S#}}):{b:=count(@a)}){b}

18+┌─┐

19+│b│

20+├─┤

21+│5│

22+└─┘

23+-}

24+inclusionDependencyForKey :: AttributeNames -> RelationalExpr -> InclusionDependency

25+inclusionDependencyForKey attrNames relExpr = --InclusionDependency name (exprCount relExpr) (exprCount (projectedOnKeys relExpr))

26+ InclusionDependency equalityExpr (ExistingRelation relationFalse)

27+ where

28+ projectedOnKeys expr = Project attrNames expr

29+ exprAsSubRelation expr = Extend (AttributeTupleExpr "a" (RelationAtomExpr expr)) (ExistingRelation relationTrue)

30+ exprCount expr = projectionForCount (Extend (AttributeTupleExpr "b" (FunctionAtomExpr "count" [AttributeAtomExpr "a"])) (exprAsSubRelation expr))

31+ projectionForCount expr = Project (AttributeNames $ S.fromList ["b"]) expr

32+ equalityExpr = NotEquals (exprCount relExpr) (exprCount (projectedOnKeys relExpr))

33+

ProjectM36/Relation.hs+5−5

@@ -73,12 +73,12 @@ singletonValueFromRelation rel@(Relation _ tupSet) = if cardinality rel /= Count

7373

7474union :: Relation -> Relation -> Either RelationalError Relation

7575union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

76− if not (attrs1 == attrs2)

76+ if not (A.attributesEqual attrs1 attrs2)

7777 then Left $ AttributeNamesMismatchError (A.attributeNameSet (A.attributesDifference attrs1 attrs2))

7878 else

7979 Right $ Relation attrs1 newtuples

8080 where

81− newtuples = HS.union tupSet1 tupSet2

81+ newtuples = HS.union tupSet1 (HS.map (reorderTuple attrs1) tupSet2)

8282

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

8484project projectionAttrNames rel =

@@ -209,8 +209,8 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

209209 tupleSetJoiner tuple1 accumulator = HS.union (singleTupleSetJoin tuple1 tupSet2) accumulator

210210 newAttrs <- A.joinAttributes attrs1 attrs2

211211 return $ Relation newAttrs newTupSet

212−

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

212+

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

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

215215relMap mapper (Relation attrs tupleSet) = do

216216 case forM (HS.toList tupleSet) typeMapCheck of

@@ -221,7 +221,7 @@ relMap mapper (Relation attrs tupleSet) = do

221221 let remappedTuple = mapper tupleIn

222222 if tupleAttributes remappedTuple == tupleAttributes tupleIn

223223 then Right remappedTuple

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

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

225225

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

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

ProjectM36/RelationalExpression.hs+39−16

@@ -89,6 +89,16 @@ evalRelationalExpr (Equals relExprA relExprB) = do

8989 Left err -> return $ Left err

9090 Right relB -> return $ Right $ if relA == relB then relationTrue else relationFalse

9191

92+--warning: copy-pasta from above- refactor

93+evalRelationalExpr (NotEquals relExprA relExprB) = do

94+ evaldA <- evalRelationalExpr relExprA

95+ evaldB <- evalRelationalExpr relExprB

96+ case evaldA of

97+ Left err -> return $ Left err

98+ Right relA -> case evaldB of

99+ Left err -> return $ Left err

100+ Right relB -> return $ Right $ if relA /= relB then relationTrue else relationFalse

101+

92102-- extending a relation adds a single attribute with the results of the per-tuple expression evaluated

93103evalRelationalExpr (Extend tupleExpression relExpr) = do

94104 evald <- evalRelationalExpr relExpr

@@ -101,20 +111,20 @@ evalRelationalExpr (Extend tupleExpression relExpr) = do

101111 Right (newAttrs, tupProc) -> return $ relMogrify tupProc newAttrs rel

102112

103113emptyDatabaseContext :: DatabaseContext

104−emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

114+emptyDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

105115 relationVariables = M.empty,

106116 atomFunctions = HS.empty

107117 }

108118

109119basicDatabaseContext :: DatabaseContext

110−basicDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

120+basicDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

111121 relationVariables = M.fromList [("true", relationTrue),

112122 ("false", relationFalse)],

113123 atomFunctions = basicAtomFunctions

114124 }

115125

116126dateExamples :: DatabaseContext

117−dateExamples = DatabaseContext { inclusionDependencies = HS.empty, -- add foreign key relationships

127+dateExamples = DatabaseContext { inclusionDependencies = M.empty,

118128 relationVariables = M.union (relationVariables basicDatabaseContext) dateRelVars,

119129 atomFunctions = basicAtomFunctions}

120130 where

@@ -186,12 +196,13 @@ productsRel = case mkRelationFromList attrs matrix of

186196--helper function to process relation variable creation/assignment

187197setRelVar :: RelVarName -> Relation -> DatabaseState (Maybe RelationalError)

188198setRelVar relVarName rel = do

189− currstate <- get

190− let newRelVars = M.insert relVarName rel $ relationVariables currstate

191− case checkConstraints currstate of

199+ currentContext <- get

200+ let newRelVars = M.insert relVarName rel $ relationVariables currentContext

201+ let potentialContext = DatabaseContext (inclusionDependencies currentContext) newRelVars (atomFunctions currentContext)

202+ case checkConstraints potentialContext of

192203 Just err -> return $ Just err

193204 Nothing -> do

194− put $ DatabaseContext (inclusionDependencies currstate) newRelVars (atomFunctions currstate)

205+ put potentialContext

195206 return Nothing

196207

197208-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation

@@ -258,10 +269,21 @@ evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = d

258269 updatedPortion <- relMap (updateTuple attrAssignments) restrictedPortion

259270 union updatedPortion unrestrictedPortion

260271

261−evalContextExpr (AddInclusionDependency dep) = do

262− currstate <- get

263− let newDeps = HS.insert dep (inclusionDependencies currstate)

264− put $ DatabaseContext newDeps (relationVariables currstate) (atomFunctions currstate)

272+evalContextExpr (AddInclusionDependency newDepName newDep) = do

273+ currContext <- get

274+ let currDeps = inclusionDependencies currContext

275+ newDeps = M.insert newDepName newDep currDeps

276+ if M.member newDepName currDeps then

277+ return $ Just (InclusionDepedencyNameInUseError newDepName)

278+ else do

279+ put $ DatabaseContext newDeps (relationVariables currContext) (atomFunctions currContext)

280+ return Nothing

281+

282+evalContextExpr (RemoveInclusionDependency depName) = do

283+ currContext <- get

284+ let currDeps = inclusionDependencies currContext

285+ newDeps = M.delete depName currDeps

286+ put $ DatabaseContext newDeps (relationVariables currContext) (atomFunctions currContext)

265287 return Nothing

266288

267289evalContextExpr (MultipleExpr exprs) = do

@@ -281,18 +303,19 @@ checkConstraints context = case failures of

281303 [] -> Nothing

282304 l:_ -> Just l

283305 where

284− failures = catMaybes $ map checkIncDep (HS.toList deps)

306+ failures = M.elems $ M.mapMaybeWithKey checkIncDep deps

285307 deps = inclusionDependencies context

286308 eval expr = runState (evalRelationalExpr expr) context

287− checkIncDep (InclusionDependency depName subsetExpr supersetExpr) = case evaldSub of

309+ checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = case evaldSub of

288310 (Left err, _) -> Just err

289311 (Right relSub, _) -> case evaldSuper of

290312 (Left err, _) -> Just err

291313 (Right relSuper, _) -> case union relSub relSuper of

292314 Left err -> Just err

293− Right resultRel -> case resultRel == relSuper of

294− False -> Just $ InclusionDependencyCheckError depName

295− True -> Nothing

315+ Right resultRel -> if resultRel == relSuper then

316+ Nothing

317+ else

318+ Just $ InclusionDependencyCheckError depName

296319 where

297320 evaldSub = eval subsetExpr

298321 evaldSuper = eval supersetExpr

ProjectM36/StaticOptimizer.hs+5−1

@@ -83,6 +83,8 @@ applyStaticRelationalOptimization (Restrict predicate expr) = do

8383 Right optSubExpr -> return $ Right $ Restrict optimizedPredicate2 optSubExpr

8484

8585applyStaticRelationalOptimization e@(Equals _ _) = return $ Right e

86+

87+applyStaticRelationalOptimization e@(NotEquals _ _) = return $ Right e

8688

8789applyStaticRelationalOptimization e@(Extend _ _) = return $ Right e

8890

@@ -115,7 +117,9 @@ applyStaticDatabaseOptimization (Update name upmap predicate) = do

115117 Left err -> return $ Left err

116118 Right optimizedPredicate2 -> return $ Right (Update name upmap optimizedPredicate2)

117119

118−applyStaticDatabaseOptimization (AddInclusionDependency dep) = return $ Right (AddInclusionDependency dep)

120+applyStaticDatabaseOptimization dep@(AddInclusionDependency _ _) = return $ Right dep

121+

122+applyStaticDatabaseOptimization (RemoveInclusionDependency name) = return $ Right (RemoveInclusionDependency name)

119123

120124--optimization: from pgsql lists- check for join condition referencing foreign key- if join projection project away the referenced table, then it does not need to be scanned

121125

TutorialD/Interpreter/Base.hs−7

@@ -44,13 +44,6 @@ semi = Token.semi lexer

4444whiteSpace :: Parser ()

4545whiteSpace = Token.whiteSpace lexer

4646

47−--convert Tutorial D type to AtomType

48−tutDTypeToAtomType :: String -> Maybe AtomType

49−tutDTypeToAtomType tutDType = case tutDType of

50− "char" -> Just StringAtomType

51− "int" -> Just IntAtomType

52− _ -> Nothing

53−

5447atomTypeToTutDType :: AtomType -> Maybe T.Text

5548atomTypeToTutDType atomType = case atomType of

5649 StringAtomType -> Just "char"

TutorialD/Interpreter/DatabaseExpr.hs+14−1

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

1+{-# LANGUAGE OverloadedStrings #-}

12module TutorialD.Interpreter.DatabaseExpr where

23import Text.Parsec

34import Text.Parsec.String

@@ -11,6 +12,7 @@ import Control.Monad.State

1112import ProjectM36.StaticOptimizer

1213import ProjectM36.Error

1314import ProjectM36.RelationalExpression

15+import ProjectM36.Key

1416

1517--parsers which create "database expressions" which modify the database context (such as relvar assignment)

1618databaseExprP :: Parser DatabaseExpr

@@ -18,6 +20,7 @@ databaseExprP = insertP

1820 <|> deleteP

1921 <|> updateP

2022 <|> constraintP

23+ <|> keyP

2124 <|> defineP

2225 <|> undefineP

2326 <|> assignP

@@ -80,7 +83,17 @@ constraintP = do

8083 subset <- relExprP

8184 reservedOp "in"

8285 superset <- relExprP

83− return $ AddInclusionDependency (InclusionDependency (T.pack constraintName) subset superset)

86+ return $ AddInclusionDependency (T.pack constraintName) (InclusionDependency subset superset)

87+

88+-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>

89+keyP :: Parser DatabaseExpr

90+keyP = do

91+ reserved "key"

92+ keyName <- identifier

93+ uniquenessAttrNames <- braces attributeListP

94+ uniquenessExpr <- relExprP

95+ let newIncDep = inclusionDependencyForKey uniquenessAttrNames uniquenessExpr

96+ return $ AddInclusionDependency (T.pack keyName) newIncDep

8497

8598attributeAssignmentP :: Parser (String, Atom)

8699attributeAssignmentP = do

TutorialD/Interpreter/RODatabaseContextOperator.hs+7−6

@@ -11,8 +11,8 @@ import TutorialD.Interpreter.RelationalExpr

1111import TutorialD.Interpreter.DatabaseExpr

1212import Control.Monad.State

1313import qualified Data.Text as T

14−import qualified Data.HashSet as HS

1514import ProjectM36.Relation.Show.Term

15+import qualified Data.Map as M

1616

1717--operators which only rely on database context reading

1818data RODatabaseContextOperator where

@@ -69,13 +69,14 @@ evalRODatabaseContextOp context (ShowRelation expr) = do

6969 (Left err, _) -> DisplayErrorResult $ T.pack (show err)

7070 (Right rel, _) -> DisplayResult $ showRelation rel

7171

72−evalRODatabaseContextOp context (ShowConstraint name) = do

73− DisplayResult $ T.pack (show filteredDeps)

72+evalRODatabaseContextOp context (ShowConstraint name) =

73+ case name of

74+ "" -> DisplayResult $ T.pack (show deps)

75+ depName -> case M.lookup depName deps of

76+ Nothing -> DisplayErrorResult "No such constraint."

77+ Just dep -> DisplayResult $ T.pack (show dep)

7478 where

7579 deps = inclusionDependencies context

76− filteredDeps = case name of

77− "" -> deps

78− name2 -> HS.filter (\(InclusionDependency n _ _) -> n == name2) deps

7980

8081evalRODatabaseContextOp context (ShowPlan dbExpr) = do

8182 DisplayResult $ T.pack (show plan)

TutorialD/Interpreter/RelationalExpr.hs+35−22

@@ -8,6 +8,7 @@ import qualified Data.Text as T

88import qualified ProjectM36.Attribute as A

99import ProjectM36.TupleSet

1010import ProjectM36.Tuple

11+import ProjectM36.Relation

1112import qualified Data.HashSet as HS

1213import ProjectM36.Atom

1314import qualified Data.Vector as V

@@ -15,6 +16,12 @@ import qualified Data.Set as S

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

1617import Data.Functor.Identity (Identity)

1718

19+

20+atomTypeP :: Parser AtomType

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

22+ (reserved "int" *> return IntAtomType) <|>

23+ (RelationAtomType <$> (reserved "relation" *> makeAttributesP))

24+

1825--used in projection

1926attributeListP :: Parser AttributeNames

2027attributeListP = do

@@ -24,14 +31,7 @@ attributeListP = do

2431 return $ constructor (S.fromList (map T.pack attrs))

2532

2633makeRelationP :: Parser RelationalExpr

27−makeRelationP = do

28− reservedOp "relation"

29− attrs <- (try makeAttributesP <|> return A.emptyAttributes)

30− if not (A.null attrs) then do

31− return $ MakeStaticRelation attrs emptyTupleSet

32− else do

33− tuples <- braces (sepBy tupleP comma)

34− return $ MakeStaticRelation (tupleAttributes (head tuples)) (HS.fromList tuples)

34+makeRelationP = ExistingRelation <$> relationP

3535

3636--used in relation creation

3737makeAttributesP :: Parser Attributes

@@ -42,11 +42,9 @@ makeAttributesP = do

4242attributeAndTypeP :: Parser Attribute

4343attributeAndTypeP = do

4444 attrName <- identifier

45− attrTypeName <- identifier

4645 --convert type name into type

47− case tutDTypeToAtomType attrTypeName of

48− Just t -> return $ Attribute (T.pack attrName) t

49− Nothing -> fail (attrTypeName ++ " is not a valid type name.")

46+ atomType <- atomTypeP

47+ return $ Attribute (T.pack attrName) atomType

5048

5149tupleP :: Parser RelationTuple

5250tupleP = do

@@ -59,15 +57,9 @@ tupleP = do

5957tupleAtomP :: Parser (AttributeName, Atom)

6058tupleAtomP = do

6159 attributeName <- identifier

62− attrType <- identifier

63− atom <- parens (stringAtomP <|> intAtomP)

64− case tutDTypeToAtomType attrType of

65− Nothing -> fail (attrType ++ " is not a valid type name.")

66− Just typeA -> if typeA == atomTypeForAtom atom then

67− return $ (T.pack attributeName, atom)

68− else

69− fail "type mismatch in tuple generation"

70−

60+ atom <- atomP

61+ return $ (T.pack attributeName, atom)

62+

7163projectP :: Parser (RelationalExpr -> RelationalExpr)

7264projectP = do

7365 attrs <- braces attributeListP

@@ -226,7 +218,10 @@ attributeAtomExprP = do

226218 return $ AttributeAtomExpr (T.pack attrName)

227219

228220nakedAtomExprP :: Parser AtomExpr

229−nakedAtomExprP = NakedAtomExpr <$> (stringAtomP <|> intAtomP <|> boolAtomP)

221+nakedAtomExprP = NakedAtomExpr <$> atomP

222+

223+atomP :: Parser Atom

224+atomP = stringAtomP <|> intAtomP <|> boolAtomP <|> relationAtomP

230225

231226functionAtomExprP :: Parser AtomExpr

232227functionAtomExprP = do

@@ -253,4 +248,22 @@ boolAtomP :: Parser Atom

253248boolAtomP = do

254249 val <- char 't' <|> char 'f'

255250 return $ BoolAtom (val == 't')

251+

252+relationAtomP :: Parser Atom

253+relationAtomP = RelationAtom <$> relationP

254+

255+--relation constructor -- no choice but to propagate relation-construction errors as parse errors. Perhaps this could be improved in the future

256+relationP :: Parser Relation

257+relationP = do

258+ reserved "relation"

259+ attrs <- (try makeAttributesP <|> return A.emptyAttributes)

260+ if not (A.null attrs) then do

261+ case mkRelation attrs emptyTupleSet of

262+ Left err -> fail (show err)

263+ Right rel -> return rel

264+ else do

265+ tuples <- braces (sepBy tupleP comma)

266+ case mkRelation (tupleAttributes (head tuples)) (HS.fromList tuples) of

267+ Left err -> fail (show err)

268+ Right rel -> return rel

256269

project-m36.cabal+1

@@ -18,6 +18,7 @@ Library

1818 ProjectM36.TupleSet,

1919 ProjectM36.Atom,

2020 ProjectM36.AtomFunction,

21+ ProjectM36.Key,

2122 ProjectM36.RelationalExpression,

2223 ProjectM36.Relation.Show.HTML,

2324 ProjectM36.StaticOptimizer,

test/TutorialD/Interpreter.hs+17−10

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

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

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

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

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

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

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

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

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

@@ -45,19 +45,22 @@ main = do

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

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

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

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

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

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

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

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

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

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

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

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

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

5557 ]

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

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

5860 simpleCAttributes = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" IntAtomType]

5961 simpleDAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" IntAtomType]

6062 simpleProjectionAttributes = A.attributesFromList [Attribute "c" IntAtomType]

63+ nestedRelationAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" (RelationAtomType $ A.attributesFromList [Attribute "a" IntAtomType])]

6164 extendTestAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" $ RelationAtomType (attributes suppliersRel)]

6265 groupCountAttrs = A.attributesFromList [Attribute "z" IntAtomType]

6366 minMaxAttrs = A.attributesFromList [Attribute "S#" StringAtomType, Attribute "z" IntAtomType]

@@ -68,7 +71,7 @@ main = do

6871 --atom function tests

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

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

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

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

7275 --relatom function tests

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

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

@@ -82,7 +85,11 @@ main = do

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

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

8487 --test "all but" attribute inversion syntax

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

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

89+ --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")),

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)

92+

8693 ]

8794

8895