c6c63fe · project-m36 · git.iko.soy

git.iko.soy/project-m36

transaction graph merge compilation checkpoint

commitc6c63feaf89c139d45bbbabf9eb44c084ebe340c authorAgentM <agentm@themactionfaction.com> dateFri 10 Jun 2016, 16:01 (10 years ago) parent8448917

4 files changed+111−1

compare with master

unifiedsplit

ProjectM36/Base.hs+9 ProjectM36/Error.hs+10−1 ProjectM36/TransactionGraph.hs+72 TutorialD/Interpreter/TransactionGraphOperator.hs+20

ProjectM36/Base.hs+9

@@ -470,3 +470,12 @@ data AttributeExpr = AttributeAndTypeNameExpr AttributeName TypeConstructor |

470470

471471data TupleExpr = TupleExpr (M.Map AttributeName AtomExpr)

472472 deriving (Eq, Show, Generic, Binary)

473+

474+data MergeStrategy =

475+ -- | After a union merge, the merge transaction is a result of union'ing relvars of the same name, introducing all uniquely-named relvars, union of constraints, union of atom functions, notifications, and types (unless the names and definitions collide, e.g. two types of the same name with different definitions)

476+ UnionMergeStrategy |

477+ -- | Similar to a union merge, but, on conflict, prefer the unmerged section (relvar, function, etc.) from the branch named as the argument.

478+ UnionPreferMergeStrategy HeadName |

479+ -- | Similar to the our/theirs merge strategy in git, the merge transaction's context is identical to that of the last transaction in the selected branch.

480+ SelectedBranchMergeStrategy HeadName

481+ deriving (Eq, Show, Binary, Generic)

ProjectM36/Error.hs+10−1

@@ -26,6 +26,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

2626 | InclusionDependencyNameNotInUseError IncDepName

2727 | ParseError T.Text

2828 | PredicateExpressionError T.Text

29+ | NoCommonTransactionAncestorError U.UUID U.UUID

2930 | NoSuchTransactionError U.UUID

3031 | NoSuchHeadNameError HeadName

3132 | TransactionIsNotAHeadError U.UUID

@@ -60,6 +61,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

6061 | NotificationNameNotInUseError NotificationName

6162 | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra

6263 | ExportError T.Text

64+ | MergeTransactionError MergeError

6365 | MultipleErrors [RelationalError]

6466 deriving (Show,Eq,Generic,Binary,Typeable)

6567

@@ -75,4 +77,11 @@ someErrors [] = error "no errors in error list: function misuse"

7577someErrors errList = if length errList == 1 then

7678 head errList

7779 else

78− MultipleErrors errList

80+ MultipleErrors errList

81+

82+data MergeError = SelectedHeadMismatchMergeError |

83+ StrategyViolatesConstraintMergeError |

84+ DisconnectedTransactionNotAMergeHeadError U.UUID

85+ deriving (Show, Eq, Generic, Binary, Typeable)

86+

87+instance NFData MergeError where rnf = genericRnf

ProjectM36/TransactionGraph.hs+72

@@ -21,12 +21,14 @@ import Data.Binary

2121data TransactionGraphOperator = JumpToHead HeadName |

2222 JumpToTransaction U.UUID |

2323 Branch HeadName |

24+ MergeTransactions MergeStrategy HeadName HeadName |

2425 Commit |

2526 Rollback

2627 deriving (Eq, Show, Binary, Generic)

2728

2829data ROTransactionGraphOperator = ShowGraph

2930

31+

3032bootstrapTransactionGraph :: U.UUID -> DatabaseContext -> TransactionGraph

3133bootstrapTransactionGraph freshUUID context = TransactionGraph bootstrapHeads bootstrapTransactions

3234 where

@@ -206,6 +208,36 @@ evalGraphOp _ (DisconnectedTransaction parentUUID _) graph Rollback = case trans

206208 Right parentTransaction -> Right (newDiscon, graph)

207209 where

208210 newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)

211+

212+-- a successful merge should remove a head

213+evalGraphOp newUUID (DisconnectedTransaction parentUUID _) graph (MergeTransactions mergeStrategy headNameA headNameB) = do

214+ let transactionForHeadErr name = case transactionForHead name graph of

215+ Nothing -> Left (NoSuchHeadNameError name)

216+ Just t -> Right t

217+ transA <- transactionForHeadErr headNameA

218+ transB <- transactionForHeadErr headNameB

219+ let transAid = transactionUUID transA

220+ transBid = transactionUUID transB

221+ headNameToDelete <- if parentUUID == transAid then

222+ pure headNameB

223+ else if parentUUID == transBid then

224+ pure headNameA

225+ else

226+ Left (MergeTransactionError (DisconnectedTransactionNotAMergeHeadError parentUUID))

227+

228+ disconParent <- transactionForUUID parentUUID graph

229+ subGraph <- subGraphToFirstCommonAncestor graph emptyTransactionGraph transA transB

230+ case mergeTransactions newUUID mergeStrategy subGraph (transA, transB) of

231+ Left err -> Left (MergeTransactionError err)

232+ Right mergedTrans -> case headNameForTransaction disconParent graph of

233+ Nothing -> Left (TransactionIsNotAHeadError parentUUID)

