f42ee21 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add basic atom functions: count, min, max

f42ee21AgentM11 years ago

ProjectM36/AtomFunction.hsnew file+37

compare with master

unifiedsplit

@@ -0,0 +1,37 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module ProjectM36.AtomFunction where

3+import ProjectM36.Base

4+import ProjectM36.Error

5+import qualified ProjectM36.Attribute as A

6+import qualified Data.HashSet as HS

7+import qualified Data.Vector as V

9+foldAtomFuncType :: AtomType -> AtomType -> [AtomType]

10+foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]

11+

12+atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction

13+atomFunctionForName funcName funcSet = if HS.null foundFunc then

14+ Left $ NoSuchTupleExprFunctionError funcName

15+ else

16+ Right $ head $ HS.toList foundFunc

17+ where

18+ foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet

19+

20+--determine if two types are equal or compatible

21+atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

22+atomTypeVerify AnyAtomType x = Right x

23+atomTypeVerify x AnyAtomType = Right x

24+atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do

25+ _ <- mapM (\(attr1,attr2) -> let name1 = A.attributeName attr1

26+ name2 = A.attributeName attr2 in

27+ if notElem "_" [name1, name2] && name1 /= name2 then

28+ Left $ AtomTypeMismatchError x y

29+ else

30+ atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip attrs1 attrs2)

31+ return x

32+atomTypeVerify x y = if x == y then

33+ Right x

34+ else

35+ Left $ AtomTypeMismatchError x y

36+

37+

ProjectM36/Base.hs+2−6

@@ -111,11 +111,7 @@ data RelationalExpr where

111 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

112 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

113 Extend :: TupleExpr -> RelationalExpr -> RelationalExpr

114−{- maybe break this into multiple steps:

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

115−1. check relational types for match (attribute counts) (typechecking step

116−2. create an execution plan (another system of nodes, another GADT)

117−3. execute the plan

118−-}

119 deriving (Show,Eq)

115 deriving (Show,Eq)

120

116

121data DatabaseContext = DatabaseContext {

117data DatabaseContext = DatabaseContext {

@@ -214,7 +210,7 @@ type AtomFunctionName = StringType

214

210

215data AtomFunction = AtomFunction {

211data AtomFunction = AtomFunction {

216 atomFuncName :: AtomFunctionName,

212 atomFuncName :: AtomFunctionName,

217− atomFuncType :: [AtomType],

213+ atomFuncType :: [AtomType],

218 atomFunc :: [Atom] -> Atom

214 atomFunc :: [Atom] -> Atom

219 }

215 }

220

216

ProjectM36/Relation.hs+17−3

@@ -151,7 +151,7 @@ group groupAttrNames newAttrName rel = do

151 newAttrs = A.addAttribute groupAttr (attributesForNames nonGroupAttrNames rel)

152 groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames groupAttrNames rel))

153 nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (attributeNames rel)

154− mogrifier tupIn = tupleExtend (traceShowId tupIn) (matchingRelTuple tupIn)

154+ mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)

155 matchingRelTuple tupIn = case imageRelationFor tupIn rel of

156 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

157 Left _ -> undefined

@@ -277,7 +277,21 @@ matrixRelation attributeCount tupleCount = do

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

278 mkRelation attrs tupleSet

279

280+--used by sum atom function

281+relationSum :: Relation -> Atom

282+relationSum relIn = IntAtom $ relFold (\tupIn acc -> acc + (newVal tupIn)) 0 relIn

283+ where

284+ newVal tupIn = (\(IntAtom i) -> i) $ (tupleAtoms tupIn) V.! 0

280

285

286+relationCount :: Relation -> Atom

287+relationCount relIn = IntAtom $ relFold (\_ acc -> acc + 1) 0 relIn

281

288

282−

289+relationMax :: Relation -> Atom

283−

290+relationMax relIn = IntAtom $ relFold (\tupIn acc -> max acc (newVal tupIn)) minBound relIn

291+ where

292+ newVal tupIn = (\(IntAtom i) -> i) $ (tupleAtoms tupIn) V.! 0

