2f6b871 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

implement update operator with simple restriction clause

2f6b871AgentM12 years ago

Relation.hs+22−26

compare with master

unifiedsplit

@@ -4,6 +4,7 @@ module Relation where

4import qualified Data.Map as M

5import qualified Data.Set as S

6import qualified Data.HashSet as HS

7+import Control.Monad

8import RelationType

9import RelationType

9import RelationTuple

10import RelationTuple

@@ -12,8 +13,6 @@ import RelationTupleSet

12import RelationalError

13import RelationalError

13import Prelude hiding (join)

14import Prelude hiding (join)

15−testTuple1 = mkRelationTuple (S.fromList ["hair"]) (M.fromList [("hair", StringAtom "brown")])

16−

17attributes :: Relation -> Attributes

16attributes :: Relation -> Attributes

18attributes (Relation attrs _ ) = attrs

17attributes (Relation attrs _ ) = attrs

@@ -41,24 +40,12 @@ atomValueType (IntAtom _) = IntAtomType

41atomValueType (RelationAtom rel) = RelationAtomType (attributes rel)

40atomValueType (RelationAtom rel) = RelationAtomType (attributes rel)

43mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation

42mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation

44−mkRelation attrs tupleSet =

43+mkRelation attrs tupleSet = do

45 --check that all tuples have the same keys

44 --check that all tuples have the same keys

46 --check that all tuples have keys (1-N) where N is the attribute count

45 --check that all tuples have keys (1-N) where N is the attribute count

47− if differentTupleCounts

48− then Left $ TupleAttributeCountMismatchError 0

49− else if not (fst (verifyRelationTupleSet tupleSet))

46+ case verifyRelationTupleSet attrs tupleSet of

50− then Left $ TupleAttributeTypeMismatchError 0

47+ Left err -> Left err

51− else if attrCountMismatch

52− then Left $ AttributeCountMismatchError 0

53− else

54− Right $ Relation attrs tupleSet

48+ Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

55− where

56− attrCount = M.size attrs

57− tupleCounts = HS.map tupleSize tupleSet

58− attrCountMismatch = if HS.size tupleSet > 0

59− then not $ HS.member attrCount tupleCounts

60− else False --empty tuple set is always OK

61− differentTupleCounts = HS.size tupleCounts > 1

63relationTrue = Relation M.empty $ HS.singleton (RelationTuple M.empty)

50relationTrue = Relation M.empty $ HS.singleton (RelationTuple M.empty)

64relationFalse = Relation M.empty emptyTupleSet

51relationFalse = Relation M.empty emptyTupleSet

@@ -233,18 +220,27 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = Right $ Relation newA

233 newAttrs = M.union attrs1 attrs2

220 newAttrs = M.union attrs1 attrs2

234 newTupSet = HS.foldr tupleSetJoiner emptyTupleSet tupSet1

221 newTupSet = HS.foldr tupleSetJoiner emptyTupleSet tupSet1

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

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

236−

223+

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

225+relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation

226+relMap mapper (Relation attrs tupleSet) = do

227+ case forM (HS.toList tupleSet) typeMapCheck of

228+ Right remappedTupleSet -> Right $ Relation attrs $ HS.fromList remappedTupleSet

229+ Left err -> Left err

230+ where

231+ typeMapCheck tupleIn = do

232+ let remappedTuple = mapper tupleIn

233+ if tupleAttributes remappedTuple == tupleAttributes tupleIn

234+ then Right remappedTuple

235+ else Left $ TupleAttributeTypeMismatchError 0

237

236

237+--in the future, the mapper should be able to return a RelationalError likely

238−--a map should NOT change the structure of a relation, so attributes should be constant relMap :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

238+relMogrify :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

239−relMap mapper newAttributes (Relation attrs tupleSet) = Right $ Relation newAttributes (HS.map mapper tupleSet)

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

240

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

242relFold folder acc (Relation attrs tupleSet) = HS.foldr folder acc tupleSet

243

