ac5c32f · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add union merge implementation

ac5c32fAgentM10 years ago

ProjectM36/Base.hs+6−3

compare with master

unifiedsplit

@@ -309,10 +309,13 @@ data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructo

309 DataConstructorDefTypeVarNameArg TypeVarName

310 deriving (Show, Generic, Binary, Eq, NFData)

311

312+type InclusionDependencies = M.Map IncDepName InclusionDependency

313+type RelationVariables = M.Map RelVarName Relation

314+

312-- | The DatabaseContext is a snapshot of a database's evolving state and contains everything a database client can change over time.

315-- | The DatabaseContext is a snapshot of a database's evolving state and contains everything a database client can change over time.

313data DatabaseContext = DatabaseContext {

316data DatabaseContext = DatabaseContext {

314− inclusionDependencies :: M.Map IncDepName InclusionDependency,

317+ inclusionDependencies :: InclusionDependencies,

315− relationVariables :: M.Map RelVarName Relation,

318+ relationVariables :: RelationVariables,

316 atomFunctions :: AtomFunctions,

319 atomFunctions :: AtomFunctions,

317 notifications :: Notifications,

320 notifications :: Notifications,

318 typeConstructorMapping :: TypeConstructorMapping

321 typeConstructorMapping :: TypeConstructorMapping

@@ -389,7 +392,7 @@ data TransactionInfo = TransactionInfo UUID (S.Set UUID) | -- 1 parent + n child

389 deriving(Show, Generic)

392 deriving(Show, Generic)

390

393

391instance Binary TransactionInfo

394instance Binary TransactionInfo

392−

395+

393-- | Every set of modifications made to the database are atomically committed to the transaction graph as a transaction.

396-- | Every set of modifications made to the database are atomically committed to the transaction graph as a transaction.

394data Transaction = Transaction UUID TransactionInfo DatabaseContext -- self uuid

397data Transaction = Transaction UUID TransactionInfo DatabaseContext -- self uuid

395 deriving (Show, Generic)

398 deriving (Show, Generic)

ProjectM36/Error.hs+4−1

@@ -83,7 +83,10 @@ someErrors errList = if length errList == 1 then

84data MergeError = SelectedHeadMismatchMergeError |

85 StrategyViolatesConstraintMergeError |

86− DisconnectedTransactionNotAMergeHeadError U.UUID

86+ DisconnectedTransactionNotAMergeHeadError U.UUID |

87+ StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.

88+ StrategyViolatesRelationVariableMergeError |

89+ StrategyViolatesTypeConstructorMergeError

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

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

89instance NFData MergeError where rnf = genericRnf

92instance NFData MergeError where rnf = genericRnf

ProjectM36/Transaction.hs+10−5

@@ -22,9 +22,14 @@ transactionSetChildren t@(Transaction _ (TransactionInfo pUUID _) _) childIds =

22transactionSetChildren t@(Transaction _ (MergeTransactionInfo pUUID1 pUUID2 _) _) childIds = Transaction (transactionUUID t) (MergeTransactionInfo pUUID1 pUUID2 childIds) (transactionContext t)

24-- | Return the same transaction but referencing only the specific child transactions. This is useful when traversing a graph and returning a subgraph. This doesn't filter parent transactions because it assumes a head-to-root traversal.

25−filterChildrenFromTransactionInfo :: TransactionInfo -> S.Set U.UUID -> TransactionInfo

25+filterTransactionInfoTransactions :: S.Set U.UUID -> TransactionInfo -> TransactionInfo

26−filterChildrenFromTransactionInfo (TransactionInfo parentId childIds) filterIds = TransactionInfo parentId (S.intersection childIds filterIds)

26+filterTransactionInfoTransactions filterIds (TransactionInfo parentId childIds) = TransactionInfo (filterParent parentId filterIds) (S.intersection childIds filterIds)

27−filterChildrenFromTransactionInfo (MergeTransactionInfo parentIdA parentIdB childIds) filterIds = MergeTransactionInfo parentIdA parentIdB (S.intersection childIds filterIds)

27+filterTransactionInfoTransactions filterIds (MergeTransactionInfo parentIdA parentIdB childIds) = MergeTransactionInfo (filterParent parentIdA filterIds) (filterParent parentIdB filterIds) (S.intersection childIds filterIds)

28+

29+filterParent :: U.UUID -> S.Set U.UUID -> U.UUID

30+filterParent parentId validIds = if S.member parentId validIds then parentId else U.nil

31+

32+-- | Remove any child or parent transaction references not in the valud UUID set.

33+filterTransaction :: S.Set U.UUID -> Transaction -> Transaction

34+filterTransaction filterIds (Transaction selfId tInfo context) = Transaction selfId (filterTransactionInfoTransactions filterIds tInfo) context

29−filterChildTransactions :: Transaction -> S.Set U.UUID -> Transaction

30−filterChildTransactions (Transaction selfId tInfo context) filterIds = Transaction selfId (filterChildrenFromTransactionInfo tInfo filterIds) context

ProjectM36/TransactionGraph.hs+24−6

@@ -16,6 +16,7 @@ import Control.Monad

16import qualified Data.Text as T

17import GHC.Generics

18import Data.Binary

19+import ProjectM36.TransactionGraph.Merge

19import Data.Either (lefts, rights)

20import Data.Either (lefts, rights)

20--import Debug.Trace

21--import Debug.Trace

@@ -263,8 +264,18 @@ createMergeTransaction newUUID (SelectedBranchMergeStrategy selectedBranch) grap

263 selectedTrans <- validateHeadName selectedBranch graph t2

264 selectedTrans <- validateHeadName selectedBranch graph t2

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

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

265

266

267+-- merge functions, relvars, individually

266−createMergeTransaction newUUID UnionMergeStrategy graph t2 = undefined

268+createMergeTransaction newUUID UnionMergeStrategy _ (t1,t2) = do

267−

269+ let contextA = transactionContext t1

270+ contextB = transactionContext t2

271+ incDeps <- unionMergeMaps PreferNeither (inclusionDependencies contextA) (inclusionDependencies contextB)

272+ relVars <- unionMergeRelVars PreferNeither (relationVariables contextA) (relationVariables contextB)

273+ atomFuncs <- unionMergeAtomFunctions PreferNeither (atomFunctions contextA) (atomFunctions contextB)

274+ notifs <- unionMergeMaps PreferNeither (notifications contextA) (notifications contextB)

275+ types <- unionMergeTypeConstructorMapping PreferNeither (typeConstructorMapping contextA) (typeConstructorMapping contextB)

276+ pure (Transaction newUUID (MergeTransactionInfo (transactionUUID t1) (transactionUUID t2) S.empty) (DatabaseContext incDeps relVars atomFuncs notifs types))

277+

278+-- merge function, relvars, but, on error, just take the component from the preferred branch

268createMergeTransaction newUUID (UnionPreferMergeStrategy preferHead) graph t2 = undefined

279createMergeTransaction newUUID (UnionPreferMergeStrategy preferHead) graph t2 = undefined

269

280

270-- | 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.

281-- | 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.

@@ -334,14 +345,13 @@ mergeTransactions newUUID parentUUID mergeStrategy (headNameA, headNameB) graph

334 Just t -> Right t

345 Just t -> Right t

335 transA <- transactionForHeadErr headNameA

346 transA <- transactionForHeadErr headNameA

336 transB <- transactionForHeadErr headNameB

347 transB <- transactionForHeadErr headNameB

337− let transAid = transactionUUID transA

338− transBid = transactionUUID transB

339

348

340 disconParent <- transactionForUUID parentUUID graph

349 disconParent <- transactionForUUID parentUUID graph

341 let subHeads = M.filterWithKey (\k _ -> elem k [headNameA, headNameB]) (transactionHeadsForGraph graph)

350 let subHeads = M.filterWithKey (\k _ -> elem k [headNameA, headNameB]) (transactionHeadsForGraph graph)

342 subGraph <- subGraphOfFirstCommonAncestor graph subHeads transA transB S.empty

351 subGraph <- subGraphOfFirstCommonAncestor graph subHeads transA transB S.empty

352+ subGraph' <- filterSubGraph subGraph subHeads

343

353

344− case createMergeTransaction newUUID mergeStrategy subGraph (transA, transB) of

354+ case createMergeTransaction newUUID mergeStrategy subGraph' (transA, transB) of

345 Left err -> Left (MergeTransactionError err)

355 Left err -> Left (MergeTransactionError err)

346 Right mergedTrans -> case headNameForTransaction disconParent graph of

356 Right mergedTrans -> case headNameForTransaction disconParent graph of

347 Nothing -> Left (TransactionIsNotAHeadError parentUUID)

357 Nothing -> Left (TransactionIsNotAHeadError parentUUID)

@@ -365,4 +375,12 @@ showGraphStructureX :: TransactionGraph -> String

365showGraphStructureX graph@(TransactionGraph heads transSet) = headsInfo ++ S.foldr folder "" transSet

375showGraphStructureX graph@(TransactionGraph heads transSet) = headsInfo ++ S.foldr folder "" transSet

366 where

376 where

367 folder trans acc = acc ++ showTransactionStructureX trans graph ++ "\n"

377 folder trans acc = acc ++ showTransactionStructureX trans graph ++ "\n"

368− headsInfo = show $ M.map transactionUUID heads

378+ headsInfo = show $ M.map transactionUUID heads

379+

380+-- | After splicing out a subgraph, run it through this function to remove references to transactions which are not in the subgraph.

381+filterSubGraph :: TransactionGraph -> TransactionHeads -> Either RelationalError TransactionGraph

382+filterSubGraph graph heads = Right $ TransactionGraph newHeads newTransSet

383+ where

384+ validIds = S.map transactionUUID (transactionsForGraph graph)

385+ newTransSet = S.map (filterTransaction validIds) (transactionsForGraph graph)

386+ newHeads = M.map (filterTransaction validIds) heads

test/TransactionGraph/Merge.hs+7−1

@@ -134,4 +134,10 @@ testSelectedBranchMerge = TestCase $ do

134 rootTrans <- assertEither $ transactionForUUID (fakeUUID 1) graph''

135 branchBTrans <- assertMaybe (transactionForHead "branchB" graph'') "failed to find branchB head"

136 assertEqual "head of merged transaction was removed" (transactionUUID branchBTrans) (fakeUUID 3)

137− --assertEqual "bad merge" mergedContext (transactionContext rootTrans)

137+ --assertEqual "bad merge" mergedContext (transactionContext rootTrans)

138+

139+testUnionPreferMergeStrategy :: Test

140+testUnionPreferMergeStrategy = TestCase $ undefined

141+

142+testUnionMergeStrategy :: Test

143+testUnionMergeStrategy = TestCase $ undefined