293+

294+relationMin :: Relation -> Atom

295+relationMin relIn = IntAtom $ relFold (\tupIn acc -> min acc (newVal tupIn)) maxBound relIn

296+ where

297+ newVal tupIn = (\(IntAtom i) -> i) $ (tupleAtoms tupIn) V.! 0

ProjectM36/RelationalExpression.hs+37−46

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

6import ProjectM36.Base

7import ProjectM36.Error

8import ProjectM36.Atom

9+import ProjectM36.AtomFunction

9import qualified ProjectM36.Attribute as A

10import qualified ProjectM36.Attribute as A

10import qualified Data.Map as M

11import qualified Data.Map as M

11import qualified Data.HashSet as HS

12import qualified Data.HashSet as HS

@@ -99,7 +100,7 @@ evalRelationalExpr (Extend tupleExpression relExpr) = do

99 case tupleExpressionProcessor rel tupleExpression context of

100 case tupleExpressionProcessor rel tupleExpression context of

100 Left err -> return $ Left err

101 Left err -> return $ Left err

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

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

102−

103+

103emptyDatabaseContext :: DatabaseContext

104emptyDatabaseContext :: DatabaseContext

104emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

105emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

105 relationVariables = M.empty,

106 relationVariables = M.empty,

@@ -359,7 +360,6 @@ predicateRestrictionFilter context (AttributeEqualityPredicate attrName atomexpr

359 case evalAtomExpr tupleIn context atomexpr of

360 case evalAtomExpr tupleIn context atomexpr of

360 Left _ -> False

361 Left _ -> False

361 Right atomCmp -> atomCmp == atomIn

362 Right atomCmp -> atomCmp == atomIn

362−

363

364tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

365tupleExprCheckNewAttrName attrName rel = if isRight $ attributeForName attrName rel then

@@ -379,25 +379,19 @@ tupleExpressionProcessor relIn

379 Left _ -> undefined -- ?!

380 Right atom -> tupleAtomExtend newAttrName atom tup)

381

382−basicAtomFunctions :: AtomFunctions

382+evalAtomExpr :: RelationTuple -> DatabaseContext -> AtomExpr -> Either RelationalError Atom

383−basicAtomFunctions = HS.fromList [

383+evalAtomExpr tupIn _ (AttributeAtomExpr attrName) = atomForAttributeName attrName tupIn

384− --match on any relation type

384+evalAtomExpr _ _ (NakedAtomExpr atom) = Right atom

385− AtomFunction "add" [IntAtomType, IntAtomType, IntAtomType] (\(i1:i2:_) -> (\(IntAtom a) (IntAtom b) -> IntAtom (a + b)) i1 i2),

385+evalAtomExpr tupIn context (FunctionAtomExpr funcName arguments) = do

386− AtomFunction { atomFuncName = "id",

386+ let functions = atomFunctions context

387− atomFuncType = [AnyAtomType],

387+ func <- atomFunctionForName funcName functions

388− atomFunc = (\(x:_) -> x)}

388+ argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn) context) arguments

389−

389+ _ <- mapM (uncurry atomTypeVerify) $ init (zip (atomFuncType func) argTypes)

390−-- AtomFunction "count" [RelationAtomType , IntAtom],

390+ evaldArgs <- mapM (evalAtomExpr tupIn context) arguments

391−-- AtomFunction "sum" [RelationAtomType IntAtomType

391+ return $ (atomFunc func) evaldArgs

392− ]

392+evalAtomExpr _ context (RelationAtomExpr relExpr) = do

393−

393+ relAtom <- evalState (evalRelationalExpr relExpr) context

394−atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction

394+ return $ RelationAtom relAtom

395−atomFunctionForName funcName funcSet = if HS.null foundFunc then

396− Left $ NoSuchTupleExprFunctionError funcName

397− else

398− Right $ head $ HS.toList foundFunc

399− where

400− foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet

401

395

402typeFromAtomExpr :: Attributes -> DatabaseContext -> AtomExpr -> Either RelationalError AtomType