244−{- a specialized form of fold which always returns a Relation

245−relTuplesFold :: (RelationTuple -> RelationTupleSet -> RelationTupleSet) -> RelationTupleSet -> AttributeNameSet -> Relation -> Either RelationalError Relation

246−-}

247−

248--image relation as defined by CJ Date

244--image relation as defined by CJ Date

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

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

250

246

@@ -277,7 +273,7 @@ relvarS = mkRelation attributes tupleSet

277 where

273 where

278 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

274 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

279 ("SNAME", Attribute "SNAME" StringAtomType),

275 ("SNAME", Attribute "SNAME" StringAtomType),

280− ("STATUS", Attribute "STATUS" StringAtomType),

276+ ("STATUS", Attribute "STATUS" IntAtomType),

281 ("CITY", Attribute "CITY" StringAtomType)]

277 ("CITY", Attribute "CITY" StringAtomType)]

282 tupleSet = HS.fromList $ mkRelationTuples attributes [

278 tupleSet = HS.fromList $ mkRelationTuples attributes [

283 M.fromList [("S#", StringAtom "S1") , ("SNAME", StringAtom "Smith"), ("STATUS", IntAtom 20) , ("CITY", StringAtom "London")],

279 M.fromList [("S#", StringAtom "S1") , ("SNAME", StringAtom "Smith"), ("STATUS", IntAtom 20) , ("CITY", StringAtom "London")],

RelationExpr.hs+28−2

@@ -98,7 +98,7 @@ suppliersRel = case mkRelation attributes tupleSet of

98 where

99 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

100 ("SNAME", Attribute "SNAME" StringAtomType),

101− ("STATUS", Attribute "STATUS" StringAtomType),

101+ ("STATUS", Attribute "STATUS" IntAtomType),

102 ("CITY", Attribute "CITY" StringAtomType)]

103 tupleSet = HS.fromList $ mkRelationTuples attributes [

104 M.fromList [("S#", StringAtom "S1") , ("SNAME", StringAtom "Smith"), ("STATUS", IntAtom 20) , ("CITY", StringAtom "London")],

@@ -193,7 +193,27 @@ evalContextExpr (Delete relVarName) = do

193 Nothing -> return $ Just (RelVarNotDefinedError relVarName)

194 Just rel -> setRelVar relVarName (Relation (attributes rel) emptyTupleSet)

195

196+

197+--union of restricted+updated portion and the unrestricted+unupdated portion

196−evalContextExpr (Update relVarName attrAssignments) = undefined

198+evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = do

199+ state <- get

200+ let relVarTable = relationVariables state

201+ case predicateRestrictionFilter state restrictionPredicateExpr of

202+ Left err -> return $ Just err

203+ Right predicateFunc -> do

204+ case M.lookup relVarName relVarTable of

205+ Nothing -> return $ Just (RelVarNotDefinedError relVarName)

206+ Just rel -> case makeUpdatedRel rel of

207+ Left err -> return $ Just err

208+ Right updatedRel -> setRelVar relVarName updatedRel

209+ where

210+ makeUpdatedRel rel = do

211+ restrictedPortion <- restrict predicateFunc rel

212+ unrestrictedPortion <- restrict (not . predicateFunc) rel

213+ updatedPortion <- relMap tupleUpdater restrictedPortion

214+ union updatedPortion unrestrictedPortion

215+ tupleUpdater = \(RelationTuple tupMap) -> RelationTuple $ M.union attrAssignments tupMap

216+

197

217

198evalContextExpr (AddInclusionDependency dep) = do

218evalContextExpr (AddInclusionDependency dep) = do

199 state <- get

219 state <- get

@@ -262,6 +282,12 @@ predicateRestrictionFilter context (OrPredicate expr1 expr2) = do

262 expr1v <- predicateRestrictionFilter context expr1

282 expr1v <- predicateRestrictionFilter context expr1

263 expr2v <- predicateRestrictionFilter context expr2

283 expr2v <- predicateRestrictionFilter context expr2

264 return $ \x -> expr1v x || expr2v x

284 return $ \x -> expr1v x || expr2v x

285+

286+predicateRestrictionFilter context TruePredicate = Right $ \x -> True

287+

288+predicateRestrictionFilter context (NotPredicate expr) = do

289+ exprv <- predicateRestrictionFilter context expr

290+ return $ \x -> not (exprv x)

265

291

266predicateRestrictionFilter context (RelationalExprPredicate relExpr) = case runState (evalRelationalExpr relExpr) context of

292predicateRestrictionFilter context (RelationalExprPredicate relExpr) = case runState (evalRelationalExpr relExpr) context of

267 (Left err, _) -> Left err

293 (Left err, _) -> Left err

RelationTuple.hs+5

@@ -12,6 +12,11 @@ tupleSize (RelationTuple m) = M.size m

12tupleAttributeNameSet :: RelationTuple -> S.Set AttributeName

13tupleAttributeNameSet (RelationTuple tupMap) = M.keysSet tupMap

15+tupleAttributes :: RelationTuple -> Attributes

16+tupleAttributes (RelationTuple tupMap) = M.mapWithKey mapper tupMap

17+ where

18+ mapper key atom = Attribute key (atomTypeForAtom atom)

19+

15tupleAtomForAttribute :: RelationTuple -> AttributeName -> Atom

20tupleAtomForAttribute :: RelationTuple -> AttributeName -> Atom

16tupleAtomForAttribute (RelationTuple tupMap) attrName = tupMap M.! attrName

21tupleAtomForAttribute (RelationTuple tupMap) attrName = tupMap M.! attrName

RelationTupleSet.hs+13−9

@@ -1,20 +1,24 @@

1module RelationTupleSet where

2import RelationType

3+import RelationTuple

4+import RelationalError

3import qualified Data.Map as M

5import qualified Data.Map as M

4import qualified Data.Set as S

6import qualified Data.Set as S

5import qualified Data.HashSet as HS

7import qualified Data.HashSet as HS

8+import Control.Monad

7emptyTupleSet = HS.empty

10emptyTupleSet = HS.empty

8emptyAttributeSet = M.empty

11emptyAttributeSet = M.empty

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

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

12−verifyRelationTupleSet :: RelationTupleSet -> (Bool,String)

15+verifyRelationTupleSet :: Attributes -> RelationTupleSet -> Either RelationalError RelationTupleSet

13−verifyRelationTupleSet tupleSet = if HS.size failedTupleSet > 0

16+verifyRelationTupleSet attrs tupleSet = do

14− then (False,"Tuple count or key mismatch: " ++ show failedTupleSet)

17+ --check that all tuples have the same types

18+ tupleList <- forM (HS.toList tupleSet) verifyTuple

19+ return $ HS.fromList tupleList

20+ where

21+ verifyTuple tuple = if tupleAttributes tuple == attrs then

22+ Right tuple

15− else (True, "")

23+ else

16− where

24+ Left $ TupleAttributeTypeMismatchError 0

17− allKeys = HS.foldr allKeysFolder S.empty tupleSet

18− allKeysFolder (RelationTuple m) = (S.union . M.keysSet) m

19− failedTupleSet = HS.filter (\(RelationTuple m) -> (M.keysSet m) /= allKeys) tupleSet

20−

RelationType.hs+9−1

@@ -9,10 +9,16 @@ import Control.Monad.State hiding (join)

9data Atom = StringAtom String |

10 IntAtom Int |

11 RelationAtom Relation deriving (Show, Eq)

12+

13data AtomType = StringAtomType |

14data AtomType = StringAtomType |

14 IntAtomType |

15 IntAtomType |

15 RelationAtomType Attributes deriving (Eq, Show)

16 RelationAtomType Attributes deriving (Eq, Show)

17+

18+atomTypeForAtom :: Atom -> AtomType

19+atomTypeForAtom (StringAtom _) = StringAtomType

20+atomTypeForAtom (IntAtom _) = IntAtomType

21+atomTypeForAtom (RelationAtom (Relation attributes _)) = RelationAtomType attributes

17type AttributeName = String

23type AttributeName = String

18type AtomName = String

24type AtomName = String

@@ -72,7 +78,7 @@ data DatabaseExpr where

72 Assign :: String -> RelationalExpr -> DatabaseExpr

78 Assign :: String -> RelationalExpr -> DatabaseExpr

73 Insert :: String -> RelationalExpr -> DatabaseExpr

79 Insert :: String -> RelationalExpr -> DatabaseExpr

74 Delete :: String -> DatabaseExpr -- needs restriction support

80 Delete :: String -> DatabaseExpr -- needs restriction support

75− Update :: String -> M.Map String RelationalExpr -> DatabaseExpr -- needs restriction support

81+ Update :: String -> M.Map String Atom -> RestrictionPredicateExpr -> DatabaseExpr -- needs restriction support

76 AddInclusionDependency :: InclusionDependency -> DatabaseExpr

82 AddInclusionDependency :: InclusionDependency -> DatabaseExpr

77 MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

83 MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

78 deriving (Show)

84 deriving (Show)

@@ -80,8 +86,10 @@ data DatabaseExpr where

80type DatabaseState a = State DatabaseContext a

86type DatabaseState a = State DatabaseContext a

82data RestrictionPredicateExpr where

88data RestrictionPredicateExpr where

89+ TruePredicate :: RestrictionPredicateExpr

83 AndPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

90 AndPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

84 OrPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

91 OrPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

92+ NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

85 RelationalExprPredicate :: RelationalExpr -> RestrictionPredicateExpr --type must be same as true and false relations (no attributes)

93 RelationalExprPredicate :: RelationalExpr -> RestrictionPredicateExpr --type must be same as true and false relations (no attributes)

86 AttributeEqualityPredicate :: AttributeName -> Atom -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

94 AttributeEqualityPredicate :: AttributeName -> Atom -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

87 deriving (Show)

95 deriving (Show)

TutorialDInterpreter.hs+42−25

@@ -17,7 +17,7 @@ import qualified Data.List as L

17import Control.Applicative (liftA, (<*), (*>))

18import Control.Monad.State

19import System.Console.Readline

20−

20+import System.IO

22lexer :: Token.TokenParser ()

23lexer = Token.makeTokenParser tutD

@@ -184,9 +184,9 @@ updateP :: Parser DatabaseExpr

184updateP = do

185 reservedOp "update"

186 relVarName <- identifier

187− -- where clause

187+ predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaces)

188 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignment comma)

