a2d81ee · project-m36 · git.iko.soy

git.iko.soy/project-m36

WIP compilation checkpoint for new automerge method

needs ProjectM36.Client glue

commita2d81ee8dd7c981b6ea92a271655dddf0a350304 authorAgentM <agentm@themactionfaction.com> dateThu 20 Jul 2017, 16:58 (9 years ago) parent8573aed

2 files changed+21−30

compare with master

unifiedsplit

src/lib/ProjectM36/Client.hs+5−13 src/lib/ProjectM36/TransactionGraph.hs+16−17

src/lib/ProjectM36/Client.hs+5−13

@@ -49,7 +49,6 @@ module ProjectM36.Client

4949 callTestTimeout_,

5050 RelationCardinality(..),

5151 TransactionGraphOperator(..),

52− CommitOption(..),

5352 transactionGraph_,

5453 disconnectedTransaction_,

5554 TransGraphRelationalExpr,

@@ -615,7 +614,7 @@ executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excMaybe $ do

615614 graphTvar = ipTransactionGraph conf

616615 mLockFileH = ipLocks conf

617616 lockHandler body = case graphExpr of

618− Commit _ -> case mLockFileH of

617+ Commit -> case mLockFileH of

619618 Nothing -> body False

620619 Just (lockFileH, lockMVar) -> let acquireLocks = do

621620 lastWrittenDigest <- takeMVar lockMVar

@@ -654,19 +653,12 @@ executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excMaybe $ do

654653 case eRefreshedGraph of

655654 Left err -> pure (Left (DatabaseLoadError err))

656655 Right refreshedGraph -> do

657− if not (isDirty session) && graphExpr == Commit IgnoreEmptyCommitOption then

658− pure (Right (M.empty, [], oldGraph))

659− else do

660656 eGraph <- executeGraphExprSTM_ dbWrittenByOtherProcess freshId sessionId session sessions graphExpr refreshedGraph graphTvar

661657 case eGraph of

662658 Left err -> pure (Left err)

663659 Right newGraph -> do

664660 --handle commit

665− if not (isDirty session) && graphExpr == Commit ForbidEmptyCommitOption then

666− pure (Left EmptyCommitError)

667− else if not (isDirty session) && graphExpr == Commit IgnoreEmptyCommitOption then

668− pure (Right (M.empty, [], newGraph))

669− else if isCommit graphExpr then do

661+ if isCommit graphExpr then do

670662 case transactionForId (Sess.parentId session) oldGraph of

671663 Left err -> pure $ Left err

672664 Right previousTrans -> do

@@ -716,9 +708,9 @@ executeSchemaExpr sessionId (InProcessConnection conf) schemaExpr = atomically $

716708executeSchemaExpr sessionId conn@(RemoteProcessConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)

717709

718710-- | After modifying a session, 'commit' the transaction to the transaction graph at the head which the session is referencing. This will also trigger checks for any notifications which need to be propagated.

719−commit :: SessionId -> Connection -> CommitOption -> IO (Maybe RelationalError)

720−commit sessionId conn@(InProcessConnection _) cOpt = executeGraphExpr sessionId conn (Commit cOpt)

721−commit sessionId conn@(RemoteProcessConnection _) cOpt = remoteCall conn (ExecuteGraphExpr sessionId (Commit cOpt))

711+commit :: SessionId -> Connection -> IO (Maybe RelationalError)

712+commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit

713+commit sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)

722714

723715sendNotifications :: [ProcessId] -> LocalNode -> EvaluatedNotifications -> IO ()

724716sendNotifications pids localNode nots = mapM_ sendNots pids

src/lib/ProjectM36/TransactionGraph.hs+16−17

@@ -17,6 +17,7 @@ import GHC.Generics

1717import Data.Binary

1818import ProjectM36.TransactionGraph.Merge

1919import Data.Either (lefts, rights, isRight)

20+import Data.Monoid

2021

2122-- | Record a lookup for a specific transaction in the graph.

2223data TransactionIdLookup = TransactionIdLookup TransactionId |

@@ -28,11 +29,6 @@ data TransactionIdHeadBacktrack = TransactionIdHeadParentBacktrack Int | -- git