396typeFromAtomExpr :: Attributes -> DatabaseContext -> AtomExpr -> Either RelationalError AtomType

403typeFromAtomExpr attrs _ (AttributeAtomExpr attrName) = A.atomTypeForAttributeName attrName attrs

397typeFromAtomExpr attrs _ (AttributeAtomExpr attrName) = A.atomTypeForAttributeName attrName attrs

@@ -409,7 +403,6 @@ typeFromAtomExpr _ context (FunctionAtomExpr funcName _) = do

409typeFromAtomExpr _ context (RelationAtomExpr relExpr) = do

403typeFromAtomExpr _ context (RelationAtomExpr relExpr) = do

410 relType <- evalState (typeForRelationalExpr relExpr) context

404 relType <- evalState (typeForRelationalExpr relExpr) context

411 return $ RelationAtomType (attributes relType)

405 return $ RelationAtomType (attributes relType)

412−

413

406

414verifyAtomExprTypes :: Relation -> DatabaseContext -> AtomExpr -> AtomType -> Either RelationalError AtomType

407verifyAtomExprTypes :: Relation -> DatabaseContext -> AtomExpr -> AtomType -> Either RelationalError AtomType

415verifyAtomExprTypes relIn _ (AttributeAtomExpr attrName) expectedType = do

408verifyAtomExprTypes relIn _ (AttributeAtomExpr attrName) expectedType = do

@@ -433,27 +426,25 @@ verifyAtomExprTypes _ context (RelationAtomExpr relationExpr) expectedType = do

433 case runState (typeForRelationalExpr relationExpr) context of

426 case runState (typeForRelationalExpr relationExpr) context of

434 (Left err, _) -> Left err

427 (Left err, _) -> Left err

435 (Right relType, _) -> atomTypeVerify expectedType (RelationAtomType (attributes relType))

428 (Right relType, _) -> atomTypeVerify expectedType (RelationAtomType (attributes relType))

436−

429+

437−--determine if two types are equal or compatible

430+basicAtomFunctions :: AtomFunctions

438−atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

431+basicAtomFunctions = HS.fromList [

439−atomTypeVerify AnyAtomType x = Right x

432+ --match on any relation type

440−atomTypeVerify x AnyAtomType = Right x

433+ AtomFunction "add" [IntAtomType, IntAtomType, IntAtomType] (\(i1:i2:_) -> (\(IntAtom a) (IntAtom b) -> IntAtom (a + b)) i1 i2),

441−atomTypeVerify x y = if x == y then

434+ AtomFunction { atomFuncName = "id",

442− Right x

435+ atomFuncType = [AnyAtomType, AnyAtomType],

443− else

436+ atomFunc = (\(x:_) -> x)},

444− Left $ AtomTypeMismatchError x y

437+ AtomFunction { atomFuncName = "sum",

445−

438+ atomFuncType = foldAtomFuncType IntAtomType IntAtomType,

446−evalAtomExpr :: RelationTuple -> DatabaseContext -> AtomExpr -> Either RelationalError Atom

439+ atomFunc = (\((RelationAtom relIn):_) -> relationSum relIn)},

447−evalAtomExpr tupIn _ (AttributeAtomExpr attrName) = atomForAttributeName attrName tupIn

440+ AtomFunction { atomFuncName = "count",

448−evalAtomExpr _ _ (NakedAtomExpr atom) = Right atom

441+ atomFuncType = foldAtomFuncType AnyAtomType IntAtomType,

449−evalAtomExpr tupIn context (FunctionAtomExpr funcName arguments) = do

442+ atomFunc = (\((RelationAtom relIn):_) -> relationCount relIn)},

450− let functions = atomFunctions context

443+ AtomFunction { atomFuncName = "max",

451− func <- atomFunctionForName funcName functions

444+ atomFuncType = foldAtomFuncType IntAtomType IntAtomType,

452− argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn) context) arguments

445+ atomFunc = (\((RelationAtom relIn):_) -> relationMax relIn)},

453− _ <- mapM (uncurry atomTypeVerify) $ init (zip (atomFuncType func) argTypes)

