git.iko.soy/project-m36
on master help sign in
Merge branch 'master' of https://github.com/agentm/project-m36
commit585420ac20b7657659743f103592c96c8a269841 authorAgentM <agentm@themactionfaction.com> dateWed 30 Nov 2016, 22:03 (10 years ago) parent912a0a93e4fee1
3 files changed+25−3
compare with master
unifiedsplit
src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+6 src/lib/ProjectM36/TransactionGraph.hs+5−1 test/TutorialD/Interpreter.hs+14−2
src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+6
@@ -26,6 +26,11 @@ branchTransactionP = do
2626 branchName <- identifier
2727 return $ Branch branchName
2828
29+deleteBranchP :: Parser TransactionGraphOperator
30+deleteBranchP = do
31+ reserved ":deletebranch"
32+ DeleteBranch <$> identifier
33+
2934commitTransactionP :: Parser TransactionGraphOperator
3035commitTransactionP = do
3136 reservedOp ":commit"
@@ -65,6 +70,7 @@ transactionGraphOpP = do
6570 jumpToHeadP
6671 <|> jumpToTransactionP
6772 <|> branchTransactionP
73+ <|> deleteBranchP
6874 <|> commitTransactionP
6975 <|> rollbackTransactionP
7076 <|> mergeTransactionsP
src/lib/ProjectM36/TransactionGraph.hs+5−1
@@ -33,6 +33,7 @@ data TransactionIdHeadBacktrack = TransactionIdHeadParentBacktrack Int | -- git
3333data TransactionGraphOperator = JumpToHead HeadName |
3434 JumpToTransaction TransactionId |
3535 Branch HeadName |
36+ DeleteBranch HeadName |
3637 MergeTransactions MergeStrategy HeadName HeadName |
3738 Commit |
3839 Rollback
@@ -240,9 +241,12 @@ evalGraphOp _ (DisconnectedTransaction parentId _) graph Rollback = case transac
240241 where
241242 newDiscon = DisconnectedTransaction parentId (schemas parentTransaction)
242243
243−-- a successful merge should remove a head
244244evalGraphOp newId (DisconnectedTransaction parentId _) graph (MergeTransactions mergeStrategy headNameA headNameB) = mergeTransactions newId parentId mergeStrategy (headNameA, headNameB) graph
245245
246+evalGraphOp _ discon graph@(TransactionGraph graphHeads transSet) (DeleteBranch branchName) = case transactionForHead branchName graph of
247+ Nothing -> Left (NoSuchHeadNameError branchName)
248+ Just _ -> Right (discon, TransactionGraph (M.delete branchName graphHeads) transSet)
249+
246250--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction
247251graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation
248252graphAsRelation (DisconnectedTransaction parentId _) graph@(TransactionGraph _ transSet) = do
test/TutorialD/Interpreter.hs+14−2
@@ -331,10 +331,22 @@ testTransGraphRelationalExpr = TestCase $ do
331331 diff <- executeTransGraphRelationalExpr sessionId dbconn (Difference (RelationVariable "s" testBranchMarker) (RelationVariable "s" masterMarker))
332332 assertEqual "difference in s" expectedRel diff
333333
334− --test graph traversal (head backtracking
334+ --test graph traversal (head backtracking)
335335 let testBranchBacktrack = TransactionIdHeadNameLookup "testbranch" [TransactionIdHeadParentBacktrack 1]
336336 backtrackRel <- executeTransGraphRelationalExpr sessionId dbconn (Equals (RelationVariable "s" testBranchBacktrack) (RelationVariable "s" masterMarker))
337337 assertEqual "backtrack to master" (Right relationTrue) backtrackRel
338+
339+ --test branch deletion
340+ mapM_ (executeTutorialD sessionId dbconn) [
341+ ":jumphead master",
342+ ":deletebranch testbranch"]
343+ eEvald <- case parseTutorialD ":jumphead testbranch" of
344+ Left _ -> assertFailure "jumphead parse error" >> error "x"
345+ Right parsed -> evalTutorialD sessionId dbconn UnsafeEvaluation parsed
346+ case eEvald of
347+ DisplayErrorResult err -> assertEqual "testbranch deletion" (show (NoSuchHeadNameError "testbranch")) (unpack err)
348+ _ -> assertFailure "failed to delete branch"
349+
338350
339351testMultiAttributeRename :: Test
340352testMultiAttributeRename = TestCase $ assertTutdEqual dateExamples renamedRel "x:=s rename {city as town, status as price} where false"
@@ -393,4 +405,4 @@ testFunctionalDependencies = TestCase $ do
393405 executeTutorialD sessionId dbconn "insert s relation{tuple{city \"Boston\", s# \"S6\", sname \"Stevens\", status 30}}"
394406 --insert an constraint-violating tuple
395407 let expectedError = InclusionDependencyCheckError "sname_status_A"
396− expectTutorialDErr sessionId dbconn expectedError "insert s relation{tuple{city \"Boston\", s# \"S7\", sname \"Jones\", status 20}}"
408+ expectTutorialDErr sessionId dbconn expectedError "insert s relation{tuple{city \"Boston\", s# \"S7\", sname \"Jones\", status 20}}"