git.iko.soy/project-m36
on master help sign in
add new commit test
commit6e2c6b002f37298a81886c9b1c6dadf655c9c4b4 authorAgentM <agentm@themactionfaction.com> dateMon 23 Mar 2015, 22:38 (12 years ago) parent455a020
4 files changed+25−5
compare with master
unifiedsplit
RelationType.hs+1−1 RelationalTransaction.hs+1−1 TutorialDInterpreter.hs+1 TutorialDInterpreterTest.hs+22−3
RelationType.hs+1−1
@@ -121,7 +121,7 @@ data Transaction = Transaction UUID TransactionInfo DatabaseContext -- self uuid
121121--represents an "in-progress" transaction which has not yet been added to the transaction graph
122122--one the transaction is "complete", it is committed and no longer can be changed
123123-- this is similar to the index in git
124−data DisconnectedTransaction = DisconnectedTransaction UUID DatabaseContext --parent UUID
124+data DisconnectedTransaction = DisconnectedTransaction UUID DatabaseContext --parentUUID, context
125125
126126transactionUUID :: Transaction -> UUID
127127transactionUUID (Transaction uuid _ _) = uuid
RelationalTransaction.hs+1−1
@@ -128,4 +128,4 @@ walkChildTransactions seenTransSet graph trans =
128128 case walk of
129129 err:xs -> Just err
130130 _ -> Nothing
131−
131+
TutorialDInterpreter.hs+1
@@ -419,6 +419,7 @@ evalGraphOp newTransUUID discon@(DisconnectedTransaction parentUUID context) gra
419419 --parentTransaction = transactionForUUID parentUUID graph
420420 maybeUpdatedGraph = addDisconnectedTransaction newTransUUID headName discon graph
421421
422+--shouldn't this be Either RelationalError DatabaseContext?
422423interpret :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseContext)
423424interpret context tutdstring = case parseString tutdstring of
424425 Left err -> (Just err, context)
TutorialDInterpreterTest.hs+22−3
@@ -9,12 +9,13 @@ import qualified Data.HashSet as HS
99import qualified Data.Map as M
1010import System.Exit
1111import Data.UUID.V4 (nextRandom)
12+import Data.Either (isRight)
1213
1314main = do
1415 counts <- runTestTT (TestList tests)
1516 if errors counts + failures counts > 0 then exitFailure else exitSuccess
1617 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]
1819 simpleRelTests = [("x:=true", Right relationTrue),
1920 ("x:=false", Right relationFalse),
2021 ("x:=true union false", Right relationTrue),
@@ -53,10 +54,28 @@ assertTutdEqual databaseContext tutd expected = assertEqual tutd interpreted exp
5354 (Just err, _) -> Left err
5455 (Nothing, context) -> Right $ (relationVariables context) M.! "x"
5556
56−transactionGraphTest1 = TestCase $ do
57+transactionGraphBasicTest = TestCase $ do
5758 (discon, graph) <- dateExamplesGraph
5859 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+
6079dateExamplesGraph :: IO (DisconnectedTransaction, TransactionGraph)
6180dateExamplesGraph = do
6281 firstTransactionUUID <- nextRandom