446+ AtomFunction { atomFuncName = "min",

454− evaldArgs <- mapM (evalAtomExpr tupIn context) arguments

447+ atomFuncType = foldAtomFuncType IntAtomType IntAtomType,

455− return $ (atomFunc func) evaldArgs

448+ atomFunc = (\((RelationAtom relIn):_) -> relationMin relIn)}

456−evalAtomExpr _ context (RelationAtomExpr relExpr) = do

449+

457− relAtom <- evalState (evalRelationalExpr relExpr) context

450+ ]

458− return $ RelationAtom relAtom

459−

ProjectM36/Tuple.hs+13−3

@@ -163,9 +163,19 @@ verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs

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

164 Left $ TupleAttributeCountMismatchError 0

165 else if attrsTypes /= tupleTypes then

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

166− Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

167+ Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

167 else

168 else

168 Right $ tuple

169 Right $ tuple

169

170

170−

171+--two tuples can be equal but the vectors of attributes could be out-of-order

171−

172+--reorder if necessary- this is useful during relMogrify so that all the relation's tuples have identical atom/attribute ordering

173+reorderTuple :: Attributes -> RelationTuple -> RelationTuple

174+reorderTuple attrs tupIn = if tupleAttributes tupIn == attrs then

175+ tupIn

176+ else do

177+ RelationTuple attrs (V.map mapper attrs)

178+ where

179+ mapper attr = case atomForAttributeName (attributeName attr) tupIn of

180+ Left _ -> undefined

181+ Right atom -> atom

TutorialD/Interpreter.hs+36−10

@@ -129,11 +129,11 @@ tutDTypeToAtomType tutDType = case tutDType of

129 "int" -> Just IntAtomType

130 _ -> Nothing

131

132−atomTypeToTutDType :: AtomType -> Maybe String

132+atomTypeToTutDType :: AtomType -> Maybe T.Text

133atomTypeToTutDType atomType = case atomType of

134 StringAtomType -> Just "char"

135 IntAtomType -> Just "int"

136− --RelationAtomType rel ->

136+ RelationAtomType attrs -> Just $ "relation" `T.append` showRelationAttributes attrs

137 _ -> Nothing

138

139relVarP :: Parser RelationalExpr

@@ -198,8 +198,33 @@ extendP = do

198 tupleExpr <- braces tupleExpressionP

199 return $ Extend tupleExpr

200

