b38932d · project-m36 · git.iko.soy

git.iko.soy/project-m36

replace UUID usage with more information TransactionId name wherever possible

resolves #22

commitb38932d164ad0472045d48e7d0d38c698f4a2d23 authorAgentM <agentm@themactionfaction.com> dateThu 21 Jul 2016, 12:36 (10 years ago) parent213787d

16 files changed+229−231

compare with master

unifiedsplit

ProjectM36/Base.hs+8−6 ProjectM36/Client.hs+28−29 ProjectM36/Error.hs+12−13 ProjectM36/Server.hs+1−1 ProjectM36/Server/EntryPoints.hs+4−5 ProjectM36/Server/RemoteCallTypes.hs+2−3 ProjectM36/Session.hs+2−2 ProjectM36/Transaction.hs+14−14 ProjectM36/Transaction/Persist.hs+11−12 ProjectM36/TransactionGraph.hs+88−87 ProjectM36/TransactionGraph/Persist.hs+23−23 ProjectM36/TransactionGraph/Show.hs+2−2 ProjectM36/TransactionGraph/Show/Dot.hs+2−2 test/Server/Main.hs+9−9 test/TransactionGraph/Merge.hs+16−16 test/TransactionGraph/Persist.hs+7−7

ProjectM36/Base.hs+8−6

@@ -387,23 +387,25 @@ transactionHeadsForGraph :: TransactionGraph -> TransactionHeads

387387transactionHeadsForGraph (TransactionGraph heads _) = heads

388388

389389-- | Every transaction has context-specific information attached to it.

390−data TransactionInfo = TransactionInfo UUID (S.Set UUID) | -- 1 parent + n children

391− MergeTransactionInfo UUID UUID (S.Set UUID) -- 2 parents, n children

390+data TransactionInfo = TransactionInfo TransactionId (S.Set TransactionId) | -- 1 parent + n children

391+ MergeTransactionInfo TransactionId TransactionId (S.Set TransactionId) -- 2 parents, n children

392392 deriving(Show, Generic)

393393

394394instance Binary TransactionInfo

395395

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

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

397+type TransactionId = UUID

398+

399+data Transaction = Transaction TransactionId TransactionInfo DatabaseContext -- self uuid

398400 deriving (Show, Generic)

399401

400402--instance Binary Transaction

401403

402404-- | The disconnected transaction represents an in-progress workspace used by sessions before changes are committed. This is similar to git's "index". After a transaction is committed, it is "connected" in the transaction graph and can no longer be modified.

403−data DisconnectedTransaction = DisconnectedTransaction UUID DatabaseContext --parentUUID, context

405+data DisconnectedTransaction = DisconnectedTransaction TransactionId DatabaseContext --parentID, context

404406

405−transactionUUID :: Transaction -> UUID

406−transactionUUID (Transaction uuid _ _) = uuid

407+transactionId :: Transaction -> TransactionId

408+transactionId (Transaction tid _ _) = tid

407409

408410transactionContext :: Transaction -> DatabaseContext

409411transactionContext (Transaction _ _ context) = context

ProjectM36/Client.hs+28−29

@@ -22,7 +22,7 @@ module ProjectM36.Client

2222 headName,

2323 remoteDBLookupName,

2424 defaultServerPort,

25− headTransactionUUID,

25+ headTransactionId,

2626 defaultDatabaseName,

2727 defaultRemoteConnectionInfo,

2828 defaultHeadName,

@@ -71,7 +71,6 @@ import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)

7171import Control.Distributed.Process.ManagedProcess.Client (call, safeCall)

7272import Control.Distributed.Process (NodeId(..))

7373

74−import Data.UUID (UUID)

7574import Data.UUID.V4 (nextRandom)

7675import Control.Concurrent.STM

7776import Data.Word

@@ -184,9 +183,9 @@ startNotificationListener callback = do

184183connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)

185184--create a new in-memory database/transaction graph

186185connectProjectM36 (InProcessConnectionInfo strat notificationCallback) = do

187− freshUUID <- nextRandom

186+ freshId <- nextRandom

188187 let bootstrapContext = basicDatabaseContext

189− freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext

188+ freshGraph = bootstrapTransactionGraph freshId bootstrapContext

190189 case strat of

191190 --create date examples graph for now- probably should be empty context in the future

192191 NoPersistence -> do

@@ -245,21 +244,21 @@ connectPersistentProjectM36 strat sync dbdir freshGraph notificationCallback = d

245244 addClientNode conn notificationPid

246245 pure (Right conn)

247246

248−-- | Create a new session at the transaction UUID and return the session's Id.

249−createSessionAtCommit :: UUID -> Connection -> IO (Either RelationalError SessionId)

250−createSessionAtCommit commitUUID conn@(InProcessConnection _ _ _ _) = do

247+-- | Create a new session at the transaction id and return the session's Id.

248+createSessionAtCommit :: TransactionId -> Connection -> IO (Either RelationalError SessionId)

249+createSessionAtCommit commitId conn@(InProcessConnection _ _ _ _) = do

251250 newSessionId <- nextRandom

252251 atomically $ do

253− createSessionAtCommit_ commitUUID newSessionId conn

252+ createSessionAtCommit_ commitId newSessionId conn

254253createSessionAtCommit uuid conn@(RemoteProcessConnection _ _) = remoteCall conn (CreateSessionAtCommit uuid)

255254

256−createSessionAtCommit_ :: UUID -> SessionId -> Connection -> STM (Either RelationalError SessionId)

257−createSessionAtCommit_ commitUUID newSessionId (InProcessConnection _ _ sessions graphTvar) = do

255+createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)

256+createSessionAtCommit_ commitId newSessionId (InProcessConnection _ _ sessions graphTvar) = do

258257 graph <- readTVar graphTvar

259− case transactionForUUID commitUUID graph of

258+ case transactionForId commitId graph of

260259 Left err -> pure (Left err)

261260 Right transaction -> do

262− let freshDiscon = DisconnectedTransaction commitUUID (transactionContext transaction)

261+ let freshDiscon = DisconnectedTransaction commitId (transactionContext transaction)

263262 keyDuplication <- STMMap.lookup newSessionId sessions

264263 case keyDuplication of

265264 Just _ -> pure $ Left (SessionIdInUseError newSessionId)

@@ -276,7 +275,7 @@ createSessionAtHead headn conn@(InProcessConnection _ _ _ graphTvar) = do

276275 graph <- readTVar graphTvar

277276 case transactionForHead headn graph of

278277 Nothing -> pure $ Left (NoSuchHeadNameError headn)

279− Just trans -> createSessionAtCommit_ (transactionUUID trans) newSessionId conn

278+ Just trans -> createSessionAtCommit_ (transactionId trans) newSessionId conn

280279createSessionAtHead headn conn@(RemoteProcessConnection _ _) = remoteCall conn (CreateSessionAtHead headn)

281280

282281-- | Used internally for server connections to keep track of remote nodes for the purpose of sending notifications later.

@@ -338,19 +337,19 @@ executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _) expr =

338337 Right session -> case runState (RE.evalContextExpr expr) (sessionContext session) of

339338 (Just err,_) -> return $ Just err

340339 (Nothing, context') -> do

341− let newDiscon = DisconnectedTransaction (sessionParentUUID session) context'

340+ let newDiscon = DisconnectedTransaction (sessionParentId session) context'

342341 newSession = Session newDiscon

343342 STMMap.insert newSession sessionId sessions

344343 return Nothing

345344executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)

346345

347−executeGraphExprSTM_ :: UUID -> SessionId -> Sessions -> TransactionGraphOperator -> TVar TransactionGraph -> STM (Either RelationalError TransactionGraph)

348−executeGraphExprSTM_ freshUUID sessionId sessions graphExpr graphTvar = do

346+executeGraphExprSTM_ :: TransactionId -> SessionId -> Sessions -> TransactionGraphOperator -> TVar TransactionGraph -> STM (Either RelationalError TransactionGraph)

347+executeGraphExprSTM_ freshId sessionId sessions graphExpr graphTvar = do

349348 graph <- readTVar graphTvar

350349 eSession <- sessionForSessionId sessionId sessions

351350 case eSession of

352351 Left err -> pure $ Left err

353− Right (Session discon) -> case evalGraphOp freshUUID discon graph graphExpr of

352+ Right (Session discon) -> case evalGraphOp freshId discon graph graphExpr of

354353 Left err -> pure $ Left err

355354 Right (discon', graph') -> do

356355 writeTVar graphTvar graph'

@@ -371,19 +370,19 @@ executeCommitExprSTM_ oldContext newContext nodes = do

371370-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.

372371executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (Maybe RelationalError)

373372executeGraphExpr sessionId (InProcessConnection strat clientNodes sessions graphTvar) graphExpr = do

374− freshUUID <- nextRandom

373+ freshId <- nextRandom

375374 manip <- atomically $ do

376375 eSession <- sessionForSessionId sessionId sessions

377376 oldGraph <- readTVar graphTvar

378377 case eSession of

379378 Left err -> pure (Left err)

380− Right (Session (DisconnectedTransaction parentUUID currentContext)) -> do

381− eGraph <- executeGraphExprSTM_ freshUUID sessionId sessions graphExpr graphTvar

379+ Right (Session (DisconnectedTransaction parentId currentContext)) -> do

380+ eGraph <- executeGraphExprSTM_ freshId sessionId sessions graphExpr graphTvar

382381 case eGraph of

383382 Left err -> pure (Left err)

384383 Right newGraph -> do

385384 if graphExpr == Commit then

386− case transactionForUUID parentUUID oldGraph of

