on master help sign in
add ":deletebranch" tutoriald operator

resolves #34

commit3e4fee1812977cba172f03cfcf79ffdf9460bce4 authorAgentM <agentm@themactionfaction.com> dateFri 25 Nov 2016, 10:13 (10 years ago) parent2c079c0
3 files changed+24−2
src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+6 src/lib/ProjectM36/TransactionGraph.hs+5−1 test/TutorialD/Interpreter.hs+13−1
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
@@ -239,9 +240,12 @@ evalGraphOp _ (DisconnectedTransaction parentId _) graph Rollback = case transac
239240 where
240241 newDiscon = DisconnectedTransaction parentId (schemas parentTransaction)
241242
242−-- a successful merge should remove a head
243243evalGraphOp newId (DisconnectedTransaction parentId _) graph (MergeTransactions mergeStrategy headNameA headNameB) = mergeTransactions newId parentId mergeStrategy (headNameA, headNameB) graph
244244
245+evalGraphOp _ discon graph@(TransactionGraph graphHeads transSet) (DeleteBranch branchName) = case transactionForHead branchName graph of
246+ Nothing -> Left (NoSuchHeadNameError branchName)
247+ Just _ -> Right (discon, TransactionGraph (M.delete branchName graphHeads) transSet)
248+
245249--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction
246250graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation
247251graphAsRelation (DisconnectedTransaction parentId _) graph@(TransactionGraph _ transSet) = do
test/TutorialD/Interpreter.hs+13−1
@@ -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"