189− return $ Update relVarName attributeAssignments

189+ return $ Update relVarName attributeAssignments predicate

190

191constraintP :: Parser DatabaseExpr

192constraintP = do

@@ -197,12 +197,12 @@ constraintP = do

197 superset <- relExpr

198 return $ AddInclusionDependency (InclusionDependency constraintName subset superset)

199

200−attributeAssignment :: Parser (String, RelationalExpr)

200+attributeAssignment :: Parser (String, Atom)

201attributeAssignment = do

202 attrName <- identifier

203 reservedOp ":="

204− relExpr <- relExpr

204+ atom <- stringAtomP <|> intAtomP

205− return $ (attrName, relExpr)

205+ return $ (attrName, atom)

206

207parseString :: String -> Either RelationalError DatabaseExpr

208parseString str = case parse multipleDatabaseExpr "" str of

@@ -213,6 +213,7 @@ data TutorialDOperator where

213 ShowRelation :: RelationalExpr -> TutorialDOperator

214 ShowRelationType :: RelationalExpr -> TutorialDOperator

215 ShowConstraint :: String -> TutorialDOperator

216+ Quit :: TutorialDOperator

216 deriving (Show)

217 deriving (Show)

217

218

218typeP :: Parser TutorialDOperator

219typeP :: Parser TutorialDOperator