385+ case transactionForId parentId oldGraph of

387386 Left err -> pure $ Left err

388387 Right (Transaction _ _ previousContext) -> do

389388 (evaldNots, nodes) <- executeCommitExprSTM_ previousContext currentContext clientNodes

@@ -472,8 +471,8 @@ planForDatabaseContextExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr =

472471-- | Return a relation which represents the current state of the global transaction graph. The attributes are

473472-- * current- boolean attribute representing whether or not the current session references this transaction

474473-- * head- text attribute which is a non-empty 'HeadName' iff the transaction references a head.

475−-- * id- UUID attribute of the transaction

476−-- * parents- a relation-valued attribute which contains a relation of UUIDs which are parent transaction to the transaction

474+-- * id- id attribute of the transaction

475+-- * parents- a relation-valued attribute which contains a relation of transaction ids which are parent transaction to the transaction

477476transactionGraphAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

478477transactionGraphAsRelation sessionId (InProcessConnection _ _ sessions tvar) = do

479478 atomically $ do

@@ -496,15 +495,15 @@ relationVariablesAsRelation sessionId (InProcessConnection _ _ sessions _) = do

496495

497496relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)

498497

499−-- | Returns the UUID for the connection's disconnected transaction committed parent transaction.

500−headTransactionUUID :: SessionId -> Connection -> IO (Maybe UUID)

501−headTransactionUUID sessionId (InProcessConnection _ _ sessions _) = do

498+-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.

499+headTransactionId :: SessionId -> Connection -> IO (Maybe TransactionId)

500+headTransactionId sessionId (InProcessConnection _ _ sessions _) = do

502501 atomically $ do

503502 eSession <- sessionForSessionId sessionId sessions

504503 case eSession of

505504 Left _ -> pure Nothing

506− Right session -> pure $ Just (sessionParentUUID session)

507−headTransactionUUID sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveHeadTransactionUUID sessionId)

505+ Right session -> pure $ Just (sessionParentId session)

506+headTransactionId sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveHeadTransactionId sessionId)

508507

509508headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Maybe HeadName)

510509headNameSTM_ sessionId sessions graphTvar = do

@@ -512,7 +511,7 @@ headNameSTM_ sessionId sessions graphTvar = do

512511 eSession <- sessionForSessionId sessionId sessions

513512 case eSession of

514513 Left _ -> pure $ Nothing

515− Right session -> pure $ case transactionForUUID (sessionParentUUID session) graph of

514+ Right session -> pure $ case transactionForId (sessionParentId session) graph of

516515 Left _ -> Nothing

517516 Right parentTrans -> headNameForTransaction parentTrans graph

518517

ProjectM36/Error.hs+12−13

@@ -2,7 +2,6 @@

22module ProjectM36.Error where

33import ProjectM36.Base

44import qualified Data.Set as S

5−import qualified Data.UUID as U

65import Control.DeepSeq (NFData, rnf)

76import Control.DeepSeq.Generics (genericRnf)

87import GHC.Generics (Generic)

@@ -26,19 +25,19 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

2625 | InclusionDependencyNameNotInUseError IncDepName

2726 | ParseError T.Text

2827 | PredicateExpressionError T.Text

29− | NoCommonTransactionAncestorError U.UUID U.UUID

30− | NoSuchTransactionError U.UUID

28+ | NoCommonTransactionAncestorError TransactionId TransactionId

29+ | NoSuchTransactionError TransactionId

3130 | RootTransactionTraversalError

3231 | HeadNameSwitchingHeadProhibitedError HeadName

3332 | NoSuchHeadNameError HeadName

34− | NewTransactionMayNotHaveChildrenError U.UUID

35− | NewTransactionMissingParentError U.UUID

36− | TransactionIsNotAHeadError U.UUID

37− | TransactionGraphCycleError U.UUID

38− | SessionIdInUseError U.UUID

39− | NoSuchSessionError U.UUID

40− | FailedToFindTransactionError U.UUID

41− | TransactionIdInUseError U.UUID

33+ | NewTransactionMayNotHaveChildrenError TransactionId

34+ | NewTransactionMissingParentError TransactionId

35+ | TransactionIsNotAHeadError TransactionId

36+ | TransactionGraphCycleError TransactionId

37+ | SessionIdInUseError TransactionId

38+ | NoSuchSessionError TransactionId

39+ | FailedToFindTransactionError TransactionId

40+ | TransactionIdInUseError TransactionId

4241 | NoSuchTupleExprFunctionError AtomFunctionName

4342 | NoSuchTypeConstructorName TypeConstructorName

4443 | TypeConstructorAtomTypeMismatch TypeConstructorName AtomType

@@ -74,7 +73,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

7473instance NFData RelationalError where rnf = genericRnf

7574

7675data PersistenceError = InvalidDirectoryError FilePath |

77− MissingTransactionError U.UUID

76+ MissingTransactionError TransactionId

7877 deriving (Show, Eq)

7978

8079--collapse list of errors into normal error- if there is just one, just return one

@@ -89,7 +88,7 @@ data MergeError = SelectedHeadMismatchMergeError |

8988 PreferredHeadMissingMergeError HeadName |

9089 StrategyViolatesConstraintMergeError |

9190 InvalidMergeStrategyError MergeStrategy | -- this is an internal coding error

92− DisconnectedTransactionNotAMergeHeadError U.UUID |

91+ DisconnectedTransactionNotAMergeHeadError TransactionId |

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

9493 StrategyViolatesRelationVariableMergeError |

9594 StrategyViolatesTypeConstructorMergeError

ProjectM36/Server.hs+1−1

@@ -27,7 +27,7 @@ serverDefinition = defaultProcess {

2727 handleCall (\conn (ExecuteTypeForRelationalExpr sessionId expr) -> handleExecuteTypeForRelationalExpr sessionId conn expr),

2828 handleCall (\conn (RetrieveInclusionDependencies sessionId) -> handleRetrieveInclusionDependencies sessionId conn),

2929 handleCall (\conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> handleRetrievePlanForDatabaseContextExpr sessionId conn dbExpr),

30− handleCall (\conn (RetrieveHeadTransactionUUID sessionId) -> handleRetrieveHeadTransactionUUID sessionId conn),

30+ handleCall (\conn (RetrieveHeadTransactionId sessionId) -> handleRetrieveHeadTransactionId sessionId conn),

3131 handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph sessionId conn),

3232 handleCall (\conn (Login procId) -> handleLogin conn procId),

3333 handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead headn conn),

ProjectM36/Server/EntryPoints.hs+4−5

@@ -7,7 +7,6 @@ import Control.Distributed.Process.ManagedProcess (ProcessReply)

77import Control.Distributed.Process.ManagedProcess.Server (reply)

88import Control.Monad.IO.Class (liftIO)

99import Data.Map

10−import Data.UUID (UUID)

1110

1211handleExecuteRelationalExpr :: SessionId -> Connection -> RelationalExpr -> Process (ProcessReply (Either RelationalError Relation) Connection)

1312handleExecuteRelationalExpr sessionId conn expr = do

@@ -54,12 +53,12 @@ handleRetrieveTransactionGraph sessionId conn = do

5453 ret <- liftIO $ transactionGraphAsRelation sessionId conn

5554 reply ret conn

5655

57−handleRetrieveHeadTransactionUUID :: SessionId -> Connection -> Process (ProcessReply (Maybe UUID) Connection)

58−handleRetrieveHeadTransactionUUID sessionId conn = do

59− ret <- liftIO $ headTransactionUUID sessionId conn

56+handleRetrieveHeadTransactionId :: SessionId -> Connection -> Process (ProcessReply (Maybe TransactionId) Connection)

57+handleRetrieveHeadTransactionId sessionId conn = do

58+ ret <- liftIO $ headTransactionId sessionId conn

6059 reply ret conn

6160

62−handleCreateSessionAtCommit :: UUID -> Connection -> Process (ProcessReply (Either RelationalError SessionId) Connection)

61+handleCreateSessionAtCommit :: TransactionId -> Connection -> Process (ProcessReply (Either RelationalError SessionId) Connection)

6362handleCreateSessionAtCommit commitId conn = do

6463 ret <- liftIO $ createSessionAtCommit commitId conn

6564 reply ret conn

ProjectM36/Server/RemoteCallTypes.hs+2−3

@@ -5,7 +5,6 @@ import ProjectM36.TransactionGraph

55import ProjectM36.Session

66import GHC.Generics

77import Data.Binary

8−import Data.UUID

98import Control.Distributed.Process (ProcessId)

109

1110-- | The initial login message. The argument should be the process id of the initiating client. This ProcessId will receive notification callbacks.

@@ -30,9 +29,9 @@ data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr Ses

3029 deriving (Binary, Generic)

3130data RetrieveTransactionGraph = RetrieveTransactionGraph SessionId

3231 deriving (Binary, Generic)

33−data RetrieveHeadTransactionUUID = RetrieveHeadTransactionUUID SessionId

32+data RetrieveHeadTransactionId = RetrieveHeadTransactionId SessionId

3433 deriving (Binary, Generic)

35−data CreateSessionAtCommit = CreateSessionAtCommit UUID

34+data CreateSessionAtCommit = CreateSessionAtCommit TransactionId

3635 deriving (Binary, Generic)

3736data CreateSessionAtHead = CreateSessionAtHead HeadName

3837 deriving (Binary, Generic)

ProjectM36/Session.hs+2−2

@@ -11,6 +11,6 @@ data Session = Session DisconnectedTransaction

1111sessionContext :: Session -> DatabaseContext

1212sessionContext (Session (DisconnectedTransaction _ context)) = context

