@@ -1,6 +1,7 @@
11{-# LANGUAGE OverloadedStrings #-}
22import TutorialD.Interpreter.DatabaseExpr
33import TutorialD.Interpreter
4+import TutorialD.Interpreter.Base
45import Test.HUnit
56import ProjectM36.RelationalExpression
67import ProjectM36.Relation
@@ -8,16 +9,14 @@ import ProjectM36.Tuple
89import ProjectM36.TupleSet
910import ProjectM36.Error
1011import ProjectM36.Base
11−import ProjectM36.Transaction
1212import ProjectM36.TransactionGraph
13+import ProjectM36.Client
1314import qualified ProjectM36.Attribute as A
1415import qualified Data.HashSet as HS
1516import qualified Data.Map as M
16−import qualified Data.Set as S
1717import System.Exit
18−import Data.UUID.V4 (nextRandom)
19−import Data.UUID (nil)
20−import Data.Either (isRight)
18+import Data.Maybe (isJust)
19+import System.IO
2120import qualified Data.Vector as V
2221
2322--urgent: add group and ungroup tests- I missed the group relation type bug
@@ -105,91 +104,78 @@ assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interp
105104
106105transactionGraphBasicTest :: Test
107106transactionGraphBasicTest = TestCase $ do
108− (_, graph) <- dateExamplesGraph
109− assertEqual "validate bootstrapped graph" (validateGraph graph) Nothing
107+ dbconn <- dateExamplesConnection
108+ graph <- transactionGraph dbconn
109+ assertEqual "validate bootstrapped graph" (validateGraph graph) Nothing
110110
111111--add a new transaction to the graph, validate it is in the graph
112112transactionGraphAddCommitTest :: Test
113113transactionGraphAddCommitTest = TestCase $ do
114− ((DisconnectedTransaction firstUUID context), origGraph) <- dateExamplesGraph
115− freshUUID <- nextRandom
116− case interpretDatabaseExpr context "x:=S" of
117− Left err -> assertFailure (show err)
118− Right newContext -> do
119− let discon = newDisconnectedTransaction firstUUID newContext
120− let addTrans = addDisconnectedTransaction freshUUID "master" discon origGraph
121− case addTrans of
122− Left err -> assertFailure (show err)
123− Right (newTrans, graph) -> do
124− assertBool "transaction in graph" (isRight $ transactionForUUID freshUUID graph)
125− assertEqual "validate fresh commit with deleted S" (validateGraph graph) Nothing
126− assertEqual "ensure S was deleted in newContext" (M.lookup "x" (relationVariables (transactionContext newTrans))) (Just suppliersRel)
114+ dbconn <- dateExamplesConnection
115+ case parseTutorialD dbconn "x:=S" of
116+ Left err -> assertFailure (show err)
117+ Right parsed -> do
118+ result <- evalTutorialD dbconn parsed
119+ case result of
120+ QuitResult -> assertFailure "quit?"
121+ DisplayResult _ -> assertFailure "display?"
122+ DisplayIOResult _ -> assertFailure "displayIO?"
123+ DisplayErrorResult err -> assertFailure (show err)
124+ QuietSuccessResult -> do
125+ commit dbconn >>= maybeFail
126+ (DisconnectedTransaction _ context) <- disconnectedTransaction dbconn
127+ assertEqual "ensure x was added" (M.lookup "x" (relationVariables context)) (Just suppliersRel)
127128
128129transactionRollbackTest :: Test
129130transactionRollbackTest = TestCase $ do
130− ((DisconnectedTransaction firstUUID origContext), graph) <- dateExamplesGraph
131− freshUUID <- nextRandom
132− case transactionForUUID firstUUID graph of
133− Left err -> assertFailure (show err)
134− Right _ -> do
135− case interpretDatabaseExpr origContext "x:=S" of
136− Left err -> assertFailure (show err)
137− Right newContext -> do
138− let discon = newDisconnectedTransaction firstUUID newContext
139− let (_, (DisconnectedTransaction _ newContext2), newGraph, _) = interpret freshUUID discon graph ":rollback"
140− assertEqual "validate context" (M.lookup "x" (relationVariables newContext2)) Nothing
141− assertEqual "validate graph" graph newGraph
131+ dbconn <- dateExamplesConnection
132+ graph <- transactionGraph dbconn
133+ maybeErr <- executeDatabaseContextExpr dbconn (Assign "x" (RelationVariable "S"))
134+ case maybeErr of
135+ Just err -> assertFailure (show err)
136+ Nothing -> do
137+ rollback dbconn >>= maybeFail
138+ (DisconnectedTransaction _ context') <- disconnectedTransaction dbconn
139+ graph' <- transactionGraph dbconn
140+ assertEqual "validate context" Nothing (M.lookup "x" (relationVariables context'))
141+ assertEqual "validate graph" graph graph'
142142
143143--commit a new transaction with "x" relation, jump to first transaction, verify that "x" is not present
144144transactionJumpTest :: Test
145145transactionJumpTest = TestCase $ do
146− ((DisconnectedTransaction firstUUID origContext), origGraph) <- dateExamplesGraph
147− freshUUID <- nextRandom
148− case transactionForUUID firstUUID origGraph of
149− Left err -> assertFailure (show err)
150− Right _ -> do
151− case interpretDatabaseExpr origContext "x:=S" of
152− Left err -> assertFailure (show err)
153− Right newContext -> do
154− --modify the second transaction
155− case interpretDatabaseExpr newContext "x:=S" of
156− Left err-> assertFailure (show err)
157− Right newContext2 -> do
158− --add the transaction
159− let discon = newDisconnectedTransaction firstUUID newContext2
160− let addTrans = addDisconnectedTransaction freshUUID "master" discon origGraph
161− case addTrans of
162− Left err -> assertFailure (show err)
163− Right (_, graph) -> do
164− --jump to the first transaction
165− let (_, (DisconnectedTransaction parentUUID newContext3), newGraph, _) = interpret freshUUID discon graph (":jump " ++ show firstUUID)
166− assertEqual "validate discon" parentUUID firstUUID
167− assertEqual "validate discon2" Nothing (M.lookup "x" (relationVariables newContext3))
168− assertEqual "validate graph" transactionUUIDs (S.map transactionUUID (transactionsForGraph newGraph))
169− where
170− transactionUUIDs = S.fromList [firstUUID, freshUUID]
146+ dbconn <- dateExamplesConnection
147+ (DisconnectedTransaction firstUUID _) <- disconnectedTransaction dbconn
148+ maybeErr <- executeDatabaseContextExpr dbconn (Assign "x" (RelationVariable "S"))
149+ case maybeErr of
150+ Just err -> assertFailure (show err)
151+ Nothing -> do
152+ commit dbconn >>= maybeFail
153+ --perform the jump
154+ maybeErr2 <- executeGraphExpr dbconn (JumpToTransaction firstUUID)
155+ case maybeErr2 of
156+ Just err -> assertFailure (show err)
157+ Nothing -> do
158+ --check that the disconnected transaction does not include "x"
159+ (DisconnectedTransaction _ context') <- disconnectedTransaction dbconn
160+ assertEqual "ensure x is not present" Nothing (M.lookup "x" (relationVariables context'))
161+
162+maybeFail :: (Show a) => Maybe a -> IO ()
163+maybeFail (Just err) = assertFailure (show err)
164+maybeFail Nothing = return ()
171165
172166--branch from the first transaction and verify that there are two heads
173167transactionBranchTest :: Test
174168transactionBranchTest = TestCase $ do
175− (origDiscon@(DisconnectedTransaction firstUUID origContext), origGraph) <- dateExamplesGraph
176− freshUUID1 <- nextRandom
177− freshUUID2 <- nextRandom
178− case transactionForUUID firstUUID origGraph of
179− Left err -> assertFailure (show err)
180− Right _ -> do
181− let disconMaster = newDisconnectedTransaction firstUUID origContext
182− let addTransMaster = addDisconnectedTransaction freshUUID1 "master" disconMaster origGraph
183− --add a second transaction to the "master" branch
184− case addTransMaster of
185− Left err -> assertFailure (show err)
186− Right (_, graph) -> do
187− --add a third transaction to the "test" branch
188− let (_, _, newGraph, _) = interpret freshUUID2 origDiscon graph ":branch test"
189− assertEqual "verify test head" freshUUID2 $ maybeTransUUID (transactionForHead "test" newGraph)
190− assertEqual "verify master head" freshUUID1 $ maybeTransUUID (transactionForHead "master" newGraph)
191− where
192− maybeTransUUID t = maybe nil transactionUUID t
169+ dbconn <- dateExamplesConnection
170+ mapM_ (\x -> x >>= maybeFail) [executeGraphExpr dbconn (Branch "test"),
171+ executeDatabaseContextExpr dbconn (Assign "x" (RelationVariable "S")),
172+ commit dbconn,
173+ executeGraphExpr dbconn (JumpToHead "master"),
174+ executeDatabaseContextExpr dbconn (Assign "y" (RelationVariable "S"))
175+ ]
176+ graph <- transactionGraph dbconn
177+ assertBool "master branch exists" $ isJust (transactionForHead "master" graph)
178+ assertBool "test branch exists" $ isJust (transactionForHead "test" graph)
193179
194180simpleJoinTest :: Test
195181simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP"
@@ -214,10 +200,18 @@ simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP
214200 [StringAtom "London", IntAtom 200, StringAtom "P2", StringAtom "S4", StringAtom "Clark", IntAtom 20]
215201 ]
216202
217−dateExamplesGraph :: IO (DisconnectedTransaction, TransactionGraph)
218−dateExamplesGraph = do
219− firstTransactionUUID <- nextRandom
220− let graph = bootstrapTransactionGraph firstTransactionUUID dateExamples
221− let discon = newDisconnectedTransaction firstTransactionUUID dateExamples
222− return (discon, graph)
203+dateExamplesConnection :: IO (Connection)
204+dateExamplesConnection = do
205+ dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)
206+ case dbconn of
207+ Left err -> do
208+ hPutStrLn stderr (show err)
209+ exitFailure
210+ Right conn -> do
211+ mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr conn (Assign rvName (ExistingRelation rvRel))) (M.toList (relationVariables dateExamples))
212+ mapM_ (\(idName,incDep) -> executeDatabaseContextExpr conn (AddInclusionDependency idName incDep)) (M.toList (inclusionDependencies dateExamples))
213+ --skipping atom functions for now- there are no atom function manipulation operators yet
214+ commit conn >>= maybeFail
215+ return conn
216+
223217