6990bd8 · project-m36 · git.iko.soy

git.iko.soy/project-m36

Merge branch 'master' into appveyor

commit6990bd8ef747efae36d20343760f17ff5128a0eb authorAgentM <agentm@themactionfaction.com> dateSat 20 Jan 2018, 12:33 (9 years ago) parent2c0c706 f167476

16 files changed+75−93

compare with master

unifiedsplit

.travis/install-dependencies.sh+2−2 src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+2−5 src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+5−10 src/bin/TutorialD/Interpreter/RelationalExpr.hs+8−16 src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+3−6 src/lib/ProjectM36/Base.hs+1−3 src/lib/ProjectM36/Client.hs+16−6 src/lib/ProjectM36/Client/Simple.hs+1−1 src/lib/ProjectM36/Relation.hs+3−5 src/lib/ProjectM36/Relation/Parse/CSV.hs+1−1 src/lib/ProjectM36/Transaction/Persist.hs+8−9 src/lib/ProjectM36/TransactionGraph.hs+5−6 src/lib/ProjectM36/TransactionGraph/Persist.hs+1−3 src/lib/ProjectM36/Tuple.hs+2−3 test/Client/Simple.hs+14−8 test/Relation/StaticOptimizer.hs+3−9

.travis/install-dependencies.sh+2−2

@@ -4,7 +4,7 @@ if [[ "$(uname)" = "Darwin" ]]; then

44else

55 timeout_cmd="timeout"

66fi

7−$timeout_cmd 15m stack --no-terminal --jobs=2 --install-ghc --system-ghc build --only-dependencies --fast

7+$timeout_cmd 30m stack --no-terminal --jobs=2 --install-ghc --system-ghc build --only-dependencies --fast

88ret=$?

99case "$ret" in

1010 0)

@@ -13,7 +13,7 @@ case "$ret" in

1313 124)

1414 echo "Timed out while installing dependencies."

1515 echo "Try building again by pushing a new commit."

16− exit 1

16+ exit 0

1717 ;;

1818 *)

1919 echo "Failed to install dependencies; stack exited with $ret"

src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+2−5

@@ -77,15 +77,12 @@ defineP = do

7777undefineP :: Parser DatabaseContextExpr

7878undefineP = do

7979 reservedOp "undefine"

80− relVarName <- identifier

81− return $ Undefine relVarName

80+ Undefine <$> identifier

8281

8382deleteP :: Parser DatabaseContextExpr

8483deleteP = do

8584 reservedOp "delete"

86− relVarName <- identifier

87− predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)

88− return $ Delete relVarName predicate

85+ Delete <$> identifier <*> option TruePredicate (reservedOp "where" *> restrictionPredicateP)

8986

9087updateP :: Parser DatabaseContextExpr

9188updateP = do

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+5−10

@@ -30,20 +30,17 @@ data RODatabaseContextOperator where

3030typeP :: Parser RODatabaseContextOperator

3131typeP = do

3232 reservedOp ":type"

33− expr <- relExprP

34− return $ ShowRelationType expr

33+ ShowRelationType <$> relExprP

3534

3635showRelP :: Parser RODatabaseContextOperator

3736showRelP = do

3837 reservedOp ":showexpr"

39− expr <- relExprP

40− return $ ShowRelation expr

38+ ShowRelation <$> relExprP

4139

4240showPlanP :: Parser RODatabaseContextOperator

4341showPlanP = do

4442 reservedOp ":showplan"

45− expr <- databaseContextExprP

46− return $ ShowPlan expr

43+ ShowPlan <$> databaseContextExprP

4744

4845showTypesP :: Parser RODatabaseContextOperator

4946showTypesP = reserved ":showtypes" >> pure ShowTypes

@@ -59,14 +56,12 @@ quitP = do

5956showConstraintsP :: Parser RODatabaseContextOperator

6057showConstraintsP = do

6158 reservedOp ":constraints"

62− constraintName <- option "" identifier