@@ -227,6 +228,11 @@ showRelP = do

227 expr <- relExpr

228 expr <- relExpr

228 return $ ShowRelation expr

229 return $ ShowRelation expr

229

230

231+quitP :: Parser TutorialDOperator

232+quitP = do

233+ reservedOp ":q"

234+ return Quit

235+

230showConstraintsP :: Parser TutorialDOperator

236showConstraintsP :: Parser TutorialDOperator

231showConstraintsP = do

237showConstraintsP = do

232 reservedOp ":c"

238 reservedOp ":c"

@@ -237,6 +243,7 @@ interpreterOps :: Parser TutorialDOperator

237interpreterOps = typeP

243interpreterOps = typeP

238 <|> showRelP

244 <|> showRelP

239 <|> showConstraintsP

245 <|> showConstraintsP

246+ <|> quitP

240

247

241showRelationAttributes :: Relation -> String

248showRelationAttributes :: Relation -> String

242showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribute attrs) ++ "}"

249showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribute attrs) ++ "}"

@@ -247,23 +254,30 @@ showRelationAttributes rel = "{" ++ concat (L.intersperse ", " $ map showAttribu

247 attrs = values (attributes rel)

254 attrs = values (attributes rel)

248 values m = map snd (M.toAscList m)

255 values m = map snd (M.toAscList m)

249

256

257+data TutorialDOperatorResult = QuitResult |

258+ DisplayResult String |

259+ DisplayErrorResult String |

260+ NoActionResult

261+

250−evalTutorialDOp :: DatabaseContext -> TutorialDOperator -> String

262+evalTutorialDOp :: DatabaseContext -> TutorialDOperator -> TutorialDOperatorResult

251evalTutorialDOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of

263evalTutorialDOp context (ShowRelationType expr) = case runState (typeForRelationalExpr expr) context of

252− (Right rel, _) -> showRelationAttributes rel

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

253− (Left err, _) -> show err

265+ (Left err, _) -> DisplayErrorResult $ show err

254

266

255evalTutorialDOp context (ShowRelation expr) = do

267evalTutorialDOp context (ShowRelation expr) = do

256 case runState (evalRelationalExpr expr) context of

268 case runState (evalRelationalExpr expr) context of

257− (Left err, _) -> show err

269+ (Left err, _) -> DisplayErrorResult $ show err

258− (Right rel, _) -> showRelation rel

270+ (Right rel, _) -> DisplayResult $ showRelation rel

259

271

260evalTutorialDOp context (ShowConstraint name) = do

272evalTutorialDOp context (ShowConstraint name) = do

261− show filteredDeps

273+ DisplayResult $ show filteredDeps

262 where

274 where

263 deps = inclusionDependencies context

275 deps = inclusionDependencies context

264 filteredDeps = case name of

276 filteredDeps = case name of

265 "" -> deps

277 "" -> deps

266 name -> HS.filter (\(InclusionDependency n _ _) -> n == name) deps

278 name -> HS.filter (\(InclusionDependency n _ _) -> n == name) deps

279+

280+evalTutorialDOp context (Quit) = QuitResult

267

281

268example1 = "relA {a,b, c}"

282example1 = "relA {a,b, c}"

269example2 = "relA join relB"

283example2 = "relA join relB"

@@ -281,10 +295,10 @@ interpret context tutdstring = case parseString tutdstring of

281 Right parsed -> runState (evalContextExpr parsed) context

295 Right parsed -> runState (evalContextExpr parsed) context

282

296

283-- for interpreter-specific operations

297-- for interpreter-specific operations

284−interpretOps :: DatabaseContext -> String -> Maybe String

298+interpretOps :: DatabaseContext -> String -> TutorialDOperatorResult

285interpretOps context instring = case parse interpreterOps "" instring of

299interpretOps context instring = case parse interpreterOps "" instring of

286− Left err -> Nothing

300+ Left err -> NoActionResult

287− Right ops -> Just $ evalTutorialDOp context ops

301+ Right ops -> evalTutorialDOp context ops

288

302

289reprLoop :: DatabaseContext -> IO ()

303reprLoop :: DatabaseContext -> IO ()

290reprLoop context = do

304reprLoop context = do

@@ -295,28 +309,31 @@ reprLoop context = do

295 addHistory line

309 addHistory line

296

310

297 case interpretOps context line of

311 case interpretOps context line of

298− Just out -> do

312+ QuitResult -> return ()

313+ DisplayErrorResult err -> hPutStrLn stderr ("ERR: " ++ err)

314+ DisplayResult out -> do

299 putStrLn out

315 putStrLn out

300 reprLoop context

316 reprLoop context

301− Nothing -> return ()

317+ NoActionResult -> do

302−

303− let (value, contextup) = interpret context line

318+ let (value, contextup) = interpret context line

304− case value of

319+ case value of

305− Nothing -> reprLoop contextup

320+ Nothing -> reprLoop contextup

306− (Just err) -> do

321+ (Just err) -> do

307− putStrLn $ show err

322+ hPutStrLn stderr ("ERR:" ++ show err)

308− reprLoop context

323+ reprLoop context

309

324

310restrictionPredicateP :: Parser RestrictionPredicateExpr

325restrictionPredicateP :: Parser RestrictionPredicateExpr

311restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm

326restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm

312 where

327 where

313 predicateOperators = [

328 predicateOperators = [

329+ [Prefix (reservedOp "not" >> return NotPredicate)],

314 [Infix (reservedOp "and" >> return AndPredicate) AssocLeft],

330 [Infix (reservedOp "and" >> return AndPredicate) AssocLeft],

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

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

316 ]

332 ]

317 predicateTerm = parens restrictionPredicateP

333 predicateTerm = parens restrictionPredicateP

318 <|> try restrictionAttributeEqualityP

334 <|> try restrictionAttributeEqualityP

319− <|> relationalBooleanExpr

335+ <|> try relationalBooleanExpr

336+

320

337

321relationalBooleanExpr :: Parser RestrictionPredicateExpr

338relationalBooleanExpr :: Parser RestrictionPredicateExpr

322relationalBooleanExpr = do

339relationalBooleanExpr = do

TutorialDInterpreterTest.hs+6−3

@@ -8,6 +8,8 @@ import qualified Data.HashSet as HS

8import qualified Data.Map as M

9import System.Exit

11+import Debug.Trace

12+

11main = do

13main = do

12 counts <- runTestTT (TestList tests)

14 counts <- runTestTT (TestList tests)

13 if errors counts + failures counts > 0 then exitFailure else exitSuccess

15 if errors counts + failures counts > 0 then exitFailure else exitSuccess

@@ -33,9 +35,10 @@ main = do

33 simpleProjectionAttributes = M.fromList [("c", Attribute "c" IntAtomType)]

35 simpleProjectionAttributes = M.fromList [("c", Attribute "c" IntAtomType)]

34 dateExampleRelTests = [("x:=S where true", Right s),

36 dateExampleRelTests = [("x:=S where true", Right s),

35 ("x:=S where CITY = \"London\"", restrict (\(RelationTuple tupMap) -> tupMap M.! "CITY" == StringAtom "London") s),

37 ("x:=S where CITY = \"London\"", restrict (\(RelationTuple tupMap) -> tupMap M.! "CITY" == StringAtom "London") s),

36− ("x:=S where false", Right $ Relation (attributes s) HS.empty)]

38+ ("x:=S where false", Right $ Relation (attributes s) HS.empty),

37− --("x:=S where SNO in S{SNO}", Right s)]

39+ ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (M.fromList [("STATUS", Attribute "STATUS" IntAtomType)]) (HS.fromList [RelationTuple $ M.fromList [("STATUS", IntAtom 50)]])),

38−

40+ ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\(RelationTuple tupMap) -> RelationTuple $ if (traceShowId tupMap) M.! "SNAME" == StringAtom "Blake" then M.insert "CITY" (StringAtom "Boston") tupMap else tupMap) s)

41+ ]

40testSimple1 = TestCase $ assertTutdEqual basicDatabaseContext "true" (Right relationTrue)

43testSimple1 = TestCase $ assertTutdEqual basicDatabaseContext "true" (Right relationTrue)