1313

14−sessionParentUUID :: Session -> UUID

15−sessionParentUUID (Session (DisconnectedTransaction parentUUID _)) = parentUUID

14+sessionParentId :: Session -> TransactionId

15+sessionParentId (Session (DisconnectedTransaction parentUUID _)) = parentUUID

1616

ProjectM36/Transaction.hs+14−14

@@ -1,35 +1,35 @@

11{-# LANGUAGE OverloadedStrings #-}

22module ProjectM36.Transaction where

3−import qualified Data.UUID as U

43import ProjectM36.Base

54import qualified Data.Set as S

5+import qualified Data.UUID as U

77--create a disconnected transaction with a parent

8−newDisconnectedTransaction :: U.UUID -> DatabaseContext -> DisconnectedTransaction

9−newDisconnectedTransaction parentUUID context = DisconnectedTransaction parentUUID context

8+newDisconnectedTransaction :: TransactionId -> DatabaseContext -> DisconnectedTransaction

9+newDisconnectedTransaction parentId context = DisconnectedTransaction parentId context

1010

11−transactionParentIds :: Transaction -> S.Set U.UUID

12−transactionParentIds (Transaction _ (TransactionInfo pUUID _) _) = S.singleton pUUID

13−transactionParentIds (Transaction _ (MergeTransactionInfo pUUID1 pUUID2 _) _) = S.fromList [pUUID1, pUUID2]

11+transactionParentIds :: Transaction -> S.Set TransactionId

12+transactionParentIds (Transaction _ (TransactionInfo pId _) _) = S.singleton pId

13+transactionParentIds (Transaction _ (MergeTransactionInfo pId1 pId2 _) _) = S.fromList [pId1, pId2]

1414

15−transactionChildIds :: Transaction -> S.Set U.UUID

15+transactionChildIds :: Transaction -> S.Set TransactionId

1616transactionChildIds (Transaction _ (TransactionInfo _ children) _) = children

1717transactionChildIds (Transaction _ (MergeTransactionInfo _ _ children) _) = children

1818

19−-- | Create a new transaction which is identical to the original except that a new set of children UUIDs is added.

20−transactionSetChildren :: Transaction -> S.Set U.UUID -> Transaction

21−transactionSetChildren t@(Transaction _ (TransactionInfo pUUID _) _) childIds = Transaction (transactionUUID t) (TransactionInfo pUUID childIds) (transactionContext t)

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

19+-- | Create a new transaction which is identical to the original except that a new set of child transaction ids is added.

20+transactionSetChildren :: Transaction -> S.Set TransactionId -> Transaction

21+transactionSetChildren t@(Transaction _ (TransactionInfo pId _) _) childIds = Transaction (transactionId t) (TransactionInfo pId childIds) (transactionContext t)

22+transactionSetChildren t@(Transaction _ (MergeTransactionInfo pId1 pId2 _) _) childIds = Transaction (transactionId t) (MergeTransactionInfo pId1 pId2 childIds) (transactionContext t)

2323

2424-- | 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−filterTransactionInfoTransactions :: S.Set U.UUID -> TransactionInfo -> TransactionInfo

25+filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo

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

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

2828

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

29+filterParent :: TransactionId -> S.Set TransactionId -> TransactionId

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

3131

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

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

33+filterTransaction :: S.Set TransactionId -> Transaction -> Transaction

3434filterTransaction filterIds (Transaction selfId tInfo context) = Transaction selfId (filterTransactionInfoTransactions filterIds tInfo) context

3535

ProjectM36/Transaction/Persist.hs+11−12

@@ -4,7 +4,6 @@ import ProjectM36.Error

44import ProjectM36.Persist (writeBSFileSync, DiskSync, renameSync)

55import qualified Data.Map as M

66import qualified Data.HashSet as HS

7−import qualified Data.UUID as U

87import qualified Data.Binary as B

98import qualified Data.ByteString.Lazy as BS

109import System.FilePath

@@ -18,11 +17,11 @@ getDirectoryNames path = do

1817 subpaths <- getDirectoryContents path

1918 return $ filter (\n -> n `notElem` ["..", "."]) subpaths

2019

21−tempTransactionDir :: FilePath -> U.UUID -> FilePath

22−tempTransactionDir dbdir transUUID = dbdir </> "." ++ U.toString transUUID

20+tempTransactionDir :: FilePath -> TransactionId -> FilePath

21+tempTransactionDir dbdir transId = dbdir </> "." ++ show transId

2322

24−transactionDir :: FilePath -> U.UUID -> FilePath

25−transactionDir dbdir transUUID = dbdir </> U.toString transUUID

23+transactionDir :: FilePath -> TransactionId -> FilePath

24+transactionDir dbdir transId = dbdir </> show transId

2625

2726transactionInfoPath :: FilePath -> FilePath

2827transactionInfoPath transdir = transdir </> "info"

@@ -39,12 +38,12 @@ atomFuncsDir transdir = transdir </> "atomfuncs"

3938typeConsPath :: FilePath -> FilePath

4039typeConsPath transdir = transdir </> "typecons"

4140

42−readTransaction :: FilePath -> U.UUID -> IO (Either PersistenceError Transaction)

43−readTransaction dbdir transUUID = do

44− let transDir = transactionDir dbdir transUUID

41+readTransaction :: FilePath -> TransactionId -> IO (Either PersistenceError Transaction)

42+readTransaction dbdir transId = do

43+ let transDir = transactionDir dbdir transId

4544 transDirExists <- doesDirectoryExist transDir

4645 if not transDirExists then

47− return $ Left $ MissingTransactionError transUUID

46+ return $ Left $ MissingTransactionError transId

4847 else do

4948 relvars <- readRelVars transDir

5049 transInfo <- liftM B.decode $ BS.readFile (transactionInfoPath transDir)

@@ -58,12 +57,12 @@ readTransaction dbdir transUUID = do

5857 notifications = M.empty,

5958 atomFunctions = atomFuncs }

6059

61− return $ Right $ Transaction transUUID transInfo newContext

60+ return $ Right $ Transaction transId transInfo newContext

6261

6362writeTransaction :: DiskSync -> FilePath -> Transaction -> IO ()

6463writeTransaction sync dbdir trans = do

65− let tempTransDir = tempTransactionDir dbdir (transactionUUID trans)

66− finalTransDir = transactionDir dbdir (transactionUUID trans)

64+ let tempTransDir = tempTransactionDir dbdir (transactionId trans)

65+ finalTransDir = transactionDir dbdir (transactionId trans)

6766 context = transactionContext trans

6867 transDirExists <- doesDirectoryExist finalTransDir

6968 if not transDirExists then do

ProjectM36/TransactionGraph.hs+88−87

@@ -22,7 +22,7 @@ import Data.Either (lefts, rights, isRight)

2222

2323--operators which manipulate a transaction graph

2424data TransactionGraphOperator = JumpToHead HeadName |

25− JumpToTransaction U.UUID |

25+ JumpToTransaction TransactionId |

2626 Branch HeadName |

2727 MergeTransactions MergeStrategy HeadName HeadName |

2828 Commit |

@@ -32,11 +32,11 @@ data TransactionGraphOperator = JumpToHead HeadName |

3232data ROTransactionGraphOperator = ShowGraph

3333

3434

35−bootstrapTransactionGraph :: U.UUID -> DatabaseContext -> TransactionGraph

36−bootstrapTransactionGraph freshUUID context = TransactionGraph bootstrapHeads bootstrapTransactions

35+bootstrapTransactionGraph :: TransactionId -> DatabaseContext -> TransactionGraph

36+bootstrapTransactionGraph freshId context = TransactionGraph bootstrapHeads bootstrapTransactions

3737 where

3838 bootstrapHeads = M.singleton "master" freshTransaction

39− freshTransaction = Transaction freshUUID (TransactionInfo U.nil S.empty) context

39+ freshTransaction = Transaction freshId (TransactionInfo U.nil S.empty) context

4040 bootstrapTransactions = S.singleton freshTransaction

4141

4242emptyTransactionGraph :: TransactionGraph

@@ -53,56 +53,56 @@ headNameForTransaction transaction (TransactionGraph heads _) = if M.null matchi

5353 where

5454 matchingTrans = M.filter (transaction ==) heads

5555

56−transactionForUUID :: U.UUID -> TransactionGraph -> Either RelationalError Transaction

57−transactionForUUID uuid graph = if uuid == U.nil then

56+transactionForId :: TransactionId -> TransactionGraph -> Either RelationalError Transaction

57+transactionForId tid graph = if tid == U.nil then

5858 Left RootTransactionTraversalError

5959 else if S.null matchingTrans then

60− Left $ NoSuchTransactionError uuid

60+ Left $ NoSuchTransactionError tid

6161 else

6262 Right $ head (S.toList matchingTrans)

6363 where

64− matchingTrans = S.filter (\(Transaction uuidMatch _ _) -> uuidMatch == uuid) (transactionsForGraph graph)

64+ matchingTrans = S.filter (\(Transaction idMatch _ _) -> idMatch == tid) (transactionsForGraph graph)

6565

66−transactionsForUUIDs :: S.Set U.UUID -> TransactionGraph -> Either RelationalError (S.Set Transaction)

67−transactionsForUUIDs uuidSet graph = do

68− transList <- forM (S.toList uuidSet) ((flip transactionForUUID) graph)

66+transactionsForIds :: S.Set TransactionId -> TransactionGraph -> Either RelationalError (S.Set Transaction)

67+transactionsForIds idSet graph = do

68+ transList <- forM (S.toList idSet) ((flip transactionForId) graph)