63− return $ ShowConstraint constraintName

59+ ShowConstraint <$> option "" identifier

6460

6561plotRelExprP :: Parser RODatabaseContextOperator

6662plotRelExprP = do

6763 reserved ":plotexpr"

68− expr <- relExprP

69− return $ PlotRelation expr

64+ PlotRelation <$> relExprP

7065

7166roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

7267roDatabaseContextOperatorP = typeP

src/bin/TutorialD/Interpreter/RelationalExpr.hs+8−16

@@ -112,8 +112,7 @@ ungroupP = do

112112extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

113113extendP = do

114114 reservedOp ":"

115− tupleExpr <- braces extendTupleExpressionP

116− return $ Extend tupleExpr

115+ Extend <$> braces extendTupleExpressionP

117116

118117semijoinP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a)

119118semijoinP = do

@@ -169,17 +168,15 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators

169168 <|> relationalBooleanExprP

170169

171170relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

172−relationalBooleanExprP = do

173− relexpr <- parens relExprP <|> relTerm

171+relationalBooleanExprP =

174172 --we can't actually detect if the type is relational boolean, so we just pass it to the next phase

175− return $ RelationalExprPredicate relexpr

173+ RelationalExprPredicate <$> (parens relExprP <|> relTerm)

176174

177175restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

178176restrictionAttributeEqualityP = do

179177 attributeName <- identifier

180178 reservedOp "="

181− atomexpr <- atomExprP

182− return $ AttributeEqualityPredicate attributeName atomexpr

179+ AttributeEqualityPredicate attributeName <$> atomExprP

183180

184181restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

185182restrictionAtomExprP = do

@@ -196,8 +193,7 @@ attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTuple

196193attributeExtendTupleExpressionP = do

197194 newAttr <- identifier

198195 reservedOp ":="

199− atom <- atomExprP

200− return $ AttributeExtendTupleExpr newAttr atom

196+ AttributeExtendTupleExpr newAttr <$> atomExprP

201197

202198atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

203199atomExprP = consumeAtomExprP True

@@ -213,8 +209,7 @@ consumeAtomExprP consume = try functionAtomExprP <|>

213209attributeAtomExprP :: Parser (AtomExprBase a)

214210attributeAtomExprP = do

215211 _ <- string "@"

216− attrName <- identifier

217− return $ AttributeAtomExpr attrName

212+ AttributeAtomExpr <$> identifier

218213

219214nakedAtomExprP :: Parser (AtomExprBase a)

220215nakedAtomExprP = NakedAtomExpr <$> atomP

@@ -234,11 +229,8 @@ atomP = stringAtomP <|>

234229 boolAtomP

235230

236231functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

237−functionAtomExprP = do

238− funcName <- identifier

239− argList <- parens (sepBy atomExprP comma)

240− marker <- parseMarkerP

241− return $ FunctionAtomExpr funcName argList marker

232+functionAtomExprP =

233+ FunctionAtomExpr <$> identifier <*> parens (sepBy atomExprP comma) <*> parseMarkerP

242234

243235relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

244236relationalAtomExprP = RelationAtomExpr <$> relExprP

src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+3−6

@@ -22,14 +22,12 @@ autoMergeToHeadP = do

2222jumpToHeadP :: Parser TransactionGraphOperator

2323jumpToHeadP = do

2424 reservedOp ":jumphead"

25− headid <- identifier

26− return $ JumpToHead headid

25+ JumpToHead <$> identifier

2726

2827jumpToTransactionP :: Parser TransactionGraphOperator

2928jumpToTransactionP = do

3029 reservedOp ":jump"

31− uuid <- uuidP

32− return $ JumpToTransaction uuid

30+ JumpToTransaction <$> uuidP

3331

3432walkBackToTimeP :: Parser TransactionGraphOperator

3533walkBackToTimeP = do

@@ -39,8 +37,7 @@ walkBackToTimeP = do