234+ Just headName -> do

235+ let newDiscon = newDisconnectedTransaction mergedTransUUID (transactionContext mergedTrans)

236+ mergedTransUUID = transactionUUID mergedTrans

237+ (_, newGraph) <- addDisconnectedTransaction mergedTransUUID headName newDiscon graph

238+ let newGraph' = TransactionGraph newHeads (transactionsForGraph newGraph)

239+ newHeads = M.delete headNameToDelete (transactionHeadsForGraph newGraph)

240+ pure (newDiscon, newGraph')

209241

210242--present a transaction graph as a relation showing the uuids, parentuuids, and flag for the current location of the disconnected transaction

211243graphAsRelation :: DisconnectedTransaction -> TransactionGraph -> Either RelationalError Relation

@@ -249,3 +281,43 @@ evalROGraphOp discon graph ShowGraph = do

249281 return graphRel

250282-}

251283

284+--execute the merge strategy against the transactions, returning a new transaction to be added to the graph

285+-- a successful merge should also remove a head

286+mergeTransactions :: U.UUID -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

287+mergeTransactions newUUID (SelectedBranchMergeStrategy selectedBranch) graph t2@(trans1, trans2) = do

288+ selectedTrans <- validateHeadName selectedBranch graph t2

289+ pure $ Transaction newUUID (MergeTransactionInfo (transactionUUID trans1) (transactionUUID trans2) S.empty) (transactionContext selectedTrans)

290+

291+mergeTransactions newUUID UnionMergeStrategy graph t2 = undefined

292+

293+

294+-- | Returns the correct Transaction for the branch name in the graph and ensures that it is one of the two transaction arguments in the tuple.

295+validateHeadName :: HeadName -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

296+validateHeadName headName graph (t1, t2) = case transactionForHead headName graph of

297+ Nothing -> Left SelectedHeadMismatchMergeError

298+ Just trans -> if trans /= t1 && trans /= t2 then

299+ Left SelectedHeadMismatchMergeError

300+ else

301+ Right trans

302+

303+-- | Return the common ancestor of two transactions. When looking for the first common ancestor, we don't need to search both parents of a merge transaction because the merge must have diverged from a common ancestor anyway, so we arbitrarily just search one of the parents of a merge transaction. Technically, due to merge transactions, this may not actually return the first common ancestor, but it should be pretty close. The incoming subgraph's heads remain unchanged in the return value.

304+subGraphToFirstCommonAncestor :: TransactionGraph -> TransactionGraph -> Transaction -> Transaction -> Either RelationalError TransactionGraph

305+subGraphToFirstCommonAncestor origGraph subGraph trans1 trans2 = do

306+ let t1id = transactionUUID trans1

307+ t2id = transactionUUID trans2

308+ if t1id == t2id then

309+ Right subGraph

310+ else if U.null t1id || U.null t2id then --no common ancestor

311+ Left (NoCommonTransactionAncestorError t1id t2id)

312+ else do

313+ parentTrans1 <- oneParent trans1

314+ parentTrans2 <- oneParent trans2

315+ --add transactions to graph

316+ let subGraph' = TransactionGraph headNames newTrans

317+ headNames = transactionHeadsForGraph subGraph

318+ newTrans = S.union (transactionsForGraph subGraph) (S.fromList [parentTrans1, parentTrans2])

319+ subGraphToFirstCommonAncestor origGraph subGraph' parentTrans1 parentTrans2

320+ where

321+ oneParent (Transaction _ (TransactionInfo parentId _) _) = transactionForUUID parentId origGraph

322+ oneParent (Transaction _ (MergeTransactionInfo parentId _ _) _) = transactionForUUID parentId origGraph

323+

TutorialD/Interpreter/TransactionGraphOperator.hs+20

@@ -42,6 +42,25 @@ showGraphP :: Parser ROTransactionGraphOperator

4242showGraphP = do

4343 reservedOp ":showgraph"

4444 return $ ShowGraph

45+

46+mergeTransactionStrategyP :: Parser MergeStrategy

47+mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>

48+ (do

49+ reserved "selectedbranch"

50+ branch <- identifier

51+ pure (SelectedBranchMergeStrategy (T.pack branch))) <|>

52+ (do

53+ reserved "unionpreferbranch"

54+ branch <- identifier

55+ pure (UnionPreferMergeStrategy (T.pack branch)))

56+

57+mergeTransactionsP :: Parser TransactionGraphOperator

58+mergeTransactionsP = do

59+ reservedOp ":mergetrans"

60+ strategy <- mergeTransactionStrategyP

61+ headA <- identifier

62+ headB <- identifier

63+ pure (MergeTransactions strategy (T.pack headA) (T.pack headB))

4564

4665transactionGraphOpP :: Parser TransactionGraphOperator

4766transactionGraphOpP = do

@@ -50,6 +69,7 @@ transactionGraphOpP = do

5069 <|> branchTransactionP

5170 <|> commitTransactionP

5271 <|> rollbackTransactionP

72+ <|> mergeTransactionsP

5373

5474roTransactionGraphOpP :: Parser ROTransactionGraphOperator

5575roTransactionGraphOpP = showGraphP