c6c63fe · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

transaction graph merge compilation checkpoint

c6c63feAgentM10 years ago

ProjectM36/Base.hs+9

compare with master

unifiedsplit

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

470

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

472 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)

26 | InclusionDependencyNameNotInUseError IncDepName

27 | ParseError T.Text

28 | PredicateExpressionError T.Text

29+ | NoCommonTransactionAncestorError U.UUID U.UUID

29 | NoSuchTransactionError U.UUID

30 | NoSuchTransactionError U.UUID

30 | NoSuchHeadNameError HeadName

31 | NoSuchHeadNameError HeadName

31 | TransactionIsNotAHeadError U.UUID

32 | TransactionIsNotAHeadError U.UUID

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

60 | NotificationNameNotInUseError NotificationName

61 | NotificationNameNotInUseError NotificationName

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

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

62 | ExportError T.Text

63 | ExportError T.Text

64+ | MergeTransactionError MergeError

63 | MultipleErrors [RelationalError]

65 | MultipleErrors [RelationalError]

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

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

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

75someErrors errList = if length errList == 1 then

77someErrors errList = if length errList == 1 then

76 head errList

78 head errList

77 else

79 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

21data TransactionGraphOperator = JumpToHead HeadName |

22 JumpToTransaction U.UUID |

23 Branch HeadName |

24+ MergeTransactions MergeStrategy HeadName HeadName |

24 Commit |

25 Commit |

25 Rollback

26 Rollback

26 deriving (Eq, Show, Binary, Generic)

27 deriving (Eq, Show, Binary, Generic)

28data ROTransactionGraphOperator = ShowGraph

29data ROTransactionGraphOperator = ShowGraph

31+

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

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

31bootstrapTransactionGraph freshUUID context = TransactionGraph bootstrapHeads bootstrapTransactions

33bootstrapTransactionGraph freshUUID context = TransactionGraph bootstrapHeads bootstrapTransactions

32 where

34 where

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

206 Right parentTransaction -> Right (newDiscon, graph)

208 Right parentTransaction -> Right (newDiscon, graph)

207 where

209 where

208 newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)

210 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')

209

241

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

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

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

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

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

249 return graphRel

281 return graphRel

250-}

282-}

251

283

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

42showGraphP = do

43 reservedOp ":showgraph"

44 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))

46transactionGraphOpP :: Parser TransactionGraphOperator

65transactionGraphOpP :: Parser TransactionGraphOperator

47transactionGraphOpP = do

66transactionGraphOpP = do

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

50 <|> branchTransactionP

69 <|> branchTransactionP

51 <|> commitTransactionP

70 <|> commitTransactionP

52 <|> rollbackTransactionP

71 <|> rollbackTransactionP

72+ <|> mergeTransactionsP

54roTransactionGraphOpP :: Parser ROTransactionGraphOperator

74roTransactionGraphOpP :: Parser ROTransactionGraphOperator

55roTransactionGraphOpP = showGraphP

75roTransactionGraphOpP = showGraphP