3937branchTransactionP :: Parser TransactionGraphOperator

4038branchTransactionP = do

4139 reservedOp ":branch"

42− branchName <- identifier

43− return $ Branch branchName

40+ Branch <$> identifier

4441

4542deleteBranchP :: Parser TransactionGraphOperator

4643deleteBranchP = do

src/lib/ProjectM36/Base.hs+1−3

@@ -58,9 +58,7 @@ instance Hashable Atom where

5858

5959instance Binary UTCTime where

6060 put utc = put $ toRational (utcTimeToPOSIXSeconds utc)

61− get = do

62− r <- get :: Get Rational

63− return (posixSecondsToUTCTime (fromRational r))

61+ get = posixSecondsToUTCTime . fromRational <$> (get :: Get Rational)

6462

6563instance Binary Day where

6664 put day = put $ toGregorian day

src/lib/ProjectM36/Client.hs+16−6

@@ -582,7 +582,7 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither

582582 pure (Right ())

583583executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)

584584

585−-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing).

585+-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing). Alternatively, as an optimization, if a simple commit is possible (meaning that the head has not changed), then a fast-forward commit takes place instead.

586586autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

587587autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do

588588 let sessions = ipSessions conf

@@ -594,11 +594,21 @@ autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do

594594 eSession <- sessionForSessionId sessionId sessions

595595 case eSession of

596596 Left err -> pure (Left err)

597− Right session ->

598− case Graph.autoMergeToHead stamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph of

599− Left err -> pure (Left err)

600− Right (discon', graph') ->

601− pure (Right (discon', graph', [id1, id2, id3]))

597+ Right session ->

598+ case Graph.transactionForHead headName' graph of

599+ Nothing -> pure (Left (NoSuchHeadNameError headName'))

600+ Just headTrans -> do

601+ --attempt fast-forward commit, if possible

602+ let graphInfo = if Sess.parentId session == transactionId headTrans then do

603+ ret <- Graph.evalGraphOp stamp id1 (Sess.disconnectedTransaction session) graph Commit

604+ pure (ret, [id1])

605+ else do

606+ ret <- Graph.autoMergeToHead stamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph

607+ pure (ret, [id1,id2,id3])

608+ case graphInfo of

609+ Left err -> pure (Left err)

610+ Right ((discon', graph'), transactionIdsAdded) ->

611+ pure (Right (discon', graph', transactionIdsAdded))

602612autoMergeToHead sessionId conn@(RemoteProcessConnection _) strat headName' = remoteCall conn (ExecuteAutoMergeToHead sessionId strat headName')

603613

604614-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr`s modify the DatabaseContext but cannot be purely implemented.

src/lib/ProjectM36/Client/Simple.hs+1−1

@@ -72,7 +72,7 @@ close (_ , conn) = C.close conn

7272withTransaction :: DbConn -> Db a -> IO (Either DbError a)

7373withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy

7474

75−-- | Same a 'withTransaction' except that the merge strategy can be specified.

75+-- | Same as 'withTransaction' except that the merge strategy can be specified.

7676withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)

7777withTransactionUsing (sess, conn) strat dbm = do

7878 eHeadName <- C.headName sess conn

src/lib/ProjectM36/Relation.hs+3−5

@@ -37,9 +37,8 @@ atomTypeForName :: AttributeName -> Relation -> Either RelationalError AtomType

3737atomTypeForName attrName (Relation attrs _) = A.atomTypeForAttributeName attrName attrs

3838

3939mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation

40−mkRelationFromList attrs atomMatrix = do

41− tupSet <- mkTupleSetFromList attrs atomMatrix

42− return $ Relation attrs tupSet

40+mkRelationFromList attrs atomMatrix =

41+ Relation attrs <$> mkTupleSetFromList attrs atomMatrix

4342

4443emptyRelationWithAttrs :: Attributes -> Relation

4544emptyRelationWithAttrs attrs = Relation attrs emptyTupleSet

@@ -220,8 +219,7 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

220219 joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2

221220 return $ joinedTupSet ++ accumulator

222221 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)

223− newTupSet <- mkTupleSet newAttrs newTupSetList

224− return $ Relation newAttrs newTupSet

222+ Relation newAttrs <$> mkTupleSet newAttrs newTupSetList

225223

226224-- | Difference takes two relations of the same type and returns a new relation which contains only tuples which appear in the first relation but not the second.

227225difference :: Relation -> Relation -> Either RelationalError Relation

src/lib/ProjectM36/Relation/Parse/CSV.hs+1−1

@@ -57,7 +57,7 @@ csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecode

5757

5858

5959parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> APT.Parser (Either RelationalError Atom)

60−parseCSVAtomP _ _ IntegerAtomType = (Right . IntegerAtom) <$> APT.decimal

60+parseCSVAtomP _ _ IntegerAtomType = Right . IntegerAtom <$> APT.decimal

6161parseCSVAtomP _ _ IntAtomType = Right . IntAtom <$> APT.decimal

6262parseCSVAtomP _ _ DoubleAtomType = Right . DoubleAtom <$> APT.double

6363parseCSVAtomP _ _ TextAtomType = do

src/lib/ProjectM36/Transaction/Persist.hs+8−9

@@ -23,9 +23,9 @@ import qualified Data.ByteString as BS

2323import qualified Data.ByteString.Lazy as BSL

2424

2525getDirectoryNames :: FilePath -> IO [FilePath]

26−getDirectoryNames path = do

27− subpaths <- getDirectoryContents path

28− return $ filter (\n -> n `notElem` ["..", "."]) subpaths

26+getDirectoryNames path =

27+ filter (\ n -> n `notElem` ["..", "."]) <$> getDirectoryContents path

28+

2929

3030tempTransactionDir :: FilePath -> TransactionId -> FilePath

3131tempTransactionDir dbdir transId = dbdir </> "." ++ show transId

@@ -109,10 +109,10 @@ readRelVars :: FilePath -> IO (M.Map RelVarName Relation)

109109readRelVars transDir = do

110110 let relvarsPath = relvarsDir transDir

111111 relvarNames <- getDirectoryNames relvarsPath

112− relvars <- mapM (\name -> do

112+ let relvars = mapM (\name -> do

113113 rel <- B.decode . decompress . BSL.fromStrict <$> BS.readFile (relvarsPath </> name)

114114 return (T.pack name, rel)) relvarNames

115− return $ M.fromList relvars

115+ M.fromList <$> relvars

116116

117117writeAtomFuncs :: DiskSync -> FilePath -> AtomFunctions -> IO ()

118118writeAtomFuncs sync transDir funcs = do

@@ -191,8 +191,8 @@ readDBCFuncs transDir mScriptSession = do

191191 funcNames <- getDirectoryNames (dbcFuncsDir transDir)

192192 --only Haskell script functions can be serialized

193193 --we always return the pre-compiled functions

194− funcs <- mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

195− return $ HS.union basicDatabaseContextFunctions (HS.fromList funcs)

194+ let funcs = mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

195+ HS.union basicDatabaseContextFunctions . HS.fromList <$> funcs

196196

197197readDBCFunc :: FilePath -> DatabaseContextFunctionName -> Maybe ScriptSession -> DatabaseContextFunctions -> IO DatabaseContextFunction

198198readDBCFunc transDir funcName mScriptSession precompiledFuncs = do

@@ -232,8 +232,7 @@ readIncDeps :: FilePath -> IO (M.Map IncDepName InclusionDependency)

232232readIncDeps transDir = do

233233 let incDepsPath = incDepsDir transDir

234234 incDepNames <- getDirectoryNames incDepsPath

235− incDeps <- mapM (readIncDep transDir . T.pack) incDepNames

236− return $ M.fromList incDeps

235+ M.fromList <$> mapM (readIncDep transDir . T.pack) incDepNames

237236

238237readSubschemas :: FilePath -> IO Subschemas

239238readSubschemas transDir = do

src/lib/ProjectM36/TransactionGraph.hs+5−6

@@ -98,9 +98,8 @@ transactionForId tid graph

9898 matchingTrans = S.filter (\(Transaction idMatch _ _) -> idMatch == tid) (transactionsForGraph graph)

9999

100100transactionsForIds :: S.Set TransactionId -> TransactionGraph -> Either RelationalError (S.Set Transaction)

101−transactionsForIds idSet graph = do

102− transList <- forM (S.toList idSet) (`transactionForId` graph)

103− return (S.fromList transList)

101+transactionsForIds idSet graph =

102+ S.fromList <$> forM (S.toList idSet) (`transactionForId` graph)

104103

105104isRootTransaction :: Transaction -> TransactionGraph -> Bool

106105isRootTransaction (Transaction _ (TransactionInfo pId _ _) _) _ = U.null pId

@@ -108,9 +107,9 @@ isRootTransaction (Transaction _ MergeTransactionInfo{} _) _ = False

108107

109108-- the first transaction has no parent - all other do have parents- merges have two parents

110109parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

111−parentTransactions (Transaction _ (TransactionInfo pId _ _) _) graph = do

112− trans <- transactionForId pId graph

113− return (S.singleton trans)

110+parentTransactions (Transaction _ (TransactionInfo pId _ _) _) graph =

111+ S.singleton <$> transactionForId pId graph

112+

114113

115114parentTransactions (Transaction _ (MergeTransactionInfo pId1 pId2 _ _) _ ) graph = transactionsForIds (S.fromList [pId1, pId2]) graph

116115

src/lib/ProjectM36/TransactionGraph/Persist.hs+1−3

@@ -211,7 +211,5 @@ readGraphTransactionIdFile dbdir = do

211211 (readUUID tid, readEpoch epochText, map readUUID parentIds)

212212 readUUID uuidText = fromMaybe (error "failed to read uuid") (U.fromText uuidText)

213213 readEpoch t = posixSecondsToUTCTime (realToFrac (either (error "failed to read epoch") fst (double t)))

214− --warning: uses lazy IO

215− graphTransactionIdData <- TIO.readFile (transactionLogPath dbdir)

216− return $ Right (map grapher $ T.lines graphTransactionIdData)

214+ Right . map grapher . T.lines <$> TIO.readFile (transactionLogPath dbdir)

217215

src/lib/ProjectM36/Tuple.hs+2−3

@@ -56,9 +56,8 @@ atomTypeForAttributeName attrName tup = do

5656-}

5757

5858atomsForAttributeNames :: V.Vector AttributeName -> RelationTuple -> Either RelationalError (V.Vector Atom)

59−atomsForAttributeNames attrNames tuple = do

60− vindices <- vectorIndicesForAttributeNames attrNames (tupleAttributes tuple)

61− return $ V.map (\index -> tupleAtoms tuple V.! index) vindices

59+atomsForAttributeNames attrNames tuple =

60+ V.map (\index -> tupleAtoms tuple V.! index) <$> vectorIndicesForAttributeNames attrNames (tupleAttributes tuple)

6261

6362vectorIndicesForAttributeNames :: V.Vector AttributeName -> Attributes -> Either RelationalError (V.Vector Int)

6463vectorIndicesForAttributeNames attrNameVec attrs = if not $ V.null unknownAttrNames then

test/Client/Simple.hs+14−8

@@ -3,11 +3,14 @@ import Test.HUnit

33import System.Exit

44import ProjectM36.Relation

55import qualified ProjectM36.Client as C

6+import ProjectM36.DateExamples

7+import ProjectM36.DatabaseContext

68import System.IO.Temp

79import System.FilePath

810import ProjectM36.TupleSet

911import ProjectM36.Attribute

1012import qualified Data.Vector as V

13+import qualified Data.Map as M

1114

1215main :: IO ()

1316main = do

@@ -15,7 +18,7 @@ main = do

1518 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

1619

1720testList :: Test

18−testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure]

21+testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure, testSimpleUpdate]

1922

2023assertEither :: (Show a) => IO (Either a b) -> IO b

2124assertEither x = do

@@ -45,6 +48,7 @@ testSimpleCommitSuccess = TestCase $

4548 eRes <- C.executeRelationalExpr sess conn relExpr

4649 assertEqual "x and y" (Right relationTrue) eRes

4750

51+

4852testSimpleCommitFailure :: Test

4953testSimpleCommitFailure = TestCase $ do

5054 let failAttrs = attributesFromList [Attribute "fail" IntAtomType]

@@ -57,11 +61,13 @@ testSimpleCommitFailure = TestCase $ do

5761 execute $ Assign "x" (MakeStaticRelation failAttrs emptyTupleSet)

5862 let expectedErr = Left (RelError (RelationTypeMismatchError V.empty failAttrs))

5963 assertEqual "dbc error" expectedErr err

60−

61−

62−

6364

64−

65−

66−

67−

65+-- #176 default merge couldn't handle Update

66+testSimpleUpdate :: Test

67+testSimpleUpdate = TestCase $ do

68+ let connInfo = InProcessConnectionInfo NoPersistence emptyNotificationCallback []

69+ dbconn <- assertEither (simpleConnectProjectM36 connInfo)

70+ assertEither $ withTransaction dbconn $

71+ execute $ databaseContextAsDatabaseContextExpr dateExamples

72+ assertEither $ withTransaction dbconn $

73+ execute $ Update "s" (M.singleton "sname" (C.NakedAtomExpr (C.TextAtom "Blakey"))) (C.AttributeEqualityPredicate "sname" (C.NakedAtomExpr (C.TextAtom "Blake")))

test/Relation/StaticOptimizer.hs+3−9

@@ -124,18 +124,12 @@ testPushDownRestrictionPredicate :: Test

124124testPushDownRestrictionPredicate = TestCase $ do

125125 -- (s union relation{tuple{city "Boston", s# "S6", sname "Stevens", status 50}}) where status = 30 == (s where status=30) union (relation{tuple{city "Boston", s# "S6", sname "Stevens", status 50}} where status=30)

126126 let rvs = RelationVariable "s" ()

127− stevens <- case mkRelationFromList (attributes suppliersRel) [

128− [TextAtom "S6", TextAtom "Stevens", IntegerAtom 50, TextAtom "Boston"]] of

129− Left err -> assertFailure ("stevens relation: " ++ show err) >> pure relationTrue

130− Right rel -> pure rel

131− let expr1 = Restrict status30 (Union rvs (ExistingRelation stevens))

132− status30 = AttributeEqualityPredicate "status" (NakedAtomExpr (IntAtom 30))

127+ let status30 = AttributeEqualityPredicate "status" (NakedAtomExpr (IntAtom 30))

133128 relationsOrError = do

134129 stevens <- mkRelationFromList (attributes suppliersRel) [[TextAtom "S6", TextAtom "Stevens", IntegerAtom 50, TextAtom "Boston"]]

135− let expr1 = Restrict status30 (Union rvs (ExistingRelation stevens))

136− status30 = AttributeEqualityPredicate "status" (NakedAtomExpr (IntAtom 30))

130+ let expectedExpr1 = Union (Restrict status30 rvs) (Restrict status30 (ExistingRelation stevens))

131+ expr1 = Restrict status30 (Union rvs (ExistingRelation stevens))

137132

138− expectedExpr1 = Union (Restrict status30 rvs) (Restrict status30 (ExistingRelation stevens))

139133 pure (expectedExpr1, applyStaticRestrictionPushdown expr1)

140134 either (assertFailure . (++) "stevens relation: " . show) (uncurry $ assertEqual "union restriction pushdown") relationsOrError

141135