201+{-

202+rewrite summarize as extend as evaluate

203+

204+summarize SP per (SP{SNO}) add (sum(@QTY) as SUMQ) === ((SP rename {QTY as _}) group ({_} as x)) : {QTY:=sum(@x)}{S#,QTY}

205+so, in general,

206+summarize rX per (relExpr) add (func(@attr) as funcd) === ((rX rename {attr as _}) group ({_} as _)) : {QTY:=sum(@_)}{relExpr, _}

207+-}

208+{-

209+summarizeP :: Parser (RelationalExpr -> RelationalExpr)

210+summarizeP = do

211+ reservedOp "per"

212+ -- "summarize in Tutorial D requires the heading of the per relation to be a subset of that of the relation to be summarized"

213+ perExpr <- parens relExpr

214+ reservedOp "add"

215+ (funcAtomExpr, newAttrName) <- parens summaryP

216+ --rewrite summarize as extend

217+ --return $ Summarize funcAtomExpr newAttrName perExpr

218+

219+summaryP :: Parser (AtomExpr, AttributeName)

220+summaryP = do

221+ expr <- atomExprP

222+ reserved "as"

223+ attrName <- identifier

224+ return (expr, T.pack attrName)

225+-}

226+

201relOperators = [

227relOperators = [

202− [Postfix extendP],

203 [Postfix projectOp],

228 [Postfix projectOp],

204 [Postfix renameP],

229 [Postfix renameP],

205 [Postfix whereClauseP],

230 [Postfix whereClauseP],

@@ -207,7 +232,8 @@ relOperators = [

207 [Postfix ungroupP],

232 [Postfix ungroupP],

208 [Infix (reservedOp "join" >> return Join) AssocLeft],

233 [Infix (reservedOp "join" >> return Join) AssocLeft],

209 [Infix (reservedOp "union" >> return Union) AssocLeft],

234 [Infix (reservedOp "union" >> return Union) AssocLeft],

210− [Infix (reservedOp "=" >> return Equals) AssocNone]

235+ [Infix (reservedOp "=" >> return Equals) AssocNone],

236+ [Postfix extendP]

211 ]

237 ]

212

238

213relExpr :: Parser RelationalExpr

239relExpr :: Parser RelationalExpr

@@ -384,13 +410,13 @@ contextOps = typeP

384interpreterOps :: Parser (Either ContextOperator GraphOperator)

410interpreterOps :: Parser (Either ContextOperator GraphOperator)

385interpreterOps = liftM Left contextOps <|> liftM Right transactionGraphOps

411interpreterOps = liftM Left contextOps <|> liftM Right transactionGraphOps

386

412

387−showRelationAttributes :: Relation -> T.Text

413+showRelationAttributes :: Attributes -> T.Text

388−showRelationAttributes rel = "{" `T.append` T.concat (L.intersperse ", " $ map showAttribute attrs) `T.append` "}"

414+showRelationAttributes attrs = "{" `T.append` T.concat (L.intersperse ", " $ map showAttribute attrsL) `T.append` "}"

389 where

415 where

390 showAttribute (Attribute name atomType) = name `T.append` " " `T.append` case atomTypeToTutDType atomType of

416 showAttribute (Attribute name atomType) = name `T.append` " " `T.append` case atomTypeToTutDType atomType of

391− Just t -> T.pack (show t)

417+ Just t -> t

392− Nothing -> T.pack "unknown"

418+ Nothing -> "unknown"

393− attrs = V.toList $ attributes rel

419+ attrsL = V.toList attrs

394

420

395data TutorialDOperatorResult = QuitResult |

421data TutorialDOperatorResult = QuitResult |

396 DisplayResult StringType |

422 DisplayResult StringType |

@@ -400,7 +426,7 @@ data TutorialDOperatorResult = QuitResult |

400

426

401evalContextOp :: DatabaseContext -> ContextOperator -> TutorialDOperatorResult

427evalContextOp :: DatabaseContext -> ContextOperator -> TutorialDOperatorResult

402evalContextOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of

428evalContextOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of

403− (Right rel, _) -> DisplayResult $ showRelationAttributes rel

429+ (Right rel, _) -> DisplayResult $ showRelationAttributes (attributes rel)

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

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

405

431

406evalContextOp context (ShowRelation expr) = do

432evalContextOp context (ShowRelation expr) = do

project-m36.cabal+1

@@ -16,6 +16,7 @@ Library

16 ProjectM36.Tuple,

17 ProjectM36.TupleSet,

18 ProjectM36.Atom,

19+ ProjectM36.AtomFunction,

19 ProjectM36.RelationalExpression,

20 ProjectM36.RelationalExpression,

20 ProjectM36.Relation.Show.HTML,

21 ProjectM36.Relation.Show.HTML,

21 ProjectM36.StaticOptimizer,

22 ProjectM36.StaticOptimizer,

test/TutorialD/Interpreter.hs+14−3

@@ -18,6 +18,7 @@ import Data.UUID (nil)

18import Data.Either (isRight)

19import qualified Data.Vector as V

21+--urgent: add group and ungroup tests- I missed the group relation type bug

21main :: IO ()

22main :: IO ()

22main = do

23main = do

23 tcounts <- runTestTT (TestList tests)

24 tcounts <- runTestTT (TestList tests)

@@ -57,14 +58,24 @@ main = do

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

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

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

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

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

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

61+ groupCountAttrs = A.attributesFromList [Attribute "z" IntAtomType]

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

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

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

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

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

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

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

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

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

67+ --atom function tests

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

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

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

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

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

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

67− ]

71+ --relatom function tests

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

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

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

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

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

77+ ]

78+

69assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion

80assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion

70assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted

81assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted