git.iko.soy/project-m36
on master help sign in
add new commit test
6e2c6b0AgentM
RelationType.hs+1−1
compare with master
unifiedsplit
@@ -121,7 +121,7 @@ data Transaction = Transaction UUID TransactionInfo DatabaseContext -- self uuid
121--represents an "in-progress" transaction which has not yet been added to the transaction graph
121--represents an "in-progress" transaction which has not yet been added to the transaction graph
122--one the transaction is "complete", it is committed and no longer can be changed
122--one the transaction is "complete", it is committed and no longer can be changed
123-- this is similar to the index in git
123-- this is similar to the index in git
124−data DisconnectedTransaction = DisconnectedTransaction UUID DatabaseContext --parent UUID
124+data DisconnectedTransaction = DisconnectedTransaction UUID DatabaseContext --parentUUID, context
125
125
126transactionUUID :: Transaction -> UUID
126transactionUUID :: Transaction -> UUID
127transactionUUID (Transaction uuid _ _) = uuid
127transactionUUID (Transaction uuid _ _) = uuid
RelationalTransaction.hs+1−1
@@ -128,4 +128,4 @@ walkChildTransactions seenTransSet graph trans =
128 case walk of
128 case walk of
129 err:xs -> Just err
129 err:xs -> Just err
130 _ -> Nothing
130 _ -> Nothing
131−
131+
TutorialDInterpreter.hs+1
@@ -419,6 +419,7 @@ evalGraphOp newTransUUID discon@(DisconnectedTransaction parentUUID context) gra
419 --parentTransaction = transactionForUUID parentUUID graph
419 --parentTransaction = transactionForUUID parentUUID graph
420 maybeUpdatedGraph = addDisconnectedTransaction newTransUUID headName discon graph
420 maybeUpdatedGraph = addDisconnectedTransaction newTransUUID headName discon graph
421
421
422+--shouldn't this be Either RelationalError DatabaseContext?
422interpret :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseContext)
423interpret :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseContext)
423interpret context tutdstring = case parseString tutdstring of
424interpret context tutdstring = case parseString tutdstring of
424 Left err -> (Just err, context)
425 Left err -> (Just err, context)
TutorialDInterpreterTest.hs+22−3
@@ -9,12 +9,13 @@ import qualified Data.HashSet as HS
9import qualified Data.Map as M
9import qualified Data.Map as M
10import System.Exit
10import System.Exit
11import Data.UUID.V4 (nextRandom)
11import Data.UUID.V4 (nextRandom)
12+import Data.Either (isRight)
12
13
13main = do
14main = do
14 counts <- runTestTT (TestList tests)
15 counts <- runTestTT (TestList tests)
15 if errors counts + failures counts > 0 then exitFailure else exitSuccess
16 if errors counts + failures counts > 0 then exitFailure else exitSuccess
16 where
17 where
17− tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext tutd expected) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples tutd expected) dateExampleRelTests ++ [transactionGraphTest1]
18+ tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext tutd expected) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples tutd expected) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest]
18 simpleRelTests = [("x:=true", Right relationTrue),
19 simpleRelTests = [("x:=true", Right relationTrue),
19 ("x:=false", Right relationFalse),
20 ("x:=false", Right relationFalse),
20 ("x:=true union false", Right relationTrue),
21 ("x:=true union false", Right relationTrue),
@@ -53,10 +54,28 @@ assertTutdEqual databaseContext tutd expected = assertEqual tutd interpreted exp
53 (Just err, _) -> Left err
54 (Just err, _) -> Left err
54 (Nothing, context) -> Right $ (relationVariables context) M.! "x"
55 (Nothing, context) -> Right $ (relationVariables context) M.! "x"
55
56
56−transactionGraphTest1 = TestCase $ do
57+transactionGraphBasicTest = TestCase $ do
57 (discon, graph) <- dateExamplesGraph
58 (discon, graph) <- dateExamplesGraph
58 assertEqual "validate bootstrapped graph" (validateGraph graph) Nothing
59 assertEqual "validate bootstrapped graph" (validateGraph graph) Nothing
59−
60+
61+--add a new transaction to the graph, validate it is in the graph
62+transactionGraphAddCommitTest = TestCase $ do
63+ (discon@(DisconnectedTransaction firstUUID context), graph) <- dateExamplesGraph
64+ freshUUID <- nextRandom
65+ case interpret context "x:=S" of
66+ (Just err, newContext) -> assertFailure (show err)
67+ (Nothing, newContext) -> do
68+ let discon = newDisconnectedTransaction firstUUID newContext
69+ let addTrans = addDisconnectedTransaction freshUUID "master" discon graph
70+ case addTrans of
71+ Left err -> assertFailure (show err)
72+ Right (newTrans, graph) -> do
73+ assertBool "transaction in graph" (isRight $ transactionForUUID freshUUID graph)
74+ assertEqual "validate fresh commit with deleted S" (validateGraph graph) Nothing
75+ assertEqual "ensure S was deleted in newContext" (M.lookup "x" (relationVariables (transactionContext newTrans))) (Just s)
76+
77+--test rollback, jump, branch
78+
60dateExamplesGraph :: IO (DisconnectedTransaction, TransactionGraph)
79dateExamplesGraph :: IO (DisconnectedTransaction, TransactionGraph)
61dateExamplesGraph = do
80dateExamplesGraph = do
62 firstTransactionUUID <- nextRandom
81 firstTransactionUUID <- nextRandom