6969 return (S.fromList transList)

7070

7171isRootTransaction :: Transaction -> TransactionGraph -> Bool

72−isRootTransaction (Transaction _ (TransactionInfo pUUID _) _) _ = U.null pUUID

72+isRootTransaction (Transaction _ (TransactionInfo pId _) _) _ = U.null pId

7373isRootTransaction (Transaction _ (MergeTransactionInfo _ _ _) _) _ = False

7474

7575-- the first transaction has no parent - all other do have parents- merges have two parents

7676parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

77−parentTransactions (Transaction _ (TransactionInfo pUUID _) _) graph = do

78− trans <- transactionForUUID pUUID graph

77+parentTransactions (Transaction _ (TransactionInfo pId _) _) graph = do

78+ trans <- transactionForId pId graph

7979 return (S.singleton trans)

8080

81−parentTransactions (Transaction _ (MergeTransactionInfo pUUID1 pUUID2 _) _ ) graph = transactionsForUUIDs (S.fromList [pUUID1, pUUID2]) graph

81+parentTransactions (Transaction _ (MergeTransactionInfo pId1 pId2 _) _ ) graph = transactionsForIds (S.fromList [pId1, pId2]) graph

8282

8383

8484childTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

85−childTransactions (Transaction _ (TransactionInfo _ children) _) = transactionsForUUIDs children

86−childTransactions (Transaction _ (MergeTransactionInfo _ _ children) _) = transactionsForUUIDs children

85+childTransactions (Transaction _ (TransactionInfo _ children) _) = transactionsForIds children

86+childTransactions (Transaction _ (MergeTransactionInfo _ _ children) _) = transactionsForIds children

8787

8888-- create a new commit and add it to the heads

8989-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

90−addBranch :: U.UUID -> HeadName -> U.UUID -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

91−addBranch newUUID newBranchName branchPointId graph = do

92− parentTrans <- transactionForUUID branchPointId graph

93− let newTrans = Transaction newUUID (TransactionInfo branchPointId S.empty) (transactionContext parentTrans)

90+addBranch :: TransactionId -> HeadName -> TransactionId -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

91+addBranch newId newBranchName branchPointId graph = do

92+ parentTrans <- transactionForId branchPointId graph

93+ let newTrans = Transaction newId (TransactionInfo branchPointId S.empty) (transactionContext parentTrans)

9494 addTransactionToGraph newBranchName newTrans graph

9595

9696--adds a disconnected transaction to a transaction graph at some head

97−addDisconnectedTransaction :: U.UUID -> HeadName -> DisconnectedTransaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

98−addDisconnectedTransaction newUUID headName (DisconnectedTransaction parentUUID context) graph = addTransactionToGraph headName (Transaction newUUID (TransactionInfo parentUUID S.empty) context) graph

97+addDisconnectedTransaction :: TransactionId -> HeadName -> DisconnectedTransaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

98+addDisconnectedTransaction newId headName (DisconnectedTransaction parentId context) graph = addTransactionToGraph headName (Transaction newId (TransactionInfo parentId S.empty) context) graph

9999

100100addTransactionToGraph :: HeadName -> Transaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

101101addTransactionToGraph headName newTrans graph = do

102102 let parentIds = transactionParentIds newTrans

103103 childIds = transactionChildIds newTrans

104− newId = transactionUUID newTrans

105− validateIds ids = mapM (\i -> transactionForUUID i graph) (S.toList ids)

104+ newId = transactionId newTrans

105+ validateIds ids = mapM (\i -> transactionForId i graph) (S.toList ids)

106106 addChildTransaction trans = transactionSetChildren trans (S.insert newId (transactionChildIds trans))

107107 --validate that the parent transactions are in the graph

108108 _ <- validateIds parentIds

@@ -110,13 +110,13 @@ addTransactionToGraph headName newTrans graph = do

110110 --if the headName already exists, ensure that it refers to a parent

111111 case transactionForHead headName graph of

112112 Nothing -> pure () -- any headName is OK

113− Just trans -> when (S.notMember (transactionUUID trans) parentIds) (Left (HeadNameSwitchingHeadProhibitedError headName))

113+ Just trans -> when (S.notMember (transactionId trans) parentIds) (Left (HeadNameSwitchingHeadProhibitedError headName))

114114 --validate that the transaction has no children

115115 when (not (S.null childIds)) (Left $ NewTransactionMayNotHaveChildrenError newId)

116116 --validate that the trasaction's id is unique

117− when (isRight (transactionForUUID newId graph)) (Left (TransactionIdInUseError newId))

117+ when (isRight (transactionForId newId graph)) (Left (TransactionIdInUseError newId))

118118 --update the parent transactions to point to the new transaction

119− parents <- mapM (\tid -> transactionForUUID tid graph) (S.toList parentIds)

119+ parents <- mapM (\tid -> transactionForId tid graph) (S.toList parentIds)

120120 let updatedParents = S.map addChildTransaction (S.fromList parents)

121121 updatedTransSet = S.insert newTrans (S.union updatedParents (transactionsForGraph graph))

122122 updatedHeads = M.insert headName newTrans (transactionHeadsForGraph graph)

@@ -124,115 +124,116 @@ addTransactionToGraph headName newTrans graph = do

124124

125125validateGraph :: TransactionGraph -> Maybe [RelationalError]

126126validateGraph graph@(TransactionGraph _ transSet) = do

127− --check that all UUIDs are unique in the graph

128− --uuids = map transactionUUID transSet

127+ --check that all transaction ids are unique in the graph

128+ --FINISH ME!

129+ --uuids = map transactionId transSet

129130 --check that all heads appear in the transSet

130131 --check that all forward and backward links are in place

131132 _ <- mapM (walkParentTransactions S.empty graph) (S.toList transSet)

132133 mapM (walkChildTransactions S.empty graph) (S.toList transSet)

133134

134135--verify that all parent links exist and that all children exist

135−--maybe verify that all parents end at UUID nil and all children end at leaves

136−walkParentTransactions :: S.Set U.UUID -> TransactionGraph -> Transaction -> Maybe RelationalError

136+--maybe verify that all parents end at transaction id nil and all children end at leaves

137+walkParentTransactions :: S.Set TransactionId -> TransactionGraph -> Transaction -> Maybe RelationalError

137138walkParentTransactions seenTransSet graph trans =

138− let transUUID = transactionUUID trans in

139− if transUUID == U.nil then

139+ let transId = transactionId trans in

140+ if transId == U.nil then

140141 Nothing

141− else if S.member transUUID seenTransSet then

142− Just $ TransactionGraphCycleError transUUID

142+ else if S.member transId seenTransSet then

143+ Just $ TransactionGraphCycleError transId

143144 else

144145 let parentTransSetOrError = parentTransactions trans graph in

145146 case parentTransSetOrError of

146147 Left err -> Just err

147148 Right parentTransSet -> do

148− walk <- mapM (walkParentTransactions (S.insert transUUID seenTransSet) graph) (S.toList parentTransSet)

149+ walk <- mapM (walkParentTransactions (S.insert transId seenTransSet) graph) (S.toList parentTransSet)

149150 case walk of

150151 err:_ -> Just err

151152 _ -> Nothing

152153

153154--refactor: needless duplication in these two functions

154−walkChildTransactions :: S.Set U.UUID -> TransactionGraph -> Transaction -> Maybe RelationalError

155+walkChildTransactions :: S.Set TransactionId -> TransactionGraph -> Transaction -> Maybe RelationalError

155156walkChildTransactions seenTransSet graph trans =

156− let transUUID = transactionUUID trans in

157+ let transId = transactionId trans in

157158 if childTransactions trans graph == Right S.empty then

158159 Nothing

159− else if S.member transUUID seenTransSet then

160− Just $ TransactionGraphCycleError transUUID

160+ else if S.member transId seenTransSet then

161+ Just $ TransactionGraphCycleError transId

161162 else

162163 let childTransSetOrError = childTransactions trans graph in

163164 case childTransSetOrError of

164165 Left err -> Just err

165166 Right childTransSet -> do

166− walk <- mapM (walkChildTransactions (S.insert transUUID seenTransSet) graph) (S.toList childTransSet)

167+ walk <- mapM (walkChildTransactions (S.insert transId seenTransSet) graph) (S.toList childTransSet)

167168 case walk of

168169 err:_ -> Just err

169170 _ -> Nothing

170171

171172-- returns the new "current" transaction, updated graph, and tutorial d result

172173-- the current transaction is not part of the transaction graph until it is committed

173−evalGraphOp :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> TransactionGraphOperator -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

174+evalGraphOp :: TransactionId -> DisconnectedTransaction -> TransactionGraph -> TransactionGraphOperator -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

174175

175176--affects only disconncted transaction

176−evalGraphOp _ _ graph (JumpToTransaction jumpUUID) = case transactionForUUID jumpUUID graph of

177+evalGraphOp _ _ graph (JumpToTransaction jumpId) = case transactionForId jumpId graph of

177178 Left err -> Left err

178179 Right parentTrans -> Right (newTrans, graph)

179180 where

180− newTrans = DisconnectedTransaction jumpUUID (transactionContext parentTrans)

181+ newTrans = DisconnectedTransaction jumpId (transactionContext parentTrans)

181182

182183-- switch from one head to another

183184-- affects only disconnectedtransaction

184185evalGraphOp _ _ graph (JumpToHead headName) =

185186 case transactionForHead headName graph of

186− Just newHeadTransaction -> let disconnectedTrans = newDisconnectedTransaction (transactionUUID newHeadTransaction) (transactionContext newHeadTransaction) in

