git.iko.soy/project-m36
on master help sign in
merge test success checkpoint
9f12c25AgentM
ProjectM36/TransactionGraph.hs+3−4
compare with master
unifiedsplit
@@ -316,17 +316,16 @@ mergeTransactions newUUID parentUUID mergeStrategy (headNameA, headNameB) graph
316 disconParent <- transactionForUUID parentUUID graph
316 disconParent <- transactionForUUID parentUUID graph
317 let subHeads = M.filterWithKey (\k _ -> elem k [headNameA, headNameB]) (transactionHeadsForGraph graph)
317 let subHeads = M.filterWithKey (\k _ -> elem k [headNameA, headNameB]) (transactionHeadsForGraph graph)
318 subGraph <- subGraphToFirstCommonAncestor graph subHeads emptyTransactionGraph transA transB
318 subGraph <- subGraphToFirstCommonAncestor graph subHeads emptyTransactionGraph transA transB
319− --traceShowM ("hello\n" ++ showGraphStructureX subGraph)
320 case createMergeTransaction newUUID mergeStrategy subGraph (transA, transB) of
319 case createMergeTransaction newUUID mergeStrategy subGraph (transA, transB) of
321 Left err -> Left (MergeTransactionError err)
320 Left err -> Left (MergeTransactionError err)
322 Right mergedTrans -> case headNameForTransaction disconParent graph of
321 Right mergedTrans -> case headNameForTransaction disconParent graph of
323 Nothing -> Left (TransactionIsNotAHeadError parentUUID)
322 Nothing -> Left (TransactionIsNotAHeadError parentUUID)
324 Just headName -> do
323 Just headName -> do
325− let newDiscon = newDisconnectedTransaction mergedTransUUID (transactionContext mergedTrans)
324+ -- why create a merge transaction and then only use the context?
326− mergedTransUUID = transactionUUID mergedTrans
325+ (newTrans, newGraph) <- addTransactionToGraph headName disconParent newUUID (transactionContext mergedTrans) graph
327− (_, newGraph) <- addDisconnectedTransaction mergedTransUUID headName newDiscon graph
328 let newGraph' = TransactionGraph newHeads (transactionsForGraph newGraph)
326 let newGraph' = TransactionGraph newHeads (transactionsForGraph newGraph)
329 newHeads = M.delete headNameToDelete (transactionHeadsForGraph newGraph)
327 newHeads = M.delete headNameToDelete (transactionHeadsForGraph newGraph)
328+ newDiscon = newDisconnectedTransaction newUUID (transactionContext newTrans)
330 pure (newDiscon, newGraph')
329 pure (newDiscon, newGraph')
331
330
332--TEMPORARY COPY/PASTE
331--TEMPORARY COPY/PASTE
test/TransactionGraph/Merge.hs+11−11
@@ -5,6 +5,7 @@ import ProjectM36.Base
5import ProjectM36.TransactionGraph
5import ProjectM36.TransactionGraph
6import ProjectM36.TransactionGraph.Show
6import ProjectM36.TransactionGraph.Show
7import ProjectM36.DateExamples
7import ProjectM36.DateExamples
8+import ProjectM36.Error
8import qualified Data.ByteString.Lazy as BS
9import qualified Data.ByteString.Lazy as BS
9import System.Exit
10import System.Exit
10import Data.Word
11import Data.Word
@@ -20,8 +21,8 @@ main = do
20testList :: Test
21testList :: Test
21testList = TestList [
22testList = TestList [
22 testSubGraphToFirstAncestorBasic,
23 testSubGraphToFirstAncestorBasic,
23− testSubGraphToFirstAncestorSnipBranch
24+ testSubGraphToFirstAncestorSnipBranch,
24− --testSelectedBranchMerge
25+ testSelectedBranchMerge
25 ]
26 ]
26
27
27-- | Create a transaction graph with two branches and no changes between them.
28-- | Create a transaction graph with two branches and no changes between them.
@@ -80,6 +81,7 @@ testSubGraphToFirstAncestorBasic = TestCase $ do
80 subgraph <- assertEither $ subGraphToFirstCommonAncestor graph (transactionHeadsForGraph graph) emptyTransactionGraph transA transB
81 subgraph <- assertEither $ subGraphToFirstCommonAncestor graph (transactionHeadsForGraph graph) emptyTransactionGraph transA transB
81 assertEqual "no graph changes" subgraph graph
82 assertEqual "no graph changes" subgraph graph
82
83
84+-- | Test that a branch anchored at the root transaction is removed when using the first ancestor function.
83testSubGraphToFirstAncestorSnipBranch :: Test
85testSubGraphToFirstAncestorSnipBranch :: Test
84testSubGraphToFirstAncestorSnipBranch = TestCase $ do
86testSubGraphToFirstAncestorSnipBranch = TestCase $ do
85 baseGraph <- basicTransactionGraph
87 baseGraph <- basicTransactionGraph
@@ -87,21 +89,19 @@ testSubGraphToFirstAncestorSnipBranch = TestCase $ do
87 transB <- assertMaybe (transactionForHead "branchB" baseGraph) "failed to get branchB"
89 transB <- assertMaybe (transactionForHead "branchB" baseGraph) "failed to get branchB"
88 rootTrans <- assertEither (transactionForUUID (fakeUUID 1) baseGraph)
90 rootTrans <- assertEither (transactionForUUID (fakeUUID 1) baseGraph)
89 (_, graph) <- addTransaction "branchC" (fakeUUID 12) (transactionContext transA) rootTrans baseGraph
91 (_, graph) <- addTransaction "branchC" (fakeUUID 12) (transactionContext transA) rootTrans baseGraph
90− subgraph <- assertEither $ subGraphToFirstCommonAncestor graph (transactionHeadsForGraph graph) emptyTransactionGraph transA transB
92+ subgraph <- assertEither $ subGraphToFirstCommonAncestor graph (transactionHeadsForGraph baseGraph) emptyTransactionGraph transA transB
91 assertGraph subgraph
93 assertGraph subgraph
92− -- putStrLn $ showGraphStructure graph
93− putStrLn $ showGraphStructure subgraph
94− putStrLn $ showGraphStructure baseGraph
95− assertEqual "failed to snip branch" (transactionHeadsForGraph subgraph) (transactionHeadsForGraph baseGraph)
94+ assertEqual "failed to snip branch" baseGraph subgraph
96− pure ()
97
95
98testSelectedBranchMerge :: Test
96testSelectedBranchMerge :: Test
99testSelectedBranchMerge = TestCase $ do
97testSelectedBranchMerge = TestCase $ do
100 graph <- basicTransactionGraph
98 graph <- basicTransactionGraph
101 assertGraph graph
99 assertGraph graph
102− -- putStrLn (showGraphStructure graph)
103
100
104 let eGraph' = mergeTransactions (fakeUUID 3) (fakeUUID 10) (SelectedBranchMergeStrategy "branchA") ("branchA", "branchB") graph
101 let eGraph' = mergeTransactions (fakeUUID 3) (fakeUUID 10) (SelectedBranchMergeStrategy "branchA") ("branchA", "branchB") graph
105− (_, graph') <- assertEither eGraph'
102+ (DisconnectedTransaction _ mergedContext, graph') <- assertEither eGraph'
106 assertGraph graph'
103 assertGraph graph'
107− pure ()
104+ --validate that the branchB was removed
105+ rootTrans <- assertEither $ transactionForUUID (fakeUUID 1) graph'
106+ assertEqual "head still available" (transactionForHead "branchB" graph') Nothing
107+ --assertEqual "bad merge" mergedContext (transactionContext rootTrans)