2829 TransactionIdHeadBranchBacktrack Int -- git ^: walk back one parent level to the nth arbitrarily-chosen parent

2930 deriving (Show, Eq, Binary, Generic)

3031

31−data EmptyCommitOption = AllowEmptyCommitOption | -- allow empty commit and add it to the graph

32− ForbidEmptyCommitOption | --return error on empty commit- probably the safest option

33− IgnoreEmptyCommitOption -- don't add the commit and don't add it to the graph (no-op)

34− deriving (Eq, Show, Binary, Generic)

35−

3632data MergeCommitOption = NoMergeCommitOption | --no special handling

3733 AutoMergeToHeadCommitOption -- branch, merge to current branch, commit- all-in-one in order to take advantage of atomic STM

3834

@@ -42,12 +38,12 @@ data TransactionGraphOperator = JumpToHead HeadName |

4238 Branch HeadName |

4339 DeleteBranch HeadName |

4440 MergeTransactions MergeStrategy HeadName HeadName |

45− Commit EmptyCommitOption MergeCommitOption |

41+ Commit |

4642 Rollback

4743 deriving (Eq, Show, Binary, Generic)

4844

4945isCommit :: TransactionGraphOperator -> Bool

50−isCommit (Commit _) = True

46+isCommit Commit = True

5147isCommit _ = False

5248

5349data ROTransactionGraphOperator = ShowGraph

@@ -232,17 +228,9 @@ evalGraphOp newId (DisconnectedTransaction parentId schemas' _) graph (Branch ne

232228 Left err -> Left err

233229 Right (_, newGraph) -> Right (newDiscon, newGraph)

234230

235−--a version of commit which adds the discon to a temporary branch and attempts to merge it to the head and commit it- deletes the merge branch so that the newTransId appears to be for a fast-forwardded commit

236−--this emulates a rebase based on the transaction merge code

237−evalGraphOp newTransId discon@(DisconnectedTransaction parentId schema' _) graph cmd@(Commit _ AutoMergeToHeadOption) = do

238− parentTrans <- transactionForId parentId graph

239− let tempBranchName = "mergebranch_" <> U.toText newTransId

240− evalGraphOp ? (Branch "junk

241−

242−

243231-- add the disconnected transaction to the graph

244232-- affects graph and disconnectedtransaction- the new disconnectedtransaction's parent is the freshly committed transaction

245−evalGraphOp newTransId discon@(DisconnectedTransaction parentId schemas' _) graph (Commit _) = case transactionForId parentId graph of

233+evalGraphOp newTransId discon@(DisconnectedTransaction parentId schemas' _) graph Commit = case transactionForId parentId graph of

246234 Left err -> Left err

247235 Right parentTransaction -> case headNameForTransaction parentTransaction graph of

248236 Nothing -> Left $ TransactionIsNotAHeadError parentId

@@ -491,4 +479,15 @@ backtrackGraph graph currentTid (TransactionIdHeadBranchBacktrack steps) = do

491479 Left (ParentCountTraversalError (S.size parents) steps)

492480 else

493481 pure (S.elemAt (steps - 1) parents)

494−

482+

483+-- | Create a temporary branch for commit, merge the result to head, delete the temporary branch. This is useful to atomically commit a transaction, avoiding a TransactionIsNotHeadError but trading it for a potential MergeError.

484+autoMergeToHead :: (TransactionId, TransactionId) -> DisconnectedTransaction -> HeadName -> MergeStrategy -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

485+autoMergeToHead (tempTransId, newCommitTransId) discon mergeToHeadName strat graph = do

486+ let tempBranchName = "mergebranch_" <> U.toText tempTransId

487+ --create the temp branch

488+ (discon', graph') <- evalGraphOp tempTransId discon graph (Branch tempBranchName)

489+ --create the merge

490+ (discon'', graph'') <- evalGraphOp newCommitTransId discon' graph' (MergeTransactions strat tempBranchName mergeToHeadName)

491+ --delete the temp branch

492+ evalGraphOp newCommitTransId discon'' graph'' (DeleteBranch tempBranchName)

493+