187+ Just newHeadTransaction -> let disconnectedTrans = newDisconnectedTransaction (transactionId newHeadTransaction) (transactionContext newHeadTransaction) in

187188 Right (disconnectedTrans, graph)

188189 Nothing -> Left $ NoSuchHeadNameError headName

189190-- add new head pointing to branchPoint

190191-- repoint the disconnected transaction to the new branch commit (with a potentially different disconnected context)

191192-- affects transactiongraph and the disconnectedtransaction is recreated based off the branch

192193 {-

193−evalGraphOp newUUID discon@(DisconnectedTransaction parentUUID disconContext) graph (Branch newBranchName) = case transactionForUUID parentUUID graph of

194+evalGraphOp newId discon@(DisconnectedTransaction parentId disconContext) graph (Branch newBranchName) = case transactionForId parentId graph of

194195 Nothing -> (discon, graph, DisplayErrorResult "Failed to find parent transaction.")

195196 Just parentTrans -> case addBranch newBranchName parentTrans graph of

196197 Nothing -> (discon, graph, DisplayErrorResult "Failed to add branch.")

197198 Just newGraph -> (newDiscon, newGraph, DisplayResult "Branched.")

198199 where

199− newDiscon = DisconnectedTransaction (transactionUUID parentTrans) disconContext

200+ newDiscon = DisconnectedTransaction (transactionId parentTrans) disconContext

200201-}

201202

202203-- create a new commit and add it to the heads

203204-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

204−evalGraphOp newUUID (DisconnectedTransaction parentUUID disconContext) graph (Branch newBranchName) = case addBranch newUUID newBranchName parentUUID graph of

205+evalGraphOp newId (DisconnectedTransaction parentId disconContext) graph (Branch newBranchName) = case addBranch newId newBranchName parentId graph of

205206 Left err -> Left err

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

207208 where

208− newDiscon = DisconnectedTransaction newUUID disconContext

209+ newDiscon = DisconnectedTransaction newId disconContext

209210

210211-- add the disconnected transaction to the graph

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

212−evalGraphOp newTransUUID discon@(DisconnectedTransaction parentUUID context) graph Commit = case transactionForUUID parentUUID graph of

213+evalGraphOp newTransId discon@(DisconnectedTransaction parentId context) graph Commit = case transactionForId parentId graph of

213214 Left err -> Left err

214215 Right parentTransaction -> case headNameForTransaction parentTransaction graph of

215− Nothing -> Left $ TransactionIsNotAHeadError parentUUID

216+ Nothing -> Left $ TransactionIsNotAHeadError parentId

216217 Just headName -> case maybeUpdatedGraph of

217218 Left err-> Left err

218219 Right (_, updatedGraph) -> Right (newDisconnectedTrans, updatedGraph)

219220 where

220− newDisconnectedTrans = newDisconnectedTransaction newTransUUID context

221− maybeUpdatedGraph = addDisconnectedTransaction newTransUUID headName discon graph

221+ newDisconnectedTrans = newDisconnectedTransaction newTransId context

222+ maybeUpdatedGraph = addDisconnectedTransaction newTransId headName discon graph

222223

223224-- refresh the disconnected transaction, return the same graph

224−evalGraphOp _ (DisconnectedTransaction parentUUID _) graph Rollback = case transactionForUUID parentUUID graph of

225+evalGraphOp _ (DisconnectedTransaction parentId _) graph Rollback = case transactionForId parentId graph of

225226 Left err -> Left err

226227 Right parentTransaction -> Right (newDiscon, graph)

227228 where

228− newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)

229+ newDiscon = newDisconnectedTransaction parentId (transactionContext parentTransaction)

229230

230231-- a successful merge should remove a head

231−evalGraphOp newUUID (DisconnectedTransaction parentUUID _) graph (MergeTransactions mergeStrategy headNameA headNameB) = mergeTransactions newUUID parentUUID mergeStrategy (headNameA, headNameB) graph

232+evalGraphOp newId (DisconnectedTransaction parentId _) graph (MergeTransactions mergeStrategy headNameA headNameB) = mergeTransactions newId parentId mergeStrategy (headNameA, headNameB) graph

232233

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

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

235−graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _ transSet) = do

236+graphAsRelation (DisconnectedTransaction parentId _) graph@(TransactionGraph _ transSet) = do

236237 tupleMatrix <- mapM tupleGenerator (S.toList transSet)

237238 mkRelationFromList attrs tupleMatrix

238239 where

@@ -244,9 +245,9 @@ graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _

244245 parentAttributes = A.attributesFromList [Attribute "id" textAtomType]

245246 tupleGenerator transaction = case transactionParentsRelation transaction graph of

246247 Left err -> Left err

247− Right parentTransRel -> Right [Atom $ T.pack $ show (transactionUUID transaction),

248+ Right parentTransRel -> Right [Atom $ T.pack $ show (transactionId transaction),

248249 Atom parentTransRel,

249− Atom $ parentUUID == transactionUUID transaction,

250+ Atom $ parentId == transactionId transaction,

250251 Atom $ case headNameForTransaction transaction graph of

251252 Just headName -> headName

252253 Nothing -> ""

@@ -262,7 +263,7 @@ transactionParentsRelation trans graph = do

262263 mkRelationFromTuples attrs tuples

263264 where

264265 attrs = A.attributesFromList [Attribute "id" textAtomType]

265− trans2tuple trans2 = mkRelationTuple attrs $ V.singleton (Atom (T.pack (show $ transactionUUID trans2)))

266+ trans2tuple trans2 = mkRelationTuple attrs $ V.singleton (Atom (T.pack (show $ transactionId trans2)))

266267

267268{-

268269--display transaction graph as relation

@@ -273,16 +274,16 @@ evalROGraphOp discon graph ShowGraph = do

273274-}

274275

275276-- | Execute the merge strategy against the transactions, returning a new transaction which can be then added to the transaction graph

276−createMergeTransaction :: U.UUID -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

277−createMergeTransaction newUUID (SelectedBranchMergeStrategy selectedBranch) graph t2@(trans1, trans2) = do

277+createMergeTransaction :: TransactionId -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

278+createMergeTransaction newId (SelectedBranchMergeStrategy selectedBranch) graph t2@(trans1, trans2) = do

278279 selectedTrans <- validateHeadName selectedBranch graph t2

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

280+ pure $ Transaction newId (MergeTransactionInfo (transactionId trans1) (transactionId trans2) S.empty) (transactionContext selectedTrans)

280281

281282-- merge functions, relvars, individually

282−createMergeTransaction newUUID strat@UnionMergeStrategy graph t2 = createUnionMergeTransaction newUUID strat graph t2

283+createMergeTransaction newId strat@UnionMergeStrategy graph t2 = createUnionMergeTransaction newId strat graph t2

283284

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

285−createMergeTransaction newUUID strat@(UnionPreferMergeStrategy _) graph t2 = createUnionMergeTransaction newUUID strat graph t2

286+createMergeTransaction newId strat@(UnionPreferMergeStrategy _) graph t2 = createUnionMergeTransaction newId strat graph t2

286287

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

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

@@ -297,13 +298,13 @@ validateHeadName headName graph (t1, t2) = do

297298-- Algorithm: start at one transaction and work backwards up the parents. If there is a node we have not yet visited as a child, then walk that up to its head. If that branch contains the goal transaction, then we have completed a valid subgraph traversal.

298299subGraphOfFirstCommonAncestor :: TransactionGraph -> TransactionHeads -> Transaction -> Transaction -> S.Set Transaction -> Either RelationalError TransactionGraph

299300subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans goalTrans traverseSet = do

300− let currentid = transactionUUID currentTrans

301− goalid = transactionUUID goalTrans

301+ let currentid = transactionId currentTrans

302+ goalid = transactionId goalTrans

302303 if currentTrans == goalTrans then

303304 Right (TransactionGraph resultHeads traverseSet) -- add filter

304305 --catch root transaction to improve error?

305306 else do

306− currentTransChildren <- liftM S.fromList $ mapM (flip transactionForUUID origGraph) (S.toList (transactionChildIds currentTrans))

307+ currentTransChildren <- liftM S.fromList $ mapM (flip transactionForId origGraph) (S.toList (transactionChildIds currentTrans))

307308 let searchChildren = S.difference (S.insert currentTrans traverseSet) currentTransChildren

308309 searchChild start = pathToTransaction origGraph start goalTrans (S.insert currentTrans traverseSet)

309310 childSearches = map searchChild (S.toList searchChildren)

@@ -322,17 +323,17 @@ subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans goalTrans trave

322323 else -- we found a path

323324 Right (TransactionGraph resultHeads (S.unions (traverseSet : pathsFound)))

324325 where

325− oneParent (Transaction _ (TransactionInfo parentId _) _) = transactionForUUID parentId origGraph

326− oneParent (Transaction _ (MergeTransactionInfo parentId _ _) _) = transactionForUUID parentId origGraph

326+ oneParent (Transaction _ (TransactionInfo parentId _) _) = transactionForId parentId origGraph

327+ oneParent (Transaction _ (MergeTransactionInfo parentId _ _) _) = transactionForId parentId origGraph

327328

328329-- | Search from a past graph point to all following heads for a specific transaction. If found, return the transaction path, otherwise a RelationalError.

329330pathToTransaction :: TransactionGraph -> Transaction -> Transaction -> S.Set Transaction -> Either RelationalError (S.Set Transaction)

330331pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

331− let targetId = transactionUUID targetTransaction

332− if transactionUUID targetTransaction == transactionUUID currentTransaction then do

332+ let targetId = transactionId targetTransaction

333+ if transactionId targetTransaction == transactionId currentTransaction then do

333334 Right accumTransSet

334335 else do

335− currentTransChildren <- mapM (flip transactionForUUID graph) (S.toList (transactionChildIds currentTransaction))

336+ currentTransChildren <- mapM (flip transactionForId graph) (S.toList (transactionChildIds currentTransaction))

336337 if length currentTransChildren == 0 then

337338 Left (FailedToFindTransactionError targetId)

338339 else do

@@ -346,53 +347,53 @@ pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

346347 else --we have some paths!

347348 Right (S.unions paths)

348349

349−mergeTransactions :: U.UUID -> U.UUID -> MergeStrategy -> (HeadName, HeadName) -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

350−mergeTransactions newUUID parentUUID mergeStrategy (headNameA, headNameB) graph = do

350+mergeTransactions :: TransactionId -> TransactionId -> MergeStrategy -> (HeadName, HeadName) -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

351+mergeTransactions newId parentId mergeStrategy (headNameA, headNameB) graph = do

351352 let transactionForHeadErr name = case transactionForHead name graph of

352353 Nothing -> Left (NoSuchHeadNameError name)

353354 Just t -> Right t

354355 transA <- transactionForHeadErr headNameA

355356 transB <- transactionForHeadErr headNameB

356− disconParent <- transactionForUUID parentUUID graph

357+ disconParent <- transactionForId parentId graph

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

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

359360 subGraph' <- filterSubGraph subGraph subHeads

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

361+ case createMergeTransaction newId mergeStrategy subGraph' (transA, transB) of

361362 Left err -> Left (MergeTransactionError err)

362363 Right mergedTrans -> case headNameForTransaction disconParent graph of

363− Nothing -> Left (TransactionIsNotAHeadError parentUUID)

364+ Nothing -> Left (TransactionIsNotAHeadError parentId)

364365 Just headName -> do

365366 (newTrans, newGraph) <- addTransactionToGraph headName mergedTrans graph

366367 let newGraph' = TransactionGraph (transactionHeadsForGraph newGraph) (transactionsForGraph newGraph)

367− newDiscon = newDisconnectedTransaction newUUID (transactionContext newTrans)

368+ newDiscon = newDisconnectedTransaction newId (transactionContext newTrans)

368369 pure (newDiscon, newGraph')

369370

370371--TEMPORARY COPY/PASTE

371372showTransactionStructureX :: Transaction -> TransactionGraph -> String

372−showTransactionStructureX trans graph = headInfo ++ " " ++ show (transactionUUID trans) ++ " " ++ parentTransactionsInfo

373+showTransactionStructureX trans graph = headInfo ++ " " ++ show (transactionId trans) ++ " " ++ parentTransactionsInfo

373374 where

374375 headInfo = maybe "" show (headNameForTransaction trans graph)

375376 parentTransactionsInfo = if isRootTransaction trans graph then "root" else case parentTransactions trans graph of

376377 Left err -> show err

377− Right parentTransSet -> concat $ S.toList $ S.map (show . transactionUUID) parentTransSet

378+ Right parentTransSet -> concat $ S.toList $ S.map (show . transactionId) parentTransSet

378379

379380showGraphStructureX :: TransactionGraph -> String

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

381382 where

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

383− headsInfo = show $ M.map transactionUUID heads

384+ headsInfo = show $ M.map transactionId heads

384385

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

386387filterSubGraph :: TransactionGraph -> TransactionHeads -> Either RelationalError TransactionGraph

387388filterSubGraph graph heads = Right $ TransactionGraph newHeads newTransSet

388389 where

389− validIds = S.map transactionUUID (transactionsForGraph graph)

390+ validIds = S.map transactionId (transactionsForGraph graph)

390391 newTransSet = S.map (filterTransaction validIds) (transactionsForGraph graph)

391392 newHeads = M.map (filterTransaction validIds) heads

392393

393394--helper function for commonalities in union merge

394−createUnionMergeTransaction :: U.UUID -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

395−createUnionMergeTransaction newUUID strategy graph (t1,t2) = do

395+createUnionMergeTransaction :: TransactionId -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

396+createUnionMergeTransaction newId strategy graph (t1,t2) = do

396397 let contextA = transactionContext t1

397398 contextB = transactionContext t2

398399

@@ -409,4 +410,4 @@ createUnionMergeTransaction newUUID strategy graph (t1,t2) = do

409410 atomFuncs <- unionMergeAtomFunctions preference (atomFunctions contextA) (atomFunctions contextB)

410411 notifs <- unionMergeMaps preference (notifications contextA) (notifications contextB)

411412 types <- unionMergeTypeConstructorMapping preference (typeConstructorMapping contextA) (typeConstructorMapping contextB)

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

413+ pure (Transaction newId (MergeTransactionInfo (transactionId t1) (transactionId t2) S.empty) (DatabaseContext incDeps relVars atomFuncs notifs types))

ProjectM36/TransactionGraph/Persist.hs+23−23

@@ -19,8 +19,8 @@ import Data.Either (isRight)

1919import Data.Maybe (catMaybes)

2020

2121{-

22−The "m36v1" file at the top-level of the destination directory contains the the transaction graph as a set of UUIDs referencing their parents (1 or more)

23−Each Transaction is written to it own directory named by its UUID. Partially written transactions UUIDs are prefixed with a "." to indicate incompleteness in the graph.

22+The "m36v1" file at the top-level of the destination directory contains the the transaction graph as a set of transaction ids referencing their parents (1 or more)

23+Each Transaction is written to it own directory named by its transaction id. Partially written transactions ids are prefixed with a "." to indicate incompleteness in the graph.

2424

2525Persistence requires a POSIX-compliant, journaled-metadata filesystem.

2626-}

@@ -67,7 +67,7 @@ incrementally updates an existing database directory

6767transactionGraphPersist :: DiskSync -> FilePath -> TransactionGraph -> IO ()

6868transactionGraphPersist sync destDirectory graph = do

6969 mapM_ (writeTransaction sync destDirectory) $ M.elems (transactionHeadsForGraph graph)

70− writeGraphUUIDFile sync destDirectory graph

70+ writeGraphTransactionIdFile sync destDirectory graph

7171 transactionGraphHeadsPersist sync destDirectory graph

7272 return ()

7373

@@ -78,14 +78,14 @@ write graph heads to a file which can be atomically swapped

7878transactionGraphHeadsPersist :: DiskSync -> FilePath -> TransactionGraph -> IO ()

7979transactionGraphHeadsPersist sync dbdir graph = do

8080 let headFileStr :: (HeadName, Transaction) -> String

81− headFileStr (headName, trans) = T.unpack headName ++ " " ++ U.toString (transactionUUID trans)

81+ headFileStr (headName, trans) = T.unpack headName ++ " " ++ U.toString (transactionId trans)

8282 withTempDirectory dbdir ".heads.tmp" $ \tempHeadsDir -> do

8383 let tempHeadsPath = tempHeadsDir </> "heads"

8484 headsStrLines = map headFileStr $ M.toList (transactionHeadsForGraph graph)

8585 writeFileSync sync tempHeadsPath $ intercalate "\n" headsStrLines

8686 renameSync sync tempHeadsPath (headsPath dbdir)

8787

88−transactionGraphHeadsLoad :: FilePath -> IO [(HeadName,U.UUID)]

88+transactionGraphHeadsLoad :: FilePath -> IO [(HeadName,TransactionId)]

8989transactionGraphHeadsLoad dbdir = do

9090 headsData <- readFile (headsPath dbdir)

9191 let headsAssocs = map (\l -> let headName:uuidStr:[] = words l in

@@ -102,50 +102,50 @@ transactionGraphLoad :: FilePath -> TransactionGraph -> IO (Either PersistenceEr

102102transactionGraphLoad dbdir graphIn = do

103103 --optimization: perform tail-bisection search to find last-recorded transaction in the existing stream- replay the rest

104104 --read in all missing transactions from transaction directories and add to graph

105− uuidInfo <- readGraphUUIDFile dbdir

105+ uuidInfo <- readGraphTransactionIdFile dbdir

106106 freshHeadsAssoc <- transactionGraphHeadsLoad dbdir

107107 case uuidInfo of

108108 Left err -> return $ Left err

109109 Right info -> do

110− let folder = \eitherGraph transUUID -> case eitherGraph of

110+ let folder = \eitherGraph transId -> case eitherGraph of

111111 Left err -> return $ Left err

112− Right graph -> readTransactionIfNecessary dbdir transUUID graph

112+ Right graph -> readTransactionIfNecessary dbdir transId graph

113113 loadedGraph <- foldM folder (Right graphIn) (map fst info)

114114 case loadedGraph of

115115 Left err -> return $ Left err

116116 Right freshGraph -> do

117− let maybeTransHeads = [(headName, transactionForUUID uuid freshGraph) | (headName, uuid) <- freshHeadsAssoc]

117+ let maybeTransHeads = [(headName, transactionForId uuid freshGraph) | (headName, uuid) <- freshHeadsAssoc]

118118 freshHeads = M.fromList [(headName,trans) | (headName, Right trans) <- maybeTransHeads]

119119 return $ Right $ TransactionGraph freshHeads (transactionsForGraph freshGraph)

120120

121121{-

122−if the transaction with the UUID argument is not yet part of the graph, then read the transaction and add it - this does not update the heads

122+if the transaction with the TransactionId argument is not yet part of the graph, then read the transaction and add it - this does not update the heads

123123-}

124−readTransactionIfNecessary :: FilePath -> U.UUID -> TransactionGraph -> IO (Either PersistenceError TransactionGraph)

125−readTransactionIfNecessary dbdir transUUID graphIn = do

126− if isRight $ transactionForUUID transUUID graphIn then

124+readTransactionIfNecessary :: FilePath -> TransactionId -> TransactionGraph -> IO (Either PersistenceError TransactionGraph)

125+readTransactionIfNecessary dbdir transId graphIn = do

126+ if isRight $ transactionForId transId graphIn then

127127 --the transaction is already known and loaded- done

128128 return $ Right graphIn

129129 else do

130− trans <- readTransaction dbdir transUUID

130+ trans <- readTransaction dbdir transId

131131 case trans of

132132 Left err -> return $ Left err

133133 Right trans' -> return $ Right $ TransactionGraph (transactionHeadsForGraph graphIn) (S.insert trans' (transactionsForGraph graphIn))

134134

135−writeGraphUUIDFile :: DiskSync -> FilePath -> TransactionGraph -> IO ()

136−writeGraphUUIDFile sync destDirectory (TransactionGraph _ transSet) = writeFileSync sync graphFile uuidInfo

135+writeGraphTransactionIdFile :: DiskSync -> FilePath -> TransactionGraph -> IO ()

136+writeGraphTransactionIdFile sync destDirectory (TransactionGraph _ transSet) = writeFileSync sync graphFile uuidInfo

137137 where

138138 graphFile = destDirectory </> "m36v1"

139139 uuidInfo = intercalate "\n" graphLines

140140 graphLines = S.toList $ S.map graphLine transSet

141− graphLine trans = U.toString (transactionUUID trans) ++ " " ++ intercalate " " (S.toList (S.map U.toString $ transactionParentIds trans))

141+ graphLine trans = U.toString (transactionId trans) ++ " " ++ intercalate " " (S.toList (S.map U.toString $ transactionParentIds trans))

142142

143−readGraphUUIDFile :: FilePath -> IO (Either PersistenceError [(U.UUID, [U.UUID])])

144−readGraphUUIDFile dbdir = do

143+readGraphTransactionIdFile :: FilePath -> IO (Either PersistenceError [(TransactionId, [TransactionId])])

144+readGraphTransactionIdFile dbdir = do

145145 --read in all transactions' uuids

146− let grapher line = let uuids = catMaybes (map U.fromString (words line)) in

147− (head uuids, tail uuids)

146+ let grapher line = let tids = catMaybes (map U.fromString (words line)) in

147+ (head tids, tail tids)

148148 --warning: uses lazy IO

149− graphUUIDData <- readFile (transactionLogPath dbdir)

150− return $ Right (map grapher $ lines graphUUIDData)

149+ graphTransactionIdData <- readFile (transactionLogPath dbdir)

150+ return $ Right (map grapher $ lines graphTransactionIdData)

151151

ProjectM36/TransactionGraph/Show.hs+2−2

@@ -6,12 +6,12 @@ import ProjectM36.Transaction

66import qualified Data.Set as S

88showTransactionStructure :: Transaction -> TransactionGraph -> String

9−showTransactionStructure trans graph = headInfo ++ " " ++ show (transactionUUID trans) ++ " p" ++ parentTransactionsInfo ++ " c" ++ childTransactionsInfo

9+showTransactionStructure trans graph = headInfo ++ " " ++ show (transactionId trans) ++ " p" ++ parentTransactionsInfo ++ " c" ++ childTransactionsInfo

1010 where

1111 headInfo = maybe "" show (headNameForTransaction trans graph)

1212 parentTransactionsInfo = if isRootTransaction trans graph then "root" else case parentTransactions trans graph of

1313 Left err -> show err

14− Right parentTransSet -> concat $ S.toList $ S.map (show . transactionUUID) parentTransSet

14+ Right parentTransSet -> concat $ S.toList $ S.map (show . transactionId) parentTransSet

1515 childTransactionsInfo = show (S.toList (transactionChildIds trans))

1616

1717showGraphStructure :: TransactionGraph -> String

ProjectM36/TransactionGraph/Show/Dot.hs+2−2

@@ -13,10 +13,10 @@ graphAsDot (TransactionGraph heads transSet) = "digraph {" ++ dot ++ headInfo ++

1313 arrows trans idSet = S.foldr (\c acc' -> acc' ++ oneArrow trans c) "" idSet

1414 childArrows trans = arrows trans (transactionChildIds trans)

1515 parentArrows trans = arrows trans (transactionParentIds trans)

16− transLabel t = tidLabel (transactionUUID t)

16+ transLabel t = tidLabel (transactionId t)

1717 tidLabel l = "\"" ++ show l ++ "\""

1818 oneArrow trans tid = transLabel trans ++ " -> " ++ tidLabel tid ++ ";"

19− headInfo = M.foldrWithKey (\headName t acc -> transLabel t ++ " [label=\"" ++ (show . transactionUUID) t ++ ":" ++ T.unpack headName ++ "\"];" ++ acc) "" heads

19+ headInfo = M.foldrWithKey (\headName t acc -> transLabel t ++ " [label=\"" ++ (show . transactionId) t ++ ":" ++ T.unpack headName ++ "\"];" ++ acc) "" heads

2020

2121

2222

test/Server/Main.hs+9−9

@@ -24,7 +24,7 @@ testList sessionId conn notificationTestMVar = TestList $ map (\t -> t sessionId

2424 testTypeForRelationalExpr,

2525 testPlanForDatabaseContextExpr,

2626 testTransactionGraphAsRelation,

27− testHeadTransactionUUID,

27+ testHeadTransactionId,

2828 testHeadName,

2929 testSession,

3030 testRelationVariableSummary,

@@ -117,9 +117,9 @@ testTransactionGraphAsRelation sessionId conn = TestCase $ do

117117 Left err -> assertFailure (show err)

118118 Right _ -> pure ()

119119

120−testHeadTransactionUUID :: SessionId -> Connection -> Test

121−testHeadTransactionUUID sessionId conn = TestCase $ do

122− uuid <- headTransactionUUID sessionId conn

120+testHeadTransactionId :: SessionId -> Connection -> Test

121+testHeadTransactionId sessionId conn = TestCase $ do

122+ uuid <- headTransactionId sessionId conn

123123 assertBool "invalid head transaction uuid" (isJust uuid)

124124 pure ()

125125

@@ -142,11 +142,11 @@ testSession _ conn = TestCase $ do

142142 case eSessionId1 of

143143 Left _ -> assertFailure "invalid session"

144144 Right sessionId1 -> do

145− mHeadUUID <- headTransactionUUID sessionId1 conn

146− case mHeadUUID of

147− Nothing -> assertFailure "invalid head UUID"

148− Just headUUID -> do

149− eSessionId2 <- createSessionAtCommit headUUID conn

145+ mHeadId <- headTransactionId sessionId1 conn

146+ case mHeadId of

147+ Nothing -> assertFailure "invalid head id"

148+ Just headId -> do

149+ eSessionId2 <- createSessionAtCommit headId conn

150150 assertBool ("invalid session: " ++ show eSessionId2) (isRight eSessionId2)

151151 closeSession sessionId1 conn

152152

test/TransactionGraph/Merge.hs+16−16

@@ -62,7 +62,7 @@ addTransaction headName transaction graph = case addTransactionToGraph headName

6262 Left err -> assertFailure (show err) >> error ""

6363 Right (t,g) -> pure (t,g)

6464

65−fakeUUID :: Word8 -> U.UUID

65+fakeUUID :: Word8 -> TransactionId

6666fakeUUID x = case U.fromByteString (BS.concat (replicate 4 w32)) of

6767 Nothing -> error "impossible uuid"

6868 Just u -> u

@@ -99,7 +99,7 @@ testSubGraphToFirstAncestorSnipBranch = TestCase $ do

9999 baseGraph <- basicTransactionGraph

100100 transA <- assertMaybe (transactionForHead "branchA" baseGraph) "failed to get branchA"

101101 transB <- assertMaybe (transactionForHead "branchB" baseGraph) "failed to get branchB"

102− rootTrans <- assertEither (transactionForUUID (fakeUUID 1) baseGraph)

102+ rootTrans <- assertEither (transactionForId (fakeUUID 1) baseGraph)

103103 (_, graph) <- addTransaction "branchC" (Transaction (fakeUUID 12) (TransactionInfo (fakeUUID 1) S.empty) (transactionContext transA)) baseGraph

104104 subgraph <- assertEither $ subGraphOfFirstCommonAncestor graph (transactionHeadsForGraph baseGraph) transA transB S.empty

105105 assertGraph subgraph

@@ -116,17 +116,17 @@ testSubGraphToFirstAncestorMoreTransactions = TestCase $ do

116116 updatedBranchBContext <- case runState (evalContextExpr (Assign "branchBOnlyRelvar" (ExistingRelation relationTrue))) (transactionContext branchBTrans) of

117117 (Just err, _) -> assertFailure (show err) >> undefined

118118 (Nothing, context) -> pure context

119− (_, graph') <- addTransaction "branchB" (Transaction (fakeUUID 3) (TransactionInfo (transactionUUID branchBTrans) S.empty) updatedBranchBContext) graph

119+ (_, graph') <- addTransaction "branchB" (Transaction (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) updatedBranchBContext) graph

120120 -- add another transaction to branchA

121121 branchATrans <- assertMaybe (transactionForHead "branchA" graph) "failed to get branchA head"

122− (_, graph'') <- addTransaction "branchA" (Transaction (fakeUUID 4) (TransactionInfo (transactionUUID branchATrans) S.empty) (transactionContext branchATrans)) graph'

122+ (_, graph'') <- addTransaction "branchA" (Transaction (fakeUUID 4) (TransactionInfo (transactionId branchATrans) S.empty) (transactionContext branchATrans)) graph'

123123

124124 --retrieve subgraph

125− let subGraphHeads = M.filter (\t -> elem (transactionUUID t) [fakeUUID 3, fakeUUID 4]) (transactionHeadsForGraph graph'')

125+ let subGraphHeads = M.filter (\t -> elem (transactionId t) [fakeUUID 3, fakeUUID 4]) (transactionHeadsForGraph graph'')

126126 subgraph <- assertEither $ subGraphOfFirstCommonAncestor graph'' subGraphHeads branchATrans branchBTrans S.empty

127127 --verify that the subgraph includes both the heads and the common ancestor

128128 let expectedTransSet = S.fromList (map fakeUUID [1,3,4])

129− assertBool "validate transactions in subgraph" (S.isProperSubsetOf expectedTransSet (S.map transactionUUID (transactionsForGraph subgraph)))

129+ assertBool "validate transactions in subgraph" (S.isProperSubsetOf expectedTransSet (S.map transactionId (transactionsForGraph subgraph)))

130130

131131testSelectedBranchMerge :: Test

132132testSelectedBranchMerge = TestCase $ do

@@ -138,7 +138,7 @@ testSelectedBranchMerge = TestCase $ do

138138 updatedBranchBContext <- case runState (evalContextExpr (Assign "branchBOnlyRelvar" (ExistingRelation relationTrue))) (transactionContext branchBTrans) of

139139 (Just err, _) -> assertFailure (show err) >> undefined

140140 (Nothing, context) -> pure context

141− (_, graph') <- addTransaction "branchB" (Transaction (fakeUUID 3) (TransactionInfo (transactionUUID branchBTrans) S.empty) updatedBranchBContext) graph

141+ (_, graph') <- addTransaction "branchB" (Transaction (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) updatedBranchBContext) graph

142142 --create the merge transaction in the graph

143143 let eGraph' = mergeTransactions (fakeUUID 4) (fakeUUID 10) (SelectedBranchMergeStrategy "branchA") ("branchA", "branchB") graph'

144144

@@ -146,12 +146,12 @@ testSelectedBranchMerge = TestCase $ do

146146

147147 assertGraph graph''

148148 --validate that the branchB remains

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

149+ rootTrans <- assertEither $ transactionForId (fakeUUID 1) graph''

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

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

151+ assertEqual "head of merged transaction was removed" (transactionId branchBTrans) (fakeUUID 3)

152152

153153 --validate that the branchB relvar does *not* appear in the merge because branchA was selected

154− mergeTrans <- assertEither (transactionForUUID (fakeUUID 4) graph'')

154+ mergeTrans <- assertEither (transactionForId (fakeUUID 4) graph'')

155155 assertBool "branchOnlyRelvar is present in merge" (M.notMember "branchBOnlyRelvar" (relationVariables (transactionContext mergeTrans)))

156156

157157-- try various individual component conflicts and check for resolution

@@ -167,8 +167,8 @@ testUnionPreferMergeStrategy = TestCase $ do

167167 branchBContext = (transactionContext branchBTrans) {relationVariables = M.insert conflictRelVarName branchBRelVar (relationVariables (transactionContext branchBTrans))}

168168 conflictRelVarName = "conflictRelVar"

169169

170− (_, graph') <- addTransaction "branchA" (Transaction (fakeUUID 3) (TransactionInfo (transactionUUID branchATrans) S.empty) branchAContext) graph

171− (_, graph'') <- addTransaction "branchB" (Transaction (fakeUUID 4) (TransactionInfo (transactionUUID branchBTrans) S.empty) branchBContext) graph'

170+ (_, graph') <- addTransaction "branchA" (Transaction (fakeUUID 3) (TransactionInfo (transactionId branchATrans) S.empty) branchAContext) graph

171+ (_, graph'') <- addTransaction "branchB" (Transaction (fakeUUID 4) (TransactionInfo (transactionId branchBTrans) S.empty) branchBContext) graph'

172172 -- validate that the conflict is hidden because we preferred a branch

173173 let merged = mergeTransactions (fakeUUID 5) (fakeUUID 3) (UnionPreferMergeStrategy "branchB") ("branchA", "branchB") graph''

174174 case merged of

@@ -193,16 +193,16 @@ testUnionMergeStrategy = TestCase $ do

193193 branchAOnlyIncDepName = "branchAOnlyIncDep"

194194 branchBOnlyRelVarName = "branchBOnlyRelVar"

195195 branchAOnlyIncDep = InclusionDependency (ExistingRelation relationTrue) (ExistingRelation relationTrue)

196− (_, graph') <- addTransaction "branchB" (Transaction (fakeUUID 3) (TransactionInfo (transactionUUID branchBTrans) S.empty) updatedBranchBContext) graph

196+ (_, graph') <- addTransaction "branchB" (Transaction (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) updatedBranchBContext) graph

197197 ((DisconnectedTransaction _ mergeContext1), mergedGraph1) <- assertEither $ mergeTransactions (fakeUUID 5) (fakeUUID 10) UnionMergeStrategy ("branchA", "branchB") graph'

198198 assertEqual "branchBOnlyRelVar should appear in the merge" (M.lookup branchBOnlyRelVarName (relationVariables mergeContext1)) (Just relationTrue)

199− (_, graph'') <- addTransaction "branchA" (Transaction (fakeUUID 4) (TransactionInfo (transactionUUID branchATrans) S.empty) updatedBranchAContext) graph'

199+ (_, graph'') <- addTransaction "branchA" (Transaction (fakeUUID 4) (TransactionInfo (transactionId branchATrans) S.empty) updatedBranchAContext) graph'

200200 let eMergeGraph = mergeTransactions (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB") graph''

201201 case eMergeGraph of

202202 Left err -> assertFailure ("expected merge success: " ++ show err)

203203 Right (mergeDiscon, mergeGraph) -> do

204204 -- check that the new merge transaction has the correct parents

205− mergeTrans <- assertEither $ transactionForUUID (fakeUUID 5) mergeGraph

205+ mergeTrans <- assertEither $ transactionForId (fakeUUID 5) mergeGraph

206206 let mergeContext = transactionContext mergeTrans

207207 assertEqual "merge transaction parents" (transactionParentIds mergeTrans) (S.fromList [fakeUUID 3, fakeUUID 4])

208208 -- check that the new merge tranasction has elements from both A and B branches

@@ -212,7 +212,7 @@ testUnionMergeStrategy = TestCase $ do

212212 conflictRelVar <- assertEither $ mkRelationFromList (attributesFromList [Attribute "conflict" intAtomType]) []

213213 let conflictContextA = updatedBranchAContext {relationVariables = M.insert branchBOnlyRelVarName conflictRelVar (relationVariables updatedBranchAContext) }

214214 conflictBranchATrans <- assertMaybe (transactionForHead "branchA" graph'') "retrieving head transaction for expected conflict"

215− (_, graph''') <- addTransaction "branchA" (Transaction (fakeUUID 6) (TransactionInfo (transactionUUID conflictBranchATrans) S.empty) conflictContextA) graph''

215+ (_, graph''') <- addTransaction "branchA" (Transaction (fakeUUID 6) (TransactionInfo (transactionId conflictBranchATrans) S.empty) conflictContextA) graph''

216216 let failingMerge = mergeTransactions (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB") graph'''

217217 case failingMerge of

218218 Right _ -> assertFailure "expected merge failure"

test/TransactionGraph/Persist.hs+7−7

@@ -25,8 +25,8 @@ testList = TestList [testBootstrapDB, testDBSimplePersistence]

2525testBootstrapDB :: Test

2626testBootstrapDB = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do

2727 let dbdir = tempdir </> "dbdir"

28− freshUUID <- nextRandom

29− _ <- bootstrapDatabaseDir NoDiskSync dbdir (bootstrapTransactionGraph freshUUID dateExamples)

28+ freshId <- nextRandom

29+ _ <- bootstrapDatabaseDir NoDiskSync dbdir (bootstrapTransactionGraph freshId dateExamples)

3030 loadedGraph <- transactionGraphLoad dbdir emptyTransactionGraph

3131 assertBool "transactionGraphLoad" $ isRight loadedGraph

3232

@@ -34,8 +34,8 @@ testBootstrapDB = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> d

3434testDBSimplePersistence :: Test

3535testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do

3636 let dbdir = tempdir </> "dbdir"

37− freshUUID <- nextRandom

38− let graph = bootstrapTransactionGraph freshUUID dateExamples

37+ freshId <- nextRandom

38+ let graph = bootstrapTransactionGraph freshId dateExamples

3939 bootstrapDatabaseDir NoDiskSync dbdir graph

4040 case transactionForHead "master" graph of

4141 Nothing -> assertFailure "Failed to retrieve head transaction for master branch."

@@ -43,9 +43,9 @@ testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \temp

4343 case interpretDatabaseContextExpr (transactionContext headTrans) "x:=s" of

4444 Left err -> assertFailure (show err)

4545 Right context' -> do

46− freshUUID' <- nextRandom

47− let newdiscon = newDisconnectedTransaction (transactionUUID headTrans) context'

48− addTrans = addDisconnectedTransaction freshUUID' "master" newdiscon graph

46+ freshId' <- nextRandom

47+ let newdiscon = newDisconnectedTransaction (transactionId headTrans) context'

48+ addTrans = addDisconnectedTransaction freshId' "master" newdiscon graph

4949 --add a transaction to the graph

5050 case addTrans of

5151 Left err -> assertFailure (show err)