b0525ca · project-m36 · git.iko.soy

git.iko.soy/project-m36

Merge branch 'master' into websocket-server

Conflicts: docs/reaching_out_of_the_tarpit.markdown project-m36.cabal

commitb0525ca40f09e3fe0b0dda76c97022d011f355e4 authorAgentM <agentm@themactionfaction.com> dateThu 21 Jul 2016, 17:09 (10 years ago) parent56c338b 56b0f2d

47 files changed+1855−372

compare with master

unifiedsplit

.gitignore+2−1 Database/Persist/ProjectM36.hs+2−2 ProjectM36/Base.hs+65−51 ProjectM36/Client.hs+31−32 ProjectM36/DatabaseContext.hs+2−2 ProjectM36/DirectoryFsync.c+5−1 ProjectM36/Error.hs+27−8 ProjectM36/Persist.hs+38−10 ProjectM36/RelationalExpression.hs+5−3 ProjectM36/Server.hs+1−1 ProjectM36/Server/EntryPoints.hs+6−7 ProjectM36/Server/RemoteCallTypes.hs+4−5 ProjectM36/Session.hs+2−2 ProjectM36/StaticOptimizer.hs+1−1 ProjectM36/Transaction.hs+27−6 ProjectM36/Transaction/Persist.hs+11−12 ProjectM36/TransactionGraph.hs+232−70 ProjectM36/TransactionGraph/Merge.hs+85 ProjectM36/TransactionGraph/Persist.hs+23−23 ProjectM36/TransactionGraph/Show.hs+4−6 ProjectM36/TransactionGraph/Show/Dot.hs+22 ProjectM36/Tuple.hs+2−2 ProjectM36/Win32Handle.hs+57 README.markdown+12−7 TutorialD/Interpreter.hs+14−6 TutorialD/Interpreter/DatabaseExpr.hs → TutorialD/Interpreter/DatabaseContextExpr.hs+26−26 TutorialD/Interpreter/Import/Base.hs+4−4 TutorialD/Interpreter/Import/CSV.hs+1−1 TutorialD/Interpreter/Import/TutorialD.hs+2−2 TutorialD/Interpreter/InformationOperator.hs+57 TutorialD/Interpreter/RODatabaseContextOperator.hs+2−2 TutorialD/Interpreter/TransactionGraphOperator.hs+20 TutorialD/tutd.hs+13−2 benchmark/bigrel.hs+2−2 docs/introduction_to_projectm36.markdown+19−13 docs/merge_notes.markdown+182 docs/merge_transactions.markdown+149 docs/reaching_out_of_the_tarpit.markdown+3−3 docs/server_mode.markdown+1−1 project-m36.cabal+354−35 stack.yaml+40 test/Relation/Basic.hs+14−2 test/Server/Main.hs+9−9 test/TransactionGraph/Merge.hs+219 test/TransactionGraph/Persist.hs+9−9 test/TutorialD/Interpreter.hs+23−3 test/scripts.hs+26

.gitignore+2−1

@@ -3,4 +3,5 @@

33*~

44dist/

55.cabal-sandbox/

6−cabal.sandbox.config

6+cabal.sandbox.config

7+.stack-work

Database/Persist/ProjectM36.hs+2−2

@@ -217,7 +217,7 @@ updateByKey key updates = do

217217 (sessionId, conn) <- ask

218218 maybeErr <- Trans.liftIO $ C.executeDatabaseContextExpr sessionId conn query

219219 case maybeErr of

220− Just err -> throwIOPersistError ("executeDatabaseExpr error" ++ show err)

220+ Just err -> throwIOPersistError ("executeDatabaseContextExpr error" ++ show err)

221221 Nothing -> return ()

222222

223223--set the truth unconditionally

@@ -316,7 +316,7 @@ instance ToJSON (BackendKey ProjectM36Backend) where

316316 toJSON (ProjectM36Key uuid) = toJSON $ U.toString uuid

317317

318318--wrapped version which throws exceptions

319−executeDatabaseContextExpr :: C.SessionId -> C.Connection -> DatabaseExpr -> IO ()

319+executeDatabaseContextExpr :: C.SessionId -> C.Connection -> DatabaseContextExpr -> IO ()

320320executeDatabaseContextExpr sessionId conn expr = do

321321 res <- C.executeDatabaseContextExpr sessionId conn expr

322322 case res of

ProjectM36/Base.hs+65−51

@@ -1,4 +1,4 @@

1−{-# LANGUAGE ExistentialQuantification,BangPatterns,GADTs,DeriveGeneric,DeriveAnyClass #-}

1+{-# LANGUAGE ExistentialQuantification,BangPatterns,DeriveGeneric,DeriveAnyClass #-}

22{-# OPTIONS_GHC -fno-warn-orphans #-}

33module ProjectM36.Base where

44import qualified Data.Map as M

@@ -232,38 +232,38 @@ data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, O

232232type RelVarName = StringType

233233

234234-- | A relational expression represents query (read) operations on a database.

235−data RelationalExpr where

235+data RelationalExpr =

236236 --- | Create a relation from tuple expressions.

237− MakeRelationFromExprs :: Maybe [AttributeExpr] -> [TupleExpr] -> RelationalExpr

237+ MakeRelationFromExprs (Maybe [AttributeExpr]) [TupleExpr] |

238238 --- | Create and reference a relation from attributes and a tuple set.

239− MakeStaticRelation :: Attributes -> RelationTupleSet -> RelationalExpr

239+ MakeStaticRelation Attributes RelationTupleSet |

240240 --- | Reference an existing relation in Haskell-space.

241− ExistingRelation :: Relation -> RelationalExpr

241+ ExistingRelation Relation |

242242 --MakeFunctionalRelation (creates a relation from a tuple-generating function, potentially infinite)

243243 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

244244 --relational variables should also be able to be explicitly-typed like in Haskell

245245 --- | Reference a relation variable by its name.

246− RelationVariable :: RelVarName -> RelationalExpr

246+ RelationVariable RelVarName |

247247 --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)

248− Project :: AttributeNames -> RelationalExpr -> RelationalExpr

248+ Project AttributeNames RelationalExpr |

249249 --- | Create a union of two relational expressions. The expressions should have identical attributes.

250− Union :: RelationalExpr -> RelationalExpr -> RelationalExpr

250+ Union RelationalExpr RelationalExpr |

251251 --- | Create a join of two relational expressions. The join occurs on attributes which are identical. If the expressions have no overlapping attributes, the join becomes a cross-product of both tuple sets.

252− Join :: RelationalExpr -> RelationalExpr -> RelationalExpr

252+ Join RelationalExpr RelationalExpr |

253253 --- | Rename an attribute (first argument) to another (second argument).

254− Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr

254+ Rename AttributeName AttributeName RelationalExpr |

255255 --- | Return a relation containing all tuples of the first argument which do not appear in the second argument (minus).

256− Difference :: RelationalExpr -> RelationalExpr -> RelationalExpr

256+ Difference RelationalExpr RelationalExpr |

257257 --- | Create a sub-relation composed of the first argument's attributes which will become an attribute of the result expression. The unreferenced attributes are not altered in the result but duplicate tuples in the projection of the expression minus the attribute names are compressed into one. For more information, <https://github.com/agentm/project-m36/blob/master/docs/introduction_to_the_relational_algebra.markdown#group read the relational algebra tutorial.>

258− Group :: AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr

258+ Group AttributeNames AttributeName RelationalExpr |

259259 --- | Create an expression to unwrap a sub-relation contained within at an attribute's name. Note that this is not always an inverse of a group operation.

260− Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

260+ Ungroup AttributeName RelationalExpr |

261261 --- | Filter the tuples of the relational expression to only retain the tuples which evaluate against the restriction predicate to true.

262− Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

262+ Restrict RestrictionPredicateExpr RelationalExpr |

263263 --- | Returns the true relation iff

264− Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

265− NotEquals :: RelationalExpr -> RelationalExpr -> RelationalExpr

266− Extend :: ExtendTupleExpr -> RelationalExpr -> RelationalExpr

264+ Equals RelationalExpr RelationalExpr |

265+ NotEquals RelationalExpr RelationalExpr |

266+ Extend ExtendTupleExpr RelationalExpr

267267 --Summarize :: AtomExpr -> AttributeName -> RelationalExpr -> RelationalExpr -> RelationalExpr -- a special case of Extend

268268 deriving (Show, Eq, Generic, Binary)

269269

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

309309 DataConstructorDefTypeVarNameArg TypeVarName

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

311311

312+type InclusionDependencies = M.Map IncDepName InclusionDependency

313+type RelationVariables = M.Map RelVarName Relation

314+

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

313316data DatabaseContext = DatabaseContext {

314− inclusionDependencies :: M.Map IncDepName InclusionDependency,

315− relationVariables :: M.Map RelVarName Relation,

317+ inclusionDependencies :: InclusionDependencies,

318+ relationVariables :: RelationVariables,

316319 atomFunctions :: AtomFunctions,

317320 notifications :: Notifications,

318321 typeConstructorMapping :: TypeConstructorMapping

@@ -326,43 +329,43 @@ data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr der

326329instance Binary InclusionDependency

327330

328331-- | Database context expressions modify the database context.

329−data DatabaseExpr where

330− NoOperation :: DatabaseExpr

331− Define :: RelVarName -> [AttributeExpr] -> DatabaseExpr

332− Undefine :: RelVarName -> DatabaseExpr --forget existence of relvar X

333− Assign :: RelVarName -> RelationalExpr -> DatabaseExpr

334− Insert :: RelVarName -> RelationalExpr -> DatabaseExpr

335− Delete :: RelVarName -> RestrictionPredicateExpr -> DatabaseExpr

336− Update :: RelVarName -> M.Map AttributeName Atom -> RestrictionPredicateExpr -> DatabaseExpr -- needs restriction support

332+data DatabaseContextExpr =

333+ NoOperation |

334+ Define RelVarName [AttributeExpr] |

335+ Undefine RelVarName | --forget existence of relvar X

336+ Assign RelVarName RelationalExpr |

337+ Insert RelVarName RelationalExpr |

338+ Delete RelVarName RestrictionPredicateExpr |

339+ Update RelVarName (M.Map AttributeName Atom) RestrictionPredicateExpr |

337340

338− AddInclusionDependency :: IncDepName -> InclusionDependency -> DatabaseExpr

339− RemoveInclusionDependency :: IncDepName -> DatabaseExpr

341+ AddInclusionDependency IncDepName InclusionDependency |

342+ RemoveInclusionDependency IncDepName |

340343

341− AddNotification :: NotificationName -> RelationalExpr -> RelationalExpr -> DatabaseExpr

342− RemoveNotification :: NotificationName -> DatabaseExpr

344+ AddNotification NotificationName RelationalExpr RelationalExpr |

345+ RemoveNotification NotificationName |

343346

344− AddTypeConstructor :: TypeConstructorDef -> [DataConstructorDef] -> DatabaseExpr

345− RemoveTypeConstructor :: TypeConstructorName -> DatabaseExpr

347+ AddTypeConstructor TypeConstructorDef [DataConstructorDef] |

348+ RemoveTypeConstructor TypeConstructorName |

346349

347350 -- to implement this, I likely need to implement a DSL for constructing arbitrary functions to operate on atoms at runtime

348− --AddAtomFunction :: AtomFunction -> DatabaseExpr

349− --RemoveAtomFunction :: AtomFunctionName -> DatabaseExpr

351+ --AddAtomFunction AtomFunction

352+ --RemoveAtomFunction AtomFunctionName

350353

351− MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

354+ MultipleExpr [DatabaseContextExpr]

352355 deriving (Show, Eq, Binary, Generic)

353356

354357

355358type DatabaseState a = State DatabaseContext a

356359

357360-- | Restriction predicate are boolean algebra components which, when composed, indicate whether or not a tuple should be retained during a restriction (filtering) operation.

358−data RestrictionPredicateExpr where

359− TruePredicate :: RestrictionPredicateExpr

360− AndPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

361− OrPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

362− NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

363− RelationalExprPredicate :: RelationalExpr -> RestrictionPredicateExpr --type must be same as true and false relations (no attributes)

364− AtomExprPredicate :: AtomExpr -> RestrictionPredicateExpr --atom must evaluate to boolean

365− AttributeEqualityPredicate :: AttributeName -> AtomExpr -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

361+data RestrictionPredicateExpr =

362+ TruePredicate |

363+ AndPredicate RestrictionPredicateExpr RestrictionPredicateExpr |

364+ OrPredicate RestrictionPredicateExpr RestrictionPredicateExpr |

365+ NotPredicate RestrictionPredicateExpr |

366+ RelationalExprPredicate RelationalExpr | --type must be same as true and false relations (no attributes)

367+ AtomExprPredicate AtomExpr | --atom must evaluate to boolean

368+ AttributeEqualityPredicate AttributeName AtomExpr -- relationalexpr must result in relation with single tuple

366369 deriving (Show, Eq, Generic)

367370

368371instance Binary RestrictionPredicateExpr

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

384387transactionHeadsForGraph (TransactionGraph heads _) = heads

385388

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

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

388− 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

389392 deriving(Show, Generic)

390393

391394instance Binary TransactionInfo

392−

395+

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

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

397+type TransactionId = UUID

398+

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

395400 deriving (Show, Generic)

396401

397402--instance Binary Transaction

398403

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

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

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

401406

402−transactionUUID :: Transaction -> UUID

403−transactionUUID (Transaction uuid _ _) = uuid

407+transactionId :: Transaction -> TransactionId

408+transactionId (Transaction tid _ _) = tid

404409

405410transactionContext :: Transaction -> DatabaseContext

406411transactionContext (Transaction _ _ context) = context

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

470475

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

472477 deriving (Eq, Show, Generic, Binary)

478+

479+data MergeStrategy =

480+ -- | 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)

481+ UnionMergeStrategy |

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

483+ UnionPreferMergeStrategy HeadName |

484+ -- | 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.

485+ SelectedBranchMergeStrategy HeadName

486+ deriving (Eq, Show, Binary, Generic, NFData)

ProjectM36/Client.hs+31−32

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

2222 headName,

2323 remoteDBLookupName,

2424 defaultServerPort,

25− headTransactionUUID,

25+ headTransactionId,

2626 defaultDatabaseName,

2727 defaultRemoteConnectionInfo,

2828 defaultHeadName,

2929 PersistenceStrategy(..),

3030 RelationalExpr(..),

31− DatabaseExpr(..),

31+ DatabaseContextExpr(..),

3232 Attribute(..),

3333 attributesFromList,

3434 createNodeId,

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

@@ -330,7 +329,7 @@ executeRelationalExpr sessionId (InProcessConnection _ _ sessions _) expr = atom

330329executeRelationalExpr sessionId conn@(RemoteProcessConnection _ _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)

331330

332331-- | Execute a database context expression in the context of the session and connection. Database expressions modify the current session's disconnected transaction but cannot modify the transaction graph.

333−executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseExpr -> IO (Maybe RelationalError)

332+executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Maybe RelationalError)

334333executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _) expr = atomically $ do

335334 eSession <- sessionForSessionId sessionId sessions

336335 case eSession of

@@ -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

@@ -460,7 +459,7 @@ inclusionDependencies sessionId (InProcessConnection _ _ sessions _) = do

460459inclusionDependencies sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveInclusionDependencies sessionId)

461460

462461-- | Return an optimized database expression which is logically equivalent to the input database expression. This function can be used to determine which expression will actually be evaluated.

463−planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseExpr -> IO (Either RelationalError DatabaseExpr)

462+planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError DatabaseContextExpr)

464463planForDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _) dbExpr = do

465464 atomically $ do

466465 eSession <- sessionForSessionId sessionId sessions

@@ -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/DatabaseContext.hs+2−2

@@ -15,11 +15,11 @@ empty = DatabaseContext { inclusionDependencies = M.empty,

1515 typeConstructorMapping = [] }

1616

1717-- | convert an existing database context into its constituent expression.

18−databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseExpr

18+databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr

1919databaseContextAsDatabaseContextExpr context = MultipleExpr $ incDepsExprs ++ relVarsExprs ++ funcsExprs

2020 where

2121 relVarsExprs = map (\(name, rel) -> Assign name (ExistingRelation rel)) (M.toList (relationVariables context))

22− incDepsExprs :: [DatabaseExpr]

22+ incDepsExprs :: [DatabaseContextExpr]

2323 incDepsExprs = map (\(name, dep) -> AddInclusionDependency name dep) (M.toList (inclusionDependencies context))

2424 funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet

2525

ProjectM36/DirectoryFsync.c+5−1

@@ -33,12 +33,16 @@ int cDirectoryFsync(char *path)

3333 }

3434

3535 /* execute the fsync */

36+

37+#if defined(__APPLE__) && defined(__MACH__) && defined(F_FULLFSYNC)

38+ ret = fcntl(fd, F_FULLFSYNC);

39+#else

3640 ret = fsync(fd);

41+#endif

3742 if(ret < 0)

3843 {

3944 return errno;

4045 }

41−

4246 return 0;

4347}

4448#endif

ProjectM36/Error.hs+27−8

@@ -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,12 +25,19 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

2625 | InclusionDependencyNameNotInUseError IncDepName

2726 | ParseError T.Text

2827 | PredicateExpressionError T.Text

29− | NoSuchTransactionError U.UUID

28+ | NoCommonTransactionAncestorError TransactionId TransactionId

29+ | NoSuchTransactionError TransactionId

30+ | RootTransactionTraversalError

31+ | HeadNameSwitchingHeadProhibitedError HeadName

3032 | NoSuchHeadNameError HeadName

31− | TransactionIsNotAHeadError U.UUID

32− | TransactionGraphCycleError U.UUID

33− | SessionIdInUseError U.UUID

34− | NoSuchSessionError 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

3541 | NoSuchTupleExprFunctionError AtomFunctionName

3642 | NoSuchTypeConstructorName TypeConstructorName

3743 | TypeConstructorAtomTypeMismatch TypeConstructorName AtomType

@@ -60,13 +66,14 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

6066 | NotificationNameNotInUseError NotificationName

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

6268 | ExportError T.Text

69+ | MergeTransactionError MergeError

6370 | MultipleErrors [RelationalError]

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

6572

6673instance NFData RelationalError where rnf = genericRnf

6774

6875data PersistenceError = InvalidDirectoryError FilePath |

69− MissingTransactionError U.UUID

76+ MissingTransactionError TransactionId

7077 deriving (Show, Eq)

7178

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

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

7582someErrors errList = if length errList == 1 then

7683 head errList

7784 else

78− MultipleErrors errList

85+ MultipleErrors errList

86+

87+data MergeError = SelectedHeadMismatchMergeError |

88+ PreferredHeadMissingMergeError HeadName |

89+ StrategyViolatesConstraintMergeError |

90+ InvalidMergeStrategyError MergeStrategy | -- this is an internal coding error

91+ DisconnectedTransactionNotAMergeHeadError TransactionId |

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

93+ StrategyViolatesRelationVariableMergeError |

94+ StrategyViolatesTypeConstructorMergeError

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

96+

97+instance NFData MergeError where rnf = genericRnf

ProjectM36/Persist.hs+38−10

@@ -1,18 +1,28 @@

1−{-# LANGUAGE ForeignFunctionInterface #-}

1+{-# LANGUAGE ForeignFunctionInterface, CPP #-}

22--this module is related to persisting Project:M36 structures to disk and not related to the persistent library

33module ProjectM36.Persist (writeFileSync,

44 writeBSFileSync,

55 renameSync,

66 DiskSync(..)) where

7−--import ProjectM36.DirectoryFsync (directoryFsync)

8−import System.Posix.Files (rename)

7+-- on Windows, use FlushFileBuffers and MoveFileEx

9+#if defined(mingw32_HOST_OS)

10+import qualified System.Win32 as Win32

11+#else

12+import qualified System.Posix as Posix

913import System.Posix.Unistd (fileSynchroniseDataOnly)

1014import System.Posix.IO (handleToFd)

15+import Foreign.C

16+#endif

17+

1118import System.IO (withFile, IOMode(WriteMode), hPutStr, Handle)

1219import qualified Data.ByteString.Lazy as BS

13−import Foreign.C

1420

15−foreign import ccall unsafe "cDirectoryFsync" cHSDirectoryFsync :: CString -> IO (CInt)

21+#if defined(mingw32_HOST_OS)

22+import ProjectM36.Win32Handle

23+#else

24+foreign import ccall unsafe "cDirectoryFsync" cHSDirectoryFsync :: CString -> IO CInt

25+#endif

1626

1727data DiskSync = NoDiskSync | FsyncDiskSync

1828

@@ -25,11 +35,25 @@ writeFileSync sync path strOut = withFile path WriteMode handler

2535

2636renameSync :: DiskSync -> FilePath -> FilePath -> IO ()

2737renameSync sync srcPath dstPath = do

28− rename srcPath dstPath

38+ atomicRename srcPath dstPath

2939 syncDirectory sync dstPath

30−

31−syncHandle :: DiskSync -> Handle -> IO ()

32−syncHandle FsyncDiskSync handle = handleToFd handle >>= fileSynchroniseDataOnly

40+

41+-- System.Directory's renameFile/renameDirectory almost do exactly what we want except that it needlessly differentiates between directories and files

42+atomicRename :: FilePath -> FilePath -> IO ()

43+atomicRename srcPath dstPath = do

44+#if defined(mingw32_HOST_OS)

45+ Win32.moveFileEx srcPath dstPath Win32.mOVEFILE_REPLACE_EXISTING

46+#else

47+ Posix.rename srcPath dstPath

48+#endif

49+

50+syncHandle :: DiskSync -> Handle -> IO ()

51+syncHandle FsyncDiskSync handle = do

52+#if defined(mingw32_HOST_OS)

53+ withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)

54+#else

55+ handleToFd handle >>= fileSynchroniseDataOnly

56+#endif

3357syncHandle NoDiskSync _ = pure ()

3458

3559syncDirectory :: DiskSync -> FilePath -> IO ()

@@ -43,5 +67,9 @@ writeBSFileSync sync path bstring = do

4367 syncHandle sync handle

4468

4569directoryFsync :: FilePath -> IO ()

70+#if defined(mingw32_HOST_OS)

71+directoryFsync _ = pure () -- on Windows directory metadata cannot be synchronized- perhaps there is a workaround? resync a file in the directory?

72+#else

4673directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)

47−

74+#endif

75+

ProjectM36/RelationalExpression.hs+5−3

@@ -18,7 +18,7 @@ import Data.Char (isUpper)

1818import qualified Data.Text as T

1919import qualified Data.Vector as V

2020import qualified ProjectM36.TypeConstructorDef as TCD

21−--import Debug.Trace

21+import Debug.Trace

2222

2323--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

2424evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

@@ -175,7 +175,7 @@ deleteRelVar relVarName = do

175175 put $ currcontext { relationVariables = newRelVars }

176176 return Nothing

177177

178−evalContextExpr :: DatabaseExpr -> DatabaseState (Maybe RelationalError)

178+evalContextExpr :: DatabaseContextExpr -> DatabaseState (Maybe RelationalError)

179179evalContextExpr NoOperation = pure Nothing

180180

181181evalContextExpr (Define relVarName attrExprs) = do

@@ -440,7 +440,7 @@ extendTupleExpressionProcessor relIn

440440 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType]

441441 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

442442 return $ (newAndOldAttrs, \tup -> case evalAtomExpr tup context atomExpr of

443− Left _ -> undefined -- ?!

443+ Left _ -> error "logic failure in extendTupleExpressionProcessor"

444444 Right atom -> tupleAtomExtend newAttrName atom tup)

445445

446446evalAtomExpr :: RelationTuple -> DatabaseContext -> AtomExpr -> Either RelationalError Atom

@@ -527,6 +527,8 @@ evalTupleExpr context attrs (TupleExpr tupMap) = do

527527 tup = mkRelationTuple tupAttrs atoms

528528 tConss = typeConstructorMapping context

529529 finalAttrs = fromMaybe tupAttrs attrs

530+ --verify that the attributes match

531+ when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) (traceShow (finalAttrs,tupAttrs) $ Left (TupleAttributeTypeMismatchError tupAttrs))

530532 tup' <- resolveTypesInTuple finalAttrs (reorderTuple finalAttrs tup)

531533 _ <- validateTuple tup' tConss

532534 pure tup'

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+6−7

@@ -7,14 +7,13 @@ 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

1413 ret <- liftIO $ executeRelationalExpr sessionId conn expr

1514 reply ret conn

1615

17−handleExecuteDatabaseContextExpr :: SessionId -> Connection -> DatabaseExpr -> Process (ProcessReply (Maybe RelationalError) Connection)

16+handleExecuteDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> Process (ProcessReply (Maybe RelationalError) Connection)

1817handleExecuteDatabaseContextExpr sessionId conn dbexpr = do

1918 ret <- liftIO $ executeDatabaseContextExpr sessionId conn dbexpr

2019 reply ret conn

@@ -44,7 +43,7 @@ handleRetrieveInclusionDependencies sessionId conn = do

4443 ret <- liftIO $ inclusionDependencies sessionId conn

4544 reply ret conn

4645

47−handleRetrievePlanForDatabaseContextExpr :: SessionId -> Connection -> DatabaseExpr -> Process (ProcessReply (Either RelationalError DatabaseExpr) Connection)

46+handleRetrievePlanForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> Process (ProcessReply (Either RelationalError DatabaseContextExpr) Connection)

4847handleRetrievePlanForDatabaseContextExpr sessionId conn dbExpr = do

4948 ret <- liftIO $ planForDatabaseContextExpr sessionId conn dbExpr

5049 reply ret conn

@@ -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+4−5

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

@@ -16,7 +15,7 @@ data Logout = Logout

1615 deriving (Binary, Generic)

1716data ExecuteRelationalExpr = ExecuteRelationalExpr SessionId RelationalExpr

1817 deriving (Binary, Generic)

19−data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseExpr

18+data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseContextExpr

2019 deriving (Binary, Generic)

2120data ExecuteGraphExpr = ExecuteGraphExpr SessionId TransactionGraphOperator

2221 deriving (Binary, Generic)

@@ -26,13 +25,13 @@ data ExecuteTypeForRelationalExpr = ExecuteTypeForRelationalExpr SessionId Relat

2625 deriving (Binary, Generic)

2726data RetrieveInclusionDependencies = RetrieveInclusionDependencies SessionId

2827 deriving (Binary, Generic)

29−data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr SessionId DatabaseExpr

28+data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr SessionId DatabaseContextExpr

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/StaticOptimizer.hs+1−1

@@ -105,7 +105,7 @@ applyStaticRelationalOptimization e@(NotEquals _ _) = return $ Right e

105105

106106applyStaticRelationalOptimization e@(Extend _ _) = return $ Right e

107107

108−applyStaticDatabaseOptimization :: DatabaseExpr -> DatabaseState (Either RelationalError DatabaseExpr)

108+applyStaticDatabaseOptimization :: DatabaseContextExpr -> DatabaseState (Either RelationalError DatabaseContextExpr)

109109applyStaticDatabaseOptimization x@NoOperation = pure $ Right x

110110applyStaticDatabaseOptimization x@(Define _ _) = pure $ Right x

111111

ProjectM36/Transaction.hs+27−6

@@ -1,14 +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

10+

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

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

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

14+

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

16+transactionChildIds (Transaction _ (TransactionInfo _ children) _) = children

17+transactionChildIds (Transaction _ (MergeTransactionInfo _ _ children) _) = children

18+

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)

23+

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+filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo

26+filterTransactionInfoTransactions filterIds (TransactionInfo parentId childIds) = TransactionInfo (filterParent parentId filterIds) (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 :: TransactionId -> S.Set TransactionId -> TransactionId

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

1031

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

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

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

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

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

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

1435

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+232−70

@@ -16,22 +16,27 @@ import Control.Monad

1616import qualified Data.Text as T

1717import GHC.Generics

1818import Data.Binary

19+import ProjectM36.TransactionGraph.Merge

20+import Data.Either (lefts, rights, isRight)

21+--import Debug.Trace

1922

2023--operators which manipulate a transaction graph

2124data TransactionGraphOperator = JumpToHead HeadName |

22− JumpToTransaction U.UUID |

25+ JumpToTransaction TransactionId |

2326 Branch HeadName |

27+ MergeTransactions MergeStrategy HeadName HeadName |

2428 Commit |

2529 Rollback

2630 deriving (Eq, Show, Binary, Generic)

2731

2832data ROTransactionGraphOperator = ShowGraph

2933

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

31−bootstrapTransactionGraph freshUUID context = TransactionGraph bootstrapHeads bootstrapTransactions

34+

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

36+bootstrapTransactionGraph freshId context = TransactionGraph bootstrapHeads bootstrapTransactions

3237 where

3338 bootstrapHeads = M.singleton "master" freshTransaction

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

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

3540 bootstrapTransactions = S.singleton freshTransaction

3641

3742emptyTransactionGraph :: TransactionGraph

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

4853 where

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

5055

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

52−transactionForUUID uuid graph = if S.null matchingTrans then

53− Left $ NoSuchTransactionError uuid

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

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

58+ Left RootTransactionTraversalError

59+ else if S.null matchingTrans then

60+ Left $ NoSuchTransactionError tid

5461 else

5562 Right $ head (S.toList matchingTrans)

5663 where

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

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

5865

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

60−transactionsForUUIDs uuidSet graph = do

61− 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)

6269 return (S.fromList transList)

6370

6471isRootTransaction :: Transaction -> TransactionGraph -> Bool

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

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

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

6774

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

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

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

71− trans <- transactionForUUID pUUID graph

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

78+ trans <- transactionForId pId graph

7279 return (S.singleton trans)

7380

74−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

7582

7683

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

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

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

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

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

8087

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

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

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

84−addBranch newUUID newBranchName branchPoint graph = addTransactionToGraph newBranchName branchPoint newUUID (transactionContext branchPoint) graph

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)

94+ addTransactionToGraph newBranchName newTrans graph

8595

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

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

88−addDisconnectedTransaction newUUID headName (DisconnectedTransaction parentUUID context) graph = do

89− parentTrans <- transactionForUUID parentUUID graph

90− addTransactionToGraph headName parentTrans newUUID context graph

91−

92−-- create a new transaction on "newHeadName" with the branchPointTrans

93−addTransactionToGraph :: HeadName -> Transaction -> U.UUID -> DatabaseContext -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

94−addTransactionToGraph newHeadName branchPointTrans newUUID newContext (TransactionGraph heads transSet) = do

95− let freshTransaction = Transaction newUUID (TransactionInfo (transactionUUID branchPointTrans) S.empty) newContext

96− -- there are two parents for MergeTransactions! not implemented

97− --update parentTransaction to add child

98− let parentTransaction = branchPointTrans

99− let updatedTransSet = (S.insert freshTransaction <$> S.insert parentTransaction <$> S.delete parentTransaction) transSet

100− let updatedGraph = TransactionGraph (M.insert newHeadName freshTransaction heads) updatedTransSet

101− return (freshTransaction, updatedGraph)

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

99+

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

101+addTransactionToGraph headName newTrans graph = do

102+ let parentIds = transactionParentIds newTrans

103+ childIds = transactionChildIds newTrans

104+ newId = transactionId newTrans

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

106+ addChildTransaction trans = transactionSetChildren trans (S.insert newId (transactionChildIds trans))

107+ --validate that the parent transactions are in the graph

108+ _ <- validateIds parentIds

109+ when (S.size parentIds < 1) (Left $ NewTransactionMissingParentError newId)

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

111+ case transactionForHead headName graph of

112+ Nothing -> pure () -- any headName is OK

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

114+ --validate that the transaction has no children

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

116+ --validate that the trasaction's id is unique

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

118+ --update the parent transactions to point to the new transaction

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

120+ let updatedParents = S.map addChildTransaction (S.fromList parents)

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

122+ updatedHeads = M.insert headName newTrans (transactionHeadsForGraph graph)

123+ pure (newTrans, (TransactionGraph updatedHeads updatedTransSet))

102124

103125validateGraph :: TransactionGraph -> Maybe [RelationalError]

104126validateGraph graph@(TransactionGraph _ transSet) = do

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

106− --uuids = map transactionUUID transSet

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

128+ --FINISH ME!

129+ --uuids = map transactionId transSet

107130 --check that all heads appear in the transSet

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

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

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

111134

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

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

114−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

115138walkParentTransactions seenTransSet graph trans =

116− let transUUID = transactionUUID trans in

117− if transUUID == U.nil then

139+ let transId = transactionId trans in

140+ if transId == U.nil then

118141 Nothing

119− else if S.member transUUID seenTransSet then

120− Just $ TransactionGraphCycleError transUUID

142+ else if S.member transId seenTransSet then

143+ Just $ TransactionGraphCycleError transId

121144 else

122145 let parentTransSetOrError = parentTransactions trans graph in

123146 case parentTransSetOrError of

124147 Left err -> Just err

125148 Right parentTransSet -> do

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

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

127150 case walk of

128151 err:_ -> Just err

129152 _ -> Nothing

130153

131154--refactor: needless duplication in these two functions

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

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

133156walkChildTransactions seenTransSet graph trans =

134− let transUUID = transactionUUID trans in

157+ let transId = transactionId trans in

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

136159 Nothing

137− else if S.member transUUID seenTransSet then

138− Just $ TransactionGraphCycleError transUUID

160+ else if S.member transId seenTransSet then

161+ Just $ TransactionGraphCycleError transId

139162 else

140163 let childTransSetOrError = childTransactions trans graph in

141164 case childTransSetOrError of

142165 Left err -> Just err

143166 Right childTransSet -> do

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

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

145168 case walk of

146169 err:_ -> Just err

147170 _ -> Nothing

148171

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

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

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

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

152175

153176--affects only disconncted transaction

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

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

155178 Left err -> Left err

156179 Right parentTrans -> Right (newTrans, graph)

157180 where

158− newTrans = DisconnectedTransaction jumpUUID (transactionContext parentTrans)

181+ newTrans = DisconnectedTransaction jumpId (transactionContext parentTrans)

159182

160183-- switch from one head to another

161184-- affects only disconnectedtransaction

162185evalGraphOp _ _ graph (JumpToHead headName) =

163186 case transactionForHead headName graph of

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

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

165188 Right (disconnectedTrans, graph)

166189 Nothing -> Left $ NoSuchHeadNameError headName

167190-- add new head pointing to branchPoint

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

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

170193 {-

171−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

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

173196 Just parentTrans -> case addBranch newBranchName parentTrans graph of

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

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

176199 where

177− newDiscon = DisconnectedTransaction (transactionUUID parentTrans) disconContext

200+ newDiscon = DisconnectedTransaction (transactionId parentTrans) disconContext

178201-}

179202

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

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

182−evalGraphOp newUUID (DisconnectedTransaction parentUUID disconContext) graph (Branch newBranchName) = case transactionForUUID parentUUID graph of

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

183206 Left err -> Left err

184− Right parentTrans -> case addBranch newUUID newBranchName parentTrans graph of

185− Left err -> Left err

186− Right (_, newGraph) -> Right (newDiscon, newGraph)

187− where

188− newDiscon = DisconnectedTransaction newUUID disconContext

207+ Right (_, newGraph) -> Right (newDiscon, newGraph)

208+ where

209+ newDiscon = DisconnectedTransaction newId disconContext

189210

190211-- add the disconnected transaction to the graph

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

192−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

193214 Left err -> Left err

194215 Right parentTransaction -> case headNameForTransaction parentTransaction graph of

195− Nothing -> Left $ TransactionIsNotAHeadError parentUUID

216+ Nothing -> Left $ TransactionIsNotAHeadError parentId

196217 Just headName -> case maybeUpdatedGraph of

197218 Left err-> Left err

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

199220 where

200− newDisconnectedTrans = newDisconnectedTransaction newTransUUID context

201− maybeUpdatedGraph = addDisconnectedTransaction newTransUUID headName discon graph

221+ newDisconnectedTrans = newDisconnectedTransaction newTransId context

222+ maybeUpdatedGraph = addDisconnectedTransaction newTransId headName discon graph

202223

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

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

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

205226 Left err -> Left err

206227 Right parentTransaction -> Right (newDiscon, graph)

207228 where

208− newDiscon = newDisconnectedTransaction parentUUID (transactionContext parentTransaction)

229+ newDiscon = newDisconnectedTransaction parentId (transactionContext parentTransaction)

230+

231+-- a successful merge should remove a head

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

209233

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

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

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

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

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

214238 mkRelationFromList attrs tupleMatrix

215239 where

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

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

222246 tupleGenerator transaction = case transactionParentsRelation transaction graph of

223247 Left err -> Left err

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

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

225249 Atom parentTransRel,

226− Atom $ parentUUID == transactionUUID transaction,

250+ Atom $ parentId == transactionId transaction,

227251 Atom $ case headNameForTransaction transaction graph of

228252 Just headName -> headName

229253 Nothing -> ""

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

239263 mkRelationFromTuples attrs tuples

240264 where

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

242− 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)))

243267

244268{-

245269--display transaction graph as relation

@@ -249,3 +273,141 @@ evalROGraphOp discon graph ShowGraph = do

249273 return graphRel

250274-}

251275

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

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

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

279+ selectedTrans <- validateHeadName selectedBranch graph t2

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

281+

282+-- merge functions, relvars, individually

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

284+

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

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

287+

288+-- | 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.

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

290+validateHeadName headName graph (t1, t2) = do

291+ case transactionForHead headName graph of

292+ Nothing -> Left SelectedHeadMismatchMergeError

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

294+ Left SelectedHeadMismatchMergeError

295+ else

296+ Right trans

297+

298+-- 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.

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

300+subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans goalTrans traverseSet = do

301+ let currentid = transactionId currentTrans

302+ goalid = transactionId goalTrans

303+ if currentTrans == goalTrans then

304+ Right (TransactionGraph resultHeads traverseSet) -- add filter

305+ --catch root transaction to improve error?

306+ else do

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

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

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

310+ childSearches = map searchChild (S.toList searchChildren)

311+ errors = lefts childSearches

312+ pathsFound = rights childSearches

313+ realErrors = filter (/= (FailedToFindTransactionError goalid)) errors

314+ -- report any non-search-related errors

315+ when (not (null realErrors)) (Left (head realErrors))

316+ -- if no paths found, search the parent

317+ if null pathsFound then

318+ case oneParent currentTrans of

319+ Left RootTransactionTraversalError -> Left (NoCommonTransactionAncestorError currentid goalid)

320+ Left err -> Left err

321+ Right currentTransParent -> do

322+ subGraphOfFirstCommonAncestor origGraph resultHeads currentTransParent goalTrans (S.insert currentTrans traverseSet)

323+ else -- we found a path

324+ Right (TransactionGraph resultHeads (S.unions (traverseSet : pathsFound)))

325+ where

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

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

328+

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

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

331+pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

332+ let targetId = transactionId targetTransaction

333+ if transactionId targetTransaction == transactionId currentTransaction then do

334+ Right accumTransSet

335+ else do

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

337+ if length currentTransChildren == 0 then

338+ Left (FailedToFindTransactionError targetId)

339+ else do

340+ let searches = map (\t -> pathToTransaction graph t targetTransaction (S.insert t accumTransSet)) currentTransChildren

341+ let realErrors = filter (/= FailedToFindTransactionError targetId) (lefts searches)

342+ paths = rights searches

343+ if length realErrors > 0 then -- found some real errors

344+ Left (head realErrors)

345+ else if length paths == 0 then -- failed to find transaction in all children

346+ Left (FailedToFindTransactionError targetId)

347+ else --we have some paths!

348+ Right (S.unions paths)

349+

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

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

352+ let transactionForHeadErr name = case transactionForHead name graph of

353+ Nothing -> Left (NoSuchHeadNameError name)

354+ Just t -> Right t

355+ transA <- transactionForHeadErr headNameA

356+ transB <- transactionForHeadErr headNameB

357+ disconParent <- transactionForId parentId graph

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

359+ subGraph <- subGraphOfFirstCommonAncestor graph subHeads transA transB S.empty

360+ subGraph' <- filterSubGraph subGraph subHeads

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

362+ Left err -> Left (MergeTransactionError err)

363+ Right mergedTrans -> case headNameForTransaction disconParent graph of

364+ Nothing -> Left (TransactionIsNotAHeadError parentId)

365+ Just headName -> do

366+ (newTrans, newGraph) <- addTransactionToGraph headName mergedTrans graph

367+ let newGraph' = TransactionGraph (transactionHeadsForGraph newGraph) (transactionsForGraph newGraph)

368+ newDiscon = newDisconnectedTransaction newId (transactionContext newTrans)

369+ pure (newDiscon, newGraph')

370+

371+--TEMPORARY COPY/PASTE

372+showTransactionStructureX :: Transaction -> TransactionGraph -> String

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

374+ where

375+ headInfo = maybe "" show (headNameForTransaction trans graph)

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

377+ Left err -> show err

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

379+

380+showGraphStructureX :: TransactionGraph -> String

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

382+ where

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

384+ headsInfo = show $ M.map transactionId heads

385+

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

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

388+filterSubGraph graph heads = Right $ TransactionGraph newHeads newTransSet

389+ where

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

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

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

393+

394+--helper function for commonalities in union merge

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

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

397+ let contextA = transactionContext t1

398+ contextB = transactionContext t2

399+

400+ preference <- case strategy of

401+ UnionMergeStrategy -> pure PreferNeither

402+ UnionPreferMergeStrategy preferBranch -> do

403+ case transactionForHead preferBranch graph of

404+ Nothing -> Left (PreferredHeadMissingMergeError preferBranch)

405+ Just preferredTrans -> pure $ if t1 == preferredTrans then PreferFirst else PreferSecond

406+ badStrat -> Left (InvalidMergeStrategyError badStrat)

407+

408+ incDeps <- unionMergeMaps preference (inclusionDependencies contextA) (inclusionDependencies contextB)

409+ relVars <- unionMergeRelVars preference (relationVariables contextA) (relationVariables contextB)

410+ atomFuncs <- unionMergeAtomFunctions preference (atomFunctions contextA) (atomFunctions contextB)

411+ notifs <- unionMergeMaps preference (notifications contextA) (notifications contextB)

412+ types <- unionMergeTypeConstructorMapping preference (typeConstructorMapping contextA) (typeConstructorMapping contextB)

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

ProjectM36/TransactionGraph/Merge.hsnew file+85

@@ -0,0 +1,85 @@

1+--Transaction Merge Engines

2+module ProjectM36.TransactionGraph.Merge where

3+import ProjectM36.Base

4+import ProjectM36.Error

5+import qualified Data.Set as S

6+import qualified Data.Map as M

7+import qualified ProjectM36.TypeConstructorDef as TCD

8+import ProjectM36.Relation

9+import Control.Monad (foldM)

10+import qualified Data.HashSet as HS

11+

12+data MergePreference = PreferFirst | PreferSecond | PreferNeither

13+

14+-- Check for overlapping keys. If the values differ, try a preference resolution

15+unionMergeMaps :: (Ord k, Eq k, Eq a) => MergePreference -> M.Map k a -> M.Map k a -> Either MergeError (M.Map k a)

16+unionMergeMaps prefer mapA mapB = case prefer of

17+ PreferFirst -> pure $ M.union mapA mapB

18+ PreferSecond -> pure $ M.union mapB mapA

19+ PreferNeither -> if M.intersection mapA mapB == M.intersection mapA mapB then

20+ pure $ M.union mapA mapB

21+ else

22+ Left $ StrategyViolatesComponentMergeError

23+

24+-- perform the merge even if the attributes are different- is this what we want? Obviously, we need finer-grained merge options.

25+unionMergeRelation :: MergePreference -> Relation -> Relation -> Either MergeError Relation

26+unionMergeRelation prefer relA relB = case union relA relB of

27+ Right unionRel -> pure unionRel

28+ Left (AttributeNamesMismatchError _) -> preferredRelVar

29+ Left _ -> Left StrategyViolatesRelationVariableMergeError

30+ where

31+ preferredRelVar = case prefer of

32+ PreferFirst -> Right relA

33+ PreferSecond -> Right relB

34+ PreferNeither -> Left StrategyViolatesRelationVariableMergeError

35+

36+--try to execute unions against the relvars contents -- if a relvar only appears in one context, include it

37+unionMergeRelVars :: MergePreference -> RelationVariables -> RelationVariables -> Either MergeError RelationVariables

38+unionMergeRelVars prefer relvarsA relvarsB = do

39+ let allNames = S.toList (S.union (M.keysSet relvarsA) (M.keysSet relvarsB))

40+ foldM (\acc name -> do

41+ mergedRel <- do

42+ let findRel = M.lookup name

43+ lookupA = findRel relvarsA

44+ lookupB = findRel relvarsB

45+ case (lookupA, lookupB) of

46+ (Just relA, Just relB) -> do

47+ unionMergeRelation prefer relA relB

48+ (Nothing, Just relB) -> pure relB

49+ (Just relA, Nothing) -> pure relA

50+ (Nothing, Nothing) -> error "impossible relvar naming lookup"

51+ pure $ M.insert name mergedRel acc

52+ ) M.empty allNames

53+

54+-- if two functions have the same name, ensure that the functions are identical, otherwise, conflict or prefer

55+--because we don't have a bytecode, there is no way to verify that function bodies are equal, so if the types match up, just choose the first function. This is a serious bug, but intractable until we have a function bytecode.

56+unionMergeAtomFunctions :: MergePreference -> AtomFunctions -> AtomFunctions -> Either MergeError AtomFunctions

57+unionMergeAtomFunctions prefer funcsA funcsB = case prefer of

58+ PreferFirst -> pure $ HS.union funcsA funcsB

59+ PreferSecond -> pure $ HS.union funcsB funcsA

60+ PreferNeither -> pure $ HS.union funcsA funcsB

61+

62+unionMergeTypeConstructorMapping :: MergePreference -> TypeConstructorMapping -> TypeConstructorMapping -> Either MergeError TypeConstructorMapping

63+unionMergeTypeConstructorMapping prefer typesA typesB = do

64+ let allFuncNames = S.fromList $ map (\(tc,_) -> TCD.name tc) (typesA ++ typesB)

65+ foldM (\acc name -> do

66+ let findType tcm = case filter (\(t,_) -> TCD.name t == name) tcm of

67+ [] -> Nothing

68+ x:[] -> Just x

69+ _ -> error "multiple names matching in TypeConstructorMapping"

70+ lookupA = findType typesA

71+ lookupB = findType typesB

72+ cat t = pure (t : acc)

73+ case (lookupA, lookupB) of

74+ (Nothing, Nothing) -> error "type name lookup failure"

75+ (Just typeA, Nothing) -> cat typeA

76+ (Nothing, Just typeB) -> cat typeB

77+ (Just typeA, Just typeB) -> if typeA == typeB then

78+ cat typeA

79+ else --merge conflict

80+ case prefer of

81+ PreferFirst -> cat typeA

82+ PreferSecond -> cat typeB

83+ PreferNeither -> Left StrategyViolatesTypeConstructorMergeError

84+ ) [] (S.toList allFuncNames)

85+

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 $ transactionParentUUIDs 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+4−6

@@ -2,23 +2,21 @@

22module ProjectM36.TransactionGraph.Show where

33import ProjectM36.Base

44import ProjectM36.TransactionGraph

5+import ProjectM36.Transaction

56import qualified Data.Set as S

7−

88showTransactionStructure :: Transaction -> TransactionGraph -> String

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

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

15+ childTransactionsInfo = show (S.toList (transactionChildIds trans))

1516

1617showGraphStructure :: TransactionGraph -> String

1718showGraphStructure graph@(TransactionGraph _ transSet) = S.foldr folder "" transSet

1819 where

1920 folder trans acc = acc ++ showTransactionStructure trans graph ++ "\n"

2021

21−

22−

23−

2422

ProjectM36/TransactionGraph/Show/Dot.hsnew file+22

@@ -0,0 +1,22 @@

1+module ProjectM36.TransactionGraph.Show.Dot where

2+import ProjectM36.Transaction

3+import ProjectM36.Base

4+import qualified Data.Text as T

5+import qualified Data.Set as S

6+import qualified Data.Map as M

8+graphAsDot :: TransactionGraph -> String

9+graphAsDot (TransactionGraph heads transSet) = "digraph {" ++ dot ++ headInfo ++ "}"

10+ where

11+ dot = S.foldr transactionAsDot "" transSet

12+ transactionAsDot trans acc = acc ++ childArrows trans ++ parentArrows trans

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

14+ childArrows trans = arrows trans (transactionChildIds trans)

15+ parentArrows trans = arrows trans (transactionParentIds trans)

16+ transLabel t = tidLabel (transactionId t)

17+ tidLabel l = "\"" ++ show l ++ "\""

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

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

20+

21+

22+

ProjectM36/Tuple.hs+2−2

@@ -56,7 +56,7 @@ vectorIndicesForAttributeNames attrNameVec attrs = if not $ V.null unknownAttrNa

5656 where

5757 unknownAttrNames = V.filter ((flip V.notElem) (attributeNames attrs)) attrNameVec

5858 mapper attrName = case V.elemIndex attrName (V.map attributeName attrs) of

59− Nothing -> undefined

59+ Nothing -> error "logic failure in vectorIndicesForAttributeNames"

6060 Just index -> index

6161

6262relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation

@@ -198,6 +198,6 @@ reorderTuple attrs tupIn = if tupleAttributes tupIn == attrs then

198198 RelationTuple attrs (V.map mapper attrs)

199199 where

200200 mapper attr = case atomForAttributeName (attributeName attr) tupIn of

201− Left _ -> undefined

201+ Left _ -> error "logic failure in reorderTuple"

202202 Right atom -> atom

203203

ProjectM36/Win32Handle.hsnew file+57

@@ -0,0 +1,57 @@

1+{-# LANGUAGE CPP #-}

2+module ProjectM36.Win32Handle where

3+import System.Win32.Types

4+import Control.Exception (bracket)

5+import Foreign.StablePtr

6+import Foreign.C.Types

7+import Control.Concurrent.MVar

9+#if __GLASGOW_HASKELL__ >= 612

10+import GHC.IO.Handle.Types (Handle(..), Handle__(..))

11+import GHC.IO.FD (FD(..)) -- A wrapper around an Int32

12+import Data.Typeable

13+#else

14+import GHC.IOBase (Handle(..), Handle__(..))

15+import qualified GHC.IOBase as IOBase (FD) -- Just an Int32

16+#endif

17+

18+-- This essential function comes from the C runtime system. It is certainly provided by msvcrt, and also seems to be provided by the mingw C library - hurrah!

19+#if __GLASGOW_HASKELL__ >= 612

20+foreign import ccall unsafe "_get_osfhandle" cget_osfhandle :: CInt -> IO HANDLE

21+#else

22+foreign import ccall unsafe "_get_osfhandle" cget_osfhandle :: IOBase.FD -> IO HANDLE

23+#endif

24+

25+-- copied from ansi-terminal package

26+-- | This bit is all highly dubious. The problem is that we want to output ANSI to arbitrary Handles rather than forcing

27+-- people to use stdout. However, the Windows ANSI emulator needs a Windows HANDLE to work it's magic, so we need to be able

28+-- to extract one of those from the Haskell Handle.

29+--

30+-- This code accomplishes this, albeit at the cost of only being compatible with GHC.

31+withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a

32+withHandleToHANDLE haskell_handle action =

33+ -- Create a stable pointer to the Handle. This prevents the garbage collector

34+ -- getting to it while we are doing horrible manipulations with it, and hence

35+ -- stops it being finalized (and closed).

36+ withStablePtr haskell_handle $ const $ do

37+ -- Grab the write handle variable from the Handle

38+ let write_handle_mvar = case haskell_handle of

39+ FileHandle _ handle_mvar -> handle_mvar

40+ DuplexHandle _ _ handle_mvar -> handle_mvar -- This is "write" MVar, we could also take the "read" one

41+

42+ -- Get the FD from the algebraic data type

43+#if __GLASGOW_HASKELL__ < 612

44+ fd <- fmap haFD $ readMVar write_handle_mvar

45+#else

46+ --readMVar write_handle_mvar >>= \(Handle__ { haDevice = dev }) -> print (typeOf dev)

47+ Just fd <- fmap (\(Handle__ { haDevice = dev }) -> fmap fdFD (cast dev)) $ readMVar write_handle_mvar

48+#endif

49+

50+ -- Finally, turn that (C-land) FD into a HANDLE using msvcrt

51+ windows_handle <- cget_osfhandle fd

52+

53+ -- Do what the user originally wanted

54+ action windows_handle

55+

56+withStablePtr :: a -> (StablePtr a -> IO b) -> IO b

57+withStablePtr value = bracket (newStablePtr value) freeStablePtr

README.markdown+12−7

@@ -34,16 +34,21 @@ Project:M36 supports multiple frontends which target different audiences.

34341. [ACID Database Properties](docs/acid_assessment.markdown)

35351. [Serving Remote ProjectM36 Databases](docs/server_mode.markdown)

36361. [Using Notifications](docs/using_notifications.markdown)

37+1. [Merge Transactions](docs/merge_transactions.markdown)

37381. [Reaching "Out of the Tarpit" with Project:M36](docs/reaching_out_of_the_tarpit.markdown)

3839

3940## Development

4041

41−Project:M36 is developed in Haskell and compiled with GHC.

42+Project:M36 is developed in Haskell and compiled with GHC 7.8 or later.

4243

43−Important modules:

44+## Related Projects

4445

45−1. Relation - represents a relation in the relational algebra and implements the relational operators

46−2. Relational Expressions - represents a composable abstract syntax tree for the relational algebra

47−3. Tutorial D Interpreter - one available frontend to evaluate relational expressions

48−4. ProjectM36.Client- user-facing native Haskell library

49−5. Database.Persist.ProjectM36 - persistent library database driver

46+* [The Third Manifesto](http://thethirdmanifesto.com/): the philosophical basis for relational algebra engines

47+* [Rel](http://reldb.org/): a TutorialD implementation against a BerkeleyDB backend

48+* [Andl](http://andl.org/): a new database language with SQLite and PostgreSQL backends

49+

50+## Suggested Reading

51+

52+* [Out of the Tarpit](http://shaffner.us/cs/papers/tarpit.pdf): a proposed software architecture which minimizes state and complexity. Project:M36 implements the requirements of this paper.

53+* [Database Design & Relational Theory: Normal Forms and All That Jazz](http://shop.oreilly.com/product/0636920025276.do): mathematical foundations for the principles of the relational algebra

54+* [Database Explorations: Essays on the Third Manifesto and Related Topics](http://bookstore.trafford.com/Products/SKU-000177853/Database-Explorations.aspx): additional essays and debates on practical approaches to relational algebra engine design

TutorialD/Interpreter.hs+14−6

@@ -2,8 +2,9 @@

22module TutorialD.Interpreter where

33import TutorialD.Interpreter.Base

44import TutorialD.Interpreter.RODatabaseContextOperator

5−import TutorialD.Interpreter.DatabaseExpr

5+import TutorialD.Interpreter.DatabaseContextExpr

66import TutorialD.Interpreter.TransactionGraphOperator

7+import TutorialD.Interpreter.InformationOperator

89import TutorialD.Interpreter.Import.CSV

910import TutorialD.Interpreter.Import.TutorialD

@@ -33,7 +34,8 @@ database ops are read-write operations which change the database context (such a

3334graph ops are read-write operations which change the transaction graph

3435-}

3536data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |

36− DatabaseExprOp DatabaseExpr |

37+ DatabaseContextExprOp DatabaseContextExpr |

38+ InfoOp InformationOperator |

3739 GraphOp TransactionGraphOperator |

3840 ROGraphOp ROTransactionGraphOperator |

3941 ImportRelVarOp RelVarDataImportOperator |

@@ -42,9 +44,10 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |

4244

4345interpreterParserP :: Parser ParsedOperation

4446interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>

47+ liftM InfoOp (infoOpP <* eof) <|>

4548 liftM GraphOp (transactionGraphOpP <* eof) <|>

4649 liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>

47− liftM DatabaseExprOp (databaseExprOpP <* eof) <|>

50+ liftM DatabaseContextExprOp (databaseExprOpP <* eof) <|>

4851 liftM ImportRelVarOp (importCSVP <* eof) <|>

4952 liftM ImportDBContextOp (tutdImportP <* eof) <|>

5053 liftM RelVarExportOp (exportCSVP <* eof)

@@ -66,7 +69,7 @@ evalTutorialD sessionId conn expr = case expr of

6669 (RODatabaseContextOp execOp) -> do

6770 evalRODatabaseContextOp sessionId conn execOp

6871

69− (DatabaseExprOp execOp) -> do

72+ (DatabaseContextExprOp execOp) -> do

7073 maybeErr <- C.executeDatabaseContextExpr sessionId conn execOp

7174 case maybeErr of

7275 Just err -> barf err

@@ -94,13 +97,18 @@ evalTutorialD sessionId conn expr = case expr of

9497 exprErr <- evalRelVarDataImportOperator execOp (attributes importType)

9598 case exprErr of

9699 Left err -> barf err

97− Right dbexpr -> evalTutorialD sessionId conn (DatabaseExprOp dbexpr)

100+ Right dbexpr -> evalTutorialD sessionId conn (DatabaseContextExprOp dbexpr)

98101

99102 (ImportDBContextOp execOp) -> do

100103 mDbexprs <- evalDatabaseContextDataImportOperator execOp

101104 case mDbexprs of

102105 Left err -> barf err

103− Right dbexprs -> evalTutorialD sessionId conn (DatabaseExprOp dbexprs)

106+ Right dbexprs -> evalTutorialD sessionId conn (DatabaseContextExprOp dbexprs)

107+

108+ (InfoOp execOp) -> do

109+ case evalInformationOperator execOp of

110+ Left err -> barf err

111+ Right info -> pure (DisplayResult info)

104112

105113 (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) -> do

106114 --eval relexpr to relation and pass to export function

TutorialD/Interpreter/DatabaseExpr.hs → TutorialD/Interpreter/DatabaseContextExpr.hsrenamed+26−26

@@ -1,5 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2−module TutorialD.Interpreter.DatabaseExpr where

2+module TutorialD.Interpreter.DatabaseContextExpr where

33import Text.Parsec

44import Text.Parsec.String

55import ProjectM36.Base

@@ -15,7 +15,7 @@ import ProjectM36.RelationalExpression

1515import ProjectM36.Key

1616

1717--parsers which create "database expressions" which modify the database context (such as relvar assignment)

18−databaseExprP :: Parser DatabaseExpr

18+databaseExprP :: Parser DatabaseContextExpr

1919databaseExprP = choice $ map (\p -> p <* optional commentP) [insertP,

2020 deleteConstraintP,

2121 deleteP,

@@ -31,13 +31,13 @@ databaseExprP = choice $ map (\p -> p <* optional commentP) [insertP,

3131 removeTypeConstructorP,

3232 nothingP]

3333

34−commentP :: Parser DatabaseExpr

34+commentP :: Parser DatabaseContextExpr

3535commentP = reserved "--" >> manyTill anyChar eof >> pure NoOperation

3636

37−nothingP :: Parser DatabaseExpr

37+nothingP :: Parser DatabaseContextExpr

3838nothingP = whiteSpace >> pure NoOperation

3939

40−assignP :: Parser DatabaseExpr

40+assignP :: Parser DatabaseContextExpr

4141assignP = do

4242 relVarName <- try $ do

4343 relVarName <- identifier

@@ -46,19 +46,19 @@ assignP = do

4646 expr <- relExprP

4747 return $ Assign (T.pack relVarName) expr

4848

49−multipleDatabaseExprP :: Parser DatabaseExpr

50−multipleDatabaseExprP = do

49+multipleDatabaseContextExprP :: Parser DatabaseContextExpr

50+multipleDatabaseContextExprP = do

5151 exprs <- sepBy1 databaseExprP semi

5252 return $ MultipleExpr exprs

5353

54−insertP :: Parser DatabaseExpr

54+insertP :: Parser DatabaseContextExpr

5555insertP = do

5656 reservedOp "insert"

5757 relvar <- identifier

5858 expr <- relExprP

5959 return $ Insert (T.pack relvar) expr

6060

61−defineP :: Parser DatabaseExpr

61+defineP :: Parser DatabaseContextExpr

6262defineP = do

6363 relVarName <- try $ do

6464 relVarName <- identifier

@@ -67,20 +67,20 @@ defineP = do

6767 attributeSet <- makeAttributeExprsP

6868 return $ Define (T.pack relVarName) attributeSet

6969

70−undefineP :: Parser DatabaseExpr

70+undefineP :: Parser DatabaseContextExpr

7171undefineP = do

7272 reservedOp "undefine"

7373 relVarName <- identifier

7474 return $ Undefine (T.pack relVarName)

7575

76−deleteP :: Parser DatabaseExpr

76+deleteP :: Parser DatabaseContextExpr

7777deleteP = do

7878 reservedOp "delete"

7979 relVarName <- identifier

8080 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)

8181 return $ Delete (T.pack relVarName) predicate

8282

83−updateP :: Parser DatabaseExpr

83+updateP :: Parser DatabaseContextExpr

8484updateP = do

8585 reservedOp "update"

8686 relVarName <- identifier

@@ -90,7 +90,7 @@ updateP = do

9090

9191data IncDepOp = SubsetOp | EqualityOp

9292

93−addConstraintP :: Parser DatabaseExpr

93+addConstraintP :: Parser DatabaseContextExpr

9494addConstraintP = do

9595 reservedOp "constraint" <|> reservedOp "foreign key"

9696 constraintName <- identifier

@@ -106,14 +106,14 @@ addConstraintP = do

106106

107107

108108

109−deleteConstraintP :: Parser DatabaseExpr

109+deleteConstraintP :: Parser DatabaseContextExpr

110110deleteConstraintP = do

111111 reserved "deleteconstraint"

112112 constraintName <- identifier

113113 return $ RemoveInclusionDependency (T.pack constraintName)

114114

115115-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>

116−keyP :: Parser DatabaseExpr

116+keyP :: Parser DatabaseContextExpr

117117keyP = do

118118 reserved "key"

119119 keyName <- identifier

@@ -129,7 +129,7 @@ attributeAssignmentP = do

129129 atom <- stringAtomP <|> intAtomP

130130 return $ (attrName, atom)

131131

132−addNotificationP :: Parser DatabaseExpr

132+addNotificationP :: Parser DatabaseContextExpr

133133addNotificationP = do

134134 reserved "notify"

135135 notName <- identifier

@@ -137,14 +137,14 @@ addNotificationP = do

137137 resultExpr <- relExprP

138138 return $ AddNotification (T.pack notName) triggerExpr resultExpr

139139

140−removeNotificationP :: Parser DatabaseExpr

140+removeNotificationP :: Parser DatabaseContextExpr

141141removeNotificationP = do

142142 reserved "unnotify"

143143 notName <- identifier

144144 return $ RemoveNotification (T.pack notName)

145145

146146-- | data Hair = Bald | Color Text

147−addTypeConstructorP :: Parser DatabaseExpr

147+addTypeConstructorP :: Parser DatabaseContextExpr

148148addTypeConstructorP = do

149149 reserved "data"

150150 typeConstructorDef <- typeConstructorDefP

@@ -152,26 +152,26 @@ addTypeConstructorP = do

152152 dataConstructorDefs <- sepBy1 dataConstructorDefP pipe

153153 pure (AddTypeConstructor typeConstructorDef dataConstructorDefs)

154154

155−removeTypeConstructorP :: Parser DatabaseExpr

155+removeTypeConstructorP :: Parser DatabaseContextExpr

156156removeTypeConstructorP = do

157157 reserved "undata"

158158 RemoveTypeConstructor <$> liftM T.pack identifier

159159

160−databaseExprOpP :: Parser DatabaseExpr

161−databaseExprOpP = multipleDatabaseExprP

160+databaseExprOpP :: Parser DatabaseContextExpr

161+databaseExprOpP = multipleDatabaseContextExprP

162162

163−evalDatabaseExpr :: Bool -> DatabaseContext -> DatabaseExpr -> Either RelationalError DatabaseContext

164−evalDatabaseExpr useOptimizer context expr = do

163+evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext

164+evalDatabaseContextExpr useOptimizer context expr = do

165165 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) context

166166 case runState (evalContextExpr (if useOptimizer then optimizedExpr else expr)) context of

167167 (Nothing, context') -> Right context'

168168 (Just err, _) -> Left err

169169

170170

171−interpretDatabaseExpr :: DatabaseContext -> String -> Either RelationalError DatabaseContext

172−interpretDatabaseExpr context tutdstring = case parse databaseExprOpP "" tutdstring of

171+interpretDatabaseContextExpr :: DatabaseContext -> String -> Either RelationalError DatabaseContext

172+interpretDatabaseContextExpr context tutdstring = case parse databaseExprOpP "" tutdstring of

173173 Left err -> Left $ ParseError (T.pack (show err))

174− Right parsed -> evalDatabaseExpr True context parsed

174+ Right parsed -> evalDatabaseContextExpr True context parsed

175175

176176{-

177177--no optimization

TutorialD/Interpreter/Import/Base.hs+4−4

@@ -3,15 +3,15 @@ import ProjectM36.Base

33import ProjectM36.Error

55-- | import data into a relation variable

6−data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseExpr))

6+data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))

88-- | import data into a database context

9−data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator FilePath (FilePath -> IO (Either RelationalError DatabaseExpr))

9+data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator FilePath (FilePath -> IO (Either RelationalError DatabaseContextExpr))

1010

1111-- perhaps create a structure to import a whole transaction graph section in the future

1212

13−evalRelVarDataImportOperator :: RelVarDataImportOperator -> Attributes -> IO (Either RelationalError DatabaseExpr)

13+evalRelVarDataImportOperator :: RelVarDataImportOperator -> Attributes -> IO (Either RelationalError DatabaseContextExpr)

1414evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) attrs = importFunc relVarName attrs path

1515

16−evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseExpr)

16+evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseContextExpr)

1717evalDatabaseContextDataImportOperator (DatabaseContextDataImportOperator path importFunc) = importFunc path

TutorialD/Interpreter/Import/CSV.hs+1−1

@@ -9,7 +9,7 @@ import Text.Parsec.String

99import TutorialD.Interpreter.Base

1010import Control.Exception

1111

12−importCSVRelation :: RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseExpr)

12+importCSVRelation :: RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr)

1313importCSVRelation relVarName attrs pathIn = do

1414 --TODO: handle filesystem errors

1515 csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)

TutorialD/Interpreter/Import/TutorialD.hs+2−2

@@ -2,7 +2,7 @@ module TutorialD.Interpreter.Import.TutorialD where

22import ProjectM36.Base

33import TutorialD.Interpreter.Import.Base

44import TutorialD.Interpreter.Base

5−import TutorialD.Interpreter.DatabaseExpr

5+import TutorialD.Interpreter.DatabaseContextExpr

66import Text.Parsec.String

77import Text.Parsec hiding (try)

88import ProjectM36.Error

@@ -11,7 +11,7 @@ import qualified Data.Text as T

1111import Control.Exception

1212--import a file containing TutorialD database context expressions

1313

14−importTutorialD :: FilePath -> IO (Either RelationalError DatabaseExpr)

14+importTutorialD :: FilePath -> IO (Either RelationalError DatabaseContextExpr)

1515importTutorialD pathIn = do

1616 tutdData <- try (readFile pathIn) :: IO (Either IOError String)

1717 case tutdData of

TutorialD/Interpreter/InformationOperator.hsnew file+57

@@ -0,0 +1,57 @@

1+{-# LANGUAGE CPP, OverloadedStrings #-}

2+module TutorialD.Interpreter.InformationOperator where

3+import Data.Text

4+import Text.Parsec

5+import Text.Parsec.String

6+import TutorialD.Interpreter.Base

8+-- this module provides information about the current interpreter

10+data InformationOperator = HelpOperator |

11+ GetVersionOperator

12+

13+infoOpP :: Parser InformationOperator

14+infoOpP = helpOpP <|> getVersionP

15+

16+helpOpP :: Parser InformationOperator

17+helpOpP = reserved ":help" >> pure HelpOperator

18+

19+getVersionP :: Parser InformationOperator

20+getVersionP = reserved ":version" >> pure GetVersionOperator

21+

22+evalInformationOperator :: InformationOperator -> Either Text Text

23+evalInformationOperator GetVersionOperator = Right ("tutd " `append` PROJECTM36_VERSION)

24+-- display generic help

25+evalInformationOperator HelpOperator = Right $ intercalate "\n" help

26+ where

27+ help = ["tutd Help",

28+ "Quick Examples:",

29+ ":showexpr true",

30+ ":showexpr relation{name Text, address Text}{tuple{name \"Steve\", address \"Main St.\"}}",

31+ "address := relation{tuple{name \"Steve\", address \"Main St.\"}}",

32+ ":showexpr true join false = false",

33+ "Relational Operators:",

34+ ":showexpr relation{a Int, b Text}{} -- relation creation",

35+ ":showexpr relation{tuple{c t}} -- relation creation",

36+ ":showexpr relation{tuple{a 4, b 4}}{a} -- projection",

37+ ":showexpr relation{tuple{a 5}} rename {a as num} -- rename",

38+ ":showexpr relation{tuple{d 10}} where d=10 or d=5 -- restriction",

39+ ":showexpr relation{tuple{d 10}} : {e:=add(@d,5)} -- extension",

40+ "Database Context Operators:",

41+ "animal := relation{tuple{name \"octopus\", legs_count 8}} -- assignment",

42+ "insert animal relation{tuple{name \"cat\", legs_count 4}} -- insertion",

43+ "car :: {model Text, make Text, year Int} -- definition",

44+ "undefine car -- undefine",

45+ "delete animal where legs_count=4 -- deletion",

46+ "update animal where name=\"octopus\" (name:=\"Mr. Octopus\") -- updating",

47+ "employee:=relation{id Int, name Text, age Int}{}; key emp_unique_id {id} employee --uniqueness constraint",

48+ "constraint age_gt_zero (employee{age} where ^lt(@age,0)){} equals false -- constraint",

49+ "notify teenager_added employee where ^lt(@age,20) and ^gte(@age,13) employee{age} where ^lt(@age,20) and ^gte(@age,13) -- change notification",

50+ "Graph Operators: ",

51+ ":jumphead <head_name> - change the current database context to point to a current head",

52+ ":jump <transaction_id> - change the current database context to that of a past transaction",

53+ ":commit - push the current context into the current head and make it immutable",

54+ ":rollback - discard any changes made in the current context",

55+ ":showgraph - display the transaction graph",

56+ "View more documentation at: https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown"

57+ ]

TutorialD/Interpreter/RODatabaseContextOperator.hs+2−2

@@ -6,7 +6,7 @@ import Text.Parsec

66import Text.Parsec.String

77import TutorialD.Interpreter.Base

88import TutorialD.Interpreter.RelationalExpr

9−import TutorialD.Interpreter.DatabaseExpr

9+import TutorialD.Interpreter.DatabaseContextExpr

1010import Control.Monad.State

1111import qualified Data.Text as T

1212import ProjectM36.Relation.Show.Term

@@ -20,7 +20,7 @@ data RODatabaseContextOperator where

2020 PlotRelation :: RelationalExpr -> RODatabaseContextOperator

2121 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator

2222 ShowConstraint :: StringType -> RODatabaseContextOperator

23− ShowPlan :: DatabaseExpr -> RODatabaseContextOperator

23+ ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator

2424 ShowTypes :: RODatabaseContextOperator

2525 ShowRelationVariables :: RODatabaseContextOperator

2626 Quit :: RODatabaseContextOperator

TutorialD/Interpreter/TransactionGraphOperator.hs+20

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

4242showGraphP = do

4343 reservedOp ":showgraph"

4444 return $ ShowGraph

45+

46+mergeTransactionStrategyP :: Parser MergeStrategy

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

48+ (do

49+ reserved "selectedbranch"

50+ branch <- identifier

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

52+ (do

53+ reserved "unionpreferbranch"

54+ branch <- identifier

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

56+

57+mergeTransactionsP :: Parser TransactionGraphOperator

58+mergeTransactionsP = do

59+ reservedOp ":mergetrans"

60+ strategy <- mergeTransactionStrategyP

61+ headA <- identifier

62+ headB <- identifier

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

4564

4665transactionGraphOpP :: Parser TransactionGraphOperator

4766transactionGraphOpP = do

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

5069 <|> branchTransactionP

5170 <|> commitTransactionP

5271 <|> rollbackTransactionP

72+ <|> mergeTransactionsP

5373

5474roTransactionGraphOpP :: Parser ROTransactionGraphOperator

5575roTransactionGraphOpP = showGraphP

TutorialD/tutd.hs+13−2

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE OverloadedStrings, CPP #-}

22import TutorialD.Interpreter

33import ProjectM36.Base

44import ProjectM36.Client

@@ -59,6 +59,16 @@ headNameForConfig (RemoteInterpreterConfig _ _ headn) = headn

5959errDie :: String -> IO ()

6060errDie err = hPutStrLn stderr err >> exitFailure

6161

62+#ifndef PROJECTM36_VERSION

63+#error PROJECTM36_VERSION is not defined

64+#endif

65+printWelcome :: IO ()

66+printWelcome = do

67+ putStrLn $ "Project:M36 TutorialD Interpreter " ++ PROJECTM36_VERSION

68+ putStrLn "Type \":help\" for more information."

69+ putStrLn "A full tutorial is available at:"

70+ putStrLn "https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown"

71+

6272main :: IO ()

6373main = do

6474 interpreterConfig <- execParser opts

@@ -72,7 +82,8 @@ main = do

7282 eSessionId <- createSessionAtHead connHeadName conn

7383 case eSessionId of

7484 Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)

75− Right sessionId -> do

85+ Right sessionId -> do

86+ printWelcome

7687 _ <- reprLoop interpreterConfig sessionId conn

7788 pure ()

7889

benchmark/bigrel.hs+2−2

@@ -8,7 +8,7 @@ import qualified ProjectM36.Attribute as A

88import qualified Data.Text as T

99import ProjectM36.Relation.Show.CSV

1010import ProjectM36.Relation.Show.HTML

11−import TutorialD.Interpreter.DatabaseExpr (interpretDatabaseExpr)

11+import TutorialD.Interpreter.DatabaseContextExpr (interpretDatabaseContextExpr)

1212import ProjectM36.RelationalExpression

1313import qualified Data.HashSet as HS

1414import qualified Data.ByteString.Lazy.Char8 as BS

@@ -58,7 +58,7 @@ matrixRun (BigrelArgs attributeCount tupleCount tutd) = do

5858 else do

5959 let setx = Assign "x" (ExistingRelation (force rel))

6060 context = execState (evalContextExpr setx) dateExamples

61− interpreted = interpretDatabaseExpr context tutd

61+ interpreted = interpretDatabaseContextExpr context tutd

6262 --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd

6363 --displayOpResult plan

6464 case interpreted of

docs/introduction_to_projectm36.markdown+19−13

@@ -13,23 +13,34 @@ The relational algebra is the mathematical model underpinning Project:M36. When

1313* more opportunities for interesting optimizations

1414* elimination of odd and easy-to-forget corner cases (such as found when dealing with SQL's NULL)

1515

16−## Software Dependencies & Installation

16+## Binary Releases

17+

18+### Windows

19+Project:M36 now provides binary installations for Windows. Check the (releases page)[https://github.com/agentm/project-m36/releases] for downloads.

20+

21+### MacOS X

22+

23+Binary releases are not yet available for MacOS X, but compiling from source is easy.

24+

25+### Linux

26+

27+The currently-preferred method of installation is from source. A future enhancement would be installation from deb or rpm.

28+

29+## Source Installation

1730

1831Requirements:

1932

2033* [GHC 7.10 or greater](https://www.haskell.org/downloads)

21−* cabal-install 1.20 or greater (normally part of the Haskell installation

22−* POSIX filesystem

34+* [Haskell stack](https://docs.haskellstack.org/en/stable/README/)

35+* Linux, MacOS X, or Windows OS

2336

2437Compilation steps:

2538

2639* ```git clone https://github.com/agentm/project-m36```

2740* ```cd project-m36```

28−* ```cabal sandbox init``` (optional but recommended)

29−* ```cabal install```

30−

31−At this point, the TutorialD interactive interpreter can be run using ```cabal run tutd```.

41+* ```stack build```

3242

43+At this point, the TutorialD interactive interpreter can be run using ```stack exec tutd```.

3344

3445## Accessing Project:M36 Databases

3546

@@ -47,7 +58,7 @@ In addition to being a relational algebra engine, Project:M36 supports features

4758

4859### Transaction Graph

4960

50−Most DBMSs provide a way to allow the user to specify atomic database state changes. These changes are often wrapped up as "transactions" which, when applied to the database state, offer the illusion of sequential and grouped, atomic changes applied to the databases. Often the only state which can be queried is the snapshot at the time the transaction is opened.

61+Most DBMSs provide a way to allow the user to specify atomic database state changes. These changes are often wrapped up as "transactions" which, when applied to the database state, offer the illusion of sequential and grouped, atomic changes applied to the databases. Often the only state which can be queried is the snapshot at the time the transaction is opened.

5162

5263Project:M36 extends this transaction model with the "transaction graph". This feture can be adequately described as version control for transactions. In the legacy DBMS model, the transactions are added to a linear transaction stream where each client is contending over the "head" of the stream- the latest transactions. In the transaction graph model, clients can add named branches and add transactions to the branches, then merge changes back, if necessary.

5364

@@ -94,8 +105,3 @@ Though the CSV ("comma-separated values") format cannot represent all possible r

94105### Relations as Plots

95106

96107N-attributed relations can be visualized as plots where each tuple represents a point in the plot. Project:M36 can generate gnuplot graphs from 2- and 3-attributed relations.

97−

98−

99−

100−

101−

docs/merge_notes.markdownnew file+182

@@ -0,0 +1,182 @@

1+# Automatic Merge Notes

3+These notes present cases where two diverging transaction branches can be automatically merged. Later, we cover transaction branches which cannot be automatically merged without user intervention (either in advance or in real-time).

5+In the following diagrams, "A" is the divergence point (parent) for two branches "B1" and "B2". "B1" and "B2" are subsequently merged to "C".

7+## 1. No-op

9+![graph](http://g.gravizo.com/g?

10+ digraph G {

11+ node [shape=rect];

12+ A -> B1 [label="no change"];

13+ A -> B2 [label="no change"];

14+ B1 -> C [label="merge"];

15+ B2 -> C [label="merge"];

16+ }

17+)

18+

19+In this base case, we see that the merge is always successful if the two branches since the parent transaction A is equivalent to B1, B2, and C.

20+

21+## 2. One transaction changes

22+

23+![graph](http://g.gravizo.com/g?

24+digraph G {

25+node [shape=record];

26+A [label="A|x|a Int|[]"];

27+A -> B1 [label="insert x [4]"];

28+A -> B2 [label="no change"];

29+B1 -> C [label="merge"];

30+B2 -> C [label="merge"];

31+C [label="C|x|a Int|[4]"];

32+}

33+)

34+

35+The resultant merge is equivalent to A->B1->C ignoring B2. Since B2 adds nothing to the transaction stream, an equivalent graph would be the flat A->B1->B2->C. Such an application is similar to how git "merges" uses the fast-forward technique.

36+

37+## 3. Both transactions make equivalent changes

38+

39+![graph](http://g.gravizo.com/g?

40+digraph G {

41+node [shape=record];

42+A [label="A|x|a Int|[]"];

43+A -> B1 [label="insert x relation[tuple[a 4]]"];

44+A -> B2 [label="insert x relation[tuple[a 4]]"];

45+B1 -> C [label="merge"];

46+B2 -> C [label="merge"];

47+C [label="C|x|a Int|[[4]]"];

48+}

49+)

50+

51+Both branches add the "4" tuple, thus the result must also contain "4". There is no conflict here because, unlike in SQL, relations may not contain duplicate tuples, so the merge is unambiguous. Because both branches agree on the "truth", the merge succeeds regardless of the actual changes (insert, delete, update). Thus, the result C is equivalent to executing just one branch of changes.

52+

53+## 4. Two transactions add/remove different tuples

54+

55+![graph](http://g.gravizo.com/g?

56+ digraph G {

57+ node [shape=record];

58+ A [label="A|x|a Int|[]"];

59+ A -> B1 [label="insert x relation[tuple[a 4]]"];

60+ A -> B2 [label="insert x relation[tuple[a 5]]"];

61+ B1 -> C [label="merge"];

62+ B2 -> C [label="merge"];

63+ C [label="C|x|a Int|[[4],[5]]"];

64+ }

65+)

66+

67+Two relations add two unrelated tuples to the relation. We know they are unrelated because the merge does not trigger any constraint violations. A constraint violation during the merge would necessitate conflict resolution. In this case, the result is equivalent to the application of the branches in either order: A->B1->B2->C or A->B2->B1->C.

68+

69+## 5. Two transactions update a tuple with the same key

70+

71+![graph](http://g.gravizo.com/g?

72+digraph G {

73+node [shape=record];

74+A [label="A|employee|id Int,name Text|[[303,\"Dr. Garbez\"]]"];

75+A -> B1 [label="update employee where id=303 [name:=\"Jim Garbez\"]"];

76+A -> B2 [label="update employee where id=303 [name:=\"James Garbez\"]"];

77+B1 -> C [label="merge"];

78+B2 -> C [label="merge"];

79+B1 [label="B1|employee|id Int,name Text|[[303,\"Jim Garbez\"]]"];

80+B2 [label="B2|employee|id Int,name Text|[[303,\"James Garbez\"]]"];

81+C [label="C|employee|id Int,name Text|[[303,???]]"];

82+}

83+)

84+

85+This type of merge will always result in a key constraint violation. Logically, the branches are referring to the same tuple, so the key constraint is logically violated as if the merge engine tried to insert both changed tuples into the result.

86+

87+There are multiple possible conflict resolutions:

88+

89+### 5a. Prefer a branch name

90+

91+If a specifically-named branch is "preferred", the merge can proceed automatically with the other branch being completely discarded. This would be used, for example, when it is known that data flowing into a specific branch is authoritative. Note that this strategy (called "ours/theirs" merging in git) should discard all of a branches changes and not just the conflicted tuple changes.

92+

93+### 5b. Perform some logic to determine how to merge conflicting tuple atoms

94+

95+A stored procedure could determine which branch to choose or even how to merge values at the tuple or atom level. For example, the stored procedure could determine the "name" atom in the merged tuple result to be "Jim or James Garbez" (product) or "J. Garbez" (commonality) or even just "Garbez" (commonality) or the procedure could claim that the longer name is more likely to be correct.

96+

97+In general, the stored procedure could inspect (reading only) the two branches in the tree and make any deterministic decision it wishes to make based solely on those branches (maintaining the purity of the function).

98+

99+### 5c. Use the earlier/later changed

100+

101+The chosen branch is determined by its commit timestamp. The other branch's changes are discarded entirely.

102+

103+### 5d. Revert to shared ancestor

104+

105+Due to ambiguity, the rule could be to revert to the parent ancestor state which is the first knwon consistent state prior to the branching.

106+

107+### 6. User intervention

108+

109+If none of the above strategies result in a non-constraint-violating merge transaction, then the merge must fail, perhaps marking some state for a human to intervene and take action (which may include no action).

110+

111+# Schema changes

112+

113+## 1. Adding/removing a relation

114+

115+![graph](http://g.gravizo.com/g?

116+digraph G {

117+node [shape=record];

118+A;

119+A -> B1 [label="x:=true"];

120+A -> B2 [label="y:=true"];

121+B1 -> C [label="merge"];

122+B2 -> C [label="merge"];

123+C [label="C|x:=true and y:=true"];

124+}

125+)

126+

127+If a relation has no cross-constraints with another relation, then adding either at any point in the timeline cannot interfere with the other.

128+

129+## 2. Changing constraints

130+

131+![graph](http://g.gravizo.com/g?

132+digraph G {

133+node [shape=record];

134+A [label="A|employee[id Int, name Text]|[[3, \"Jim Garbez\"]]"];

135+A -> B1 [label="+ key employee[id]"];

136+A -> B2 [label="+ key employee[name]"];

137+B1 -> C [label="merge"];

138+B2 -> C [label="merge"];

139+C [label="C"];

140+}

141+)

142+

143+From all the examples, this is likely the most interesting since detecting when constraints conflict is not immediately obvious. Consider, for example, if A->B2 added a constraint "+ key employee[id,name]". This would not create a conflict under the conditions that both constraints can be added to the merge without causing a constraint violation, but is that the genuine intention of the user?

144+

145+Consider this example:

146+

147+![graph](http://g.gravizo.com/g?

148+digraph G {

149+node [shape=record];

150+A [label="A|integers[i Int]|[]"];

151+A -> B1 [label="+ constraint i<0"];

152+A -> B2 [label="+ constraint i>0"];

153+B1 -> C [label="merge"];

154+B2 -> C [label="merge"];

155+C [label="C"];

156+}

157+)

158+

159+The end result is a relation "i" which cannot contain any tuples. Clearly, neither branch intended this to be the case, so does it make sense to merely concatenate the constraints?

160+

161+## In general

162+

163+The function to perform the merge should be of type:

164+

165+```haskell

166+mergeBranches :: TransactionGraph -> BranchName -> BranchName -> TransactionGraph

167+mergeBranches subGraph branchNameA branchNameB = ...

168+```

169+

170+The subGraph argument is a subGraph of the entire database transaction graph starting at the common ancestor and including all transactions from both branches until the potential merge point. This is a sub graph because I have not been able to think of a circumstance where more context would be necessary. For convenience, the merge system should also include a transaction diff function of type:

171+

172+```haskell

173+diffTransactions :: Transaction -> Transaction -> DatabaseContextExpr

174+```

175+

176+This function should make a best effort to compress the actual differences into as few actions as possible, though further research will likely discover a canonical representation. Specifically, when diff'ing two transaction in sequence, this function should hopefully return the minimal statements needed to get from one transaction state to the next. This diff function's result can then be analyzed by the merge function in its decision-making.

177+

178+Each merge strategy can be implemented using separate functions of the above type, but deciding which to apply or which strategy should win automatically is likely an open research problem. Likely, this decision-making must be left up to the database developer who has the full context needed in order to make the decision.

179+

180+In addition, it would seem valuable to the algorithms to determine which constraints would be violated without executing the action. Even if this were determinable some of the time, it would appear to be a valuable optimization.

181+

182+The parallels between transaction merging and parallel lock management should not be underestimated. However, instead of critical sections, constraints appear to be able to represent additional complexity not usually attributed to locking.

docs/merge_transactions.markdownnew file+149

@@ -0,0 +1,149 @@

1+# Merge Transactions in Project:M36

3+## Introduction

5+Common database management systems offer one transaction "stream" whereby multiple database users are simultaneously contending for commits to access or change a single database state. Database management systems implement complex locking and caching in order to simulate concurrent access to this state.

7+Project:M36 allows for user-defined named "heads" which represent states (branches) onto which users can tack on additional transactions. This feature enables:

9+* experimental changes which may or may not be merged back to the main state of the database

10+* reduced contention over a single head

11+* genuinely transaction-safe DDL (schema definition changes) without locking, caveats, or abstraction leaks

12+* merge transactions according to business logic

13+* elimination of "serialization errors"

14+

15+Programmers are likely familiar with this workflow since this behavior is analogous to source version control branching and merging. Project:M36 uses terminology from [git version control](https://git-scm.com/).

16+

17+## Command Summary

18+

19+|Command|Explanation|

20+|-------|-----------|

21+|:branch <branch name>|Create a new branch.|

22+|:jumphead <head name>|Jump to the named head.|

23+|:jump <transaction id>|Jump to an arbitrarily-identified transaction. This allows the session's context to travel back in time to a part of the graph which is not a head.|

24+|:showgraph|Display the transaction graph as a relation.|

25+|:mergetrans <merge strategy> <branchA> <branchB>|Merge one branch onto another. This requires that the current context is on one of the heads. The "merge strategy" is one of "union", "unionpreferbranch <branch name>" , or "selectedbranch".|

26+

27+## Merge Strategies

28+

29+### Selected Branch Merge

30+

31+The naivest merge strategy is to pull in the database context of one branch while discarding the context of a second branch. This merge strategy is useful for marking the end of an experimental branch that is to be considered discarded or a dead end. This merge strategy always succeeds.

32+

33+### Union Merge

34+

35+The union merge strategy attempts to merge the components of the two branches' database contexts. These components are:

36+

37+* inclusion dependencies (constraints)

38+* atom functions

39+* notifications

40+* types

41+* relation variables

42+

43+If both branches have a atom function, etc. of the same name, then the merge fails with an unresolvable conflict.

44+

45+As a special case for relation variables, if both branches have a relation variable of the same name and type (same attributes), then the resultant merged relation variable is a union of both branches' relation variables.

46+

47+### Union Prefer Branch Merge

48+

49+The union-prefer-branch merge is identical to union merge except that, when encountering a conflict case as described above, the strategy chooses a component from the preferred branch. Thus, this merge strategy always succeeds.

50+

51+## Additional Strategies

52+

53+Project:M36 will support more complex merge strategies in the future. In particular, business logic will likely dictate that Project:M36 support user-defined strategies, though this is not yet supported.

54+

55+## TutorialD Usage

56+

57+Branching and merging are built-in to the Project:M36 ```tutd``` client.

58+

59+First, let's create a new branch for some new sales data.

60+```

61+TutorialD (master): :branch add_sales_feature

62+TutorialD (add_sales_feature):

63+```

64+

65+Note how the name in parentheses changes as we create and implicitly jump to the new "add_sales_feature" branch.

66+

67+Next, we will add the sales data.

68+

69+```

70+TutorialD (add_sales_feature): sales := relation{tuple{amount 45, product "peanuts"},tuple{amount 20, product "onions"}}

71+TutorialD (add_sales_feature): :showexpr sales

72+┌───────────┬─────────────┐

73+│amount::Int│product::Text│

74+├───────────┼─────────────┤

75+│45 │"peanuts" │

76+│20 │"onions" │

77+└───────────┴─────────────┘

78+TutorialD (add_sales_feature): :commit

79+```

80+

81+Now, the relation variable "sales" is available on the "add_sales_feature" branch, but *not* the "master" branch. Let's verify this.

82+

83+```

84+TutorialD (add_sales_feature): :jumphead master

85+TutorialD (master): :showexpr sales

86+ERR: RelVarNotDefinedError "sales"

87+```

88+

89+Now that we are on the "master" branch, let's add a relation variables unrelated to sales.

90+

91+```

92+TutorialD (master): employees := relation{tuple{name "Steve"},tuple{name "Cindy"}}

93+TutorialD (master): :commit

94+```

95+

96+Note that the "employees" relation variable is only available on the "master" branch and not on the "add_sales_feature" branch.

97+

98+Let's look at the transaction graph:

99+

100+```

101+TutorialD (master): :showgraph

102+┌─────────────┬───────────────────┬──────────────────────────────────────┬────────────────────────────────────────┐

103+│current::Bool│head::Text │id::Text │parents::relation {id::Text} │

104+├─────────────┼───────────────────┼──────────────────────────────────────┼────────────────────────────────────────┤

105+│False │"" │"0d3bf914-1695-4f95-ab93-6c543d7b3dfa"│┌──────────────────────────────────────┐│

106+│ │ │ ││id::Text ││

107+│ │ │ │├──────────────────────────────────────┤│

108+│ │ │ ││"0e51d95b-5578-4190-802b-9ef280a7f386"││

109+│ │ │ │└──────────────────────────────────────┘│

110+│False │"add_sales_feature"│"8b4d4eaf-31a3-4e48-85d3-bf6e8ac101ea"│┌──────────────────────────────────────┐│

111+│ │ │ ││id::Text ││

112+│ │ │ │├──────────────────────────────────────┤│

113+│ │ │ ││"0d3bf914-1695-4f95-ab93-6c543d7b3dfa"││

114+│ │ │ │└──────────────────────────────────────┘│

115+│False │"" │"0e51d95b-5578-4190-802b-9ef280a7f386"│┌────────┐ │

116+│ │ │ ││id::Text│ │

117+│ │ │ │└────────┘ │

118+│True │"master" │"e4228cb8-e792-48c9-b987-7d78fb1abe04"│┌──────────────────────────────────────┐│

119+│ │ │ ││id::Text ││

120+│ │ │ │├──────────────────────────────────────┤│

121+│ │ │ ││"0e51d95b-5578-4190-802b-9ef280a7f386"││

122+│ │ │ │└──────────────────────────────────────┘│

123+└─────────────┴───────────────────┴──────────────────────────────────────┴────────────────────────────────────────┘

124+

125+```

126+

127+```:showgraph``` shows us which database context is "current" and which parents are linked to each transaction.

128+

129+Now, imagine that the work on the "add_sales_merge" branch is complete, so we will merge the "add_sales_feature" branch back into the "master" branch. We say we are merging "back" because both branches share a common ancestor transaction.

130+

131+```

132+TutorialD (master): :mergetrans union add_sales_feature master

133+TutorialD (master): :showexpr employees

134+┌──────────┐

135+│name::Text│

136+├──────────┤

137+│"Steve" │

138+│"Cindy" │

139+└──────────┘

140+TutorialD (master): :showexpr sales

141+┌───────────┬─────────────┐

142+│amount::Int│product::Text│

143+├───────────┼─────────────┤

144+│45 │"peanuts" │

145+│20 │"onions" │

146+└───────────┴─────────────┘

147+```

148+

149+After the merge, both relation variables appear in resultant merged transaction. This is because we used a "union merge strategy" which tries to mash both database contexts together.

docs/reaching_out_of_the_tarpit.markdown+3−3

@@ -2,11 +2,11 @@

33## Introduction

5−[Project:M36](https://github.com/agentm/project-m36) is a relational algebra database management system (RDBMS) whose purpose is to implement the foundation for functional relational programming as described in the excellent paper ["Out of the Tarpit"](http://shaffner.us/cs/papers/tarpit.pdf). This document describes how Project:M36 meets the design goals laid out in the paper. It is recommended to read the paper before reading this document.

5+[Project:M36](https://github.com/agentm/project-m36) is a relational algebra database management system (RDBMS) written in the Haskell programming language whose purpose is to implement the foundation for functional relational programming as described in the excellent paper ["Out of the Tarpit"](http://shaffner.us/cs/papers/tarpit.pdf). This document describes how Project:M36 meets the design goals laid out in the paper.

77## Why is "Out of the Tarpit" Important?

9−The "Out of the Tarpit" paper, written in 2006, consolidates decades of software development research and experience to explain why software written today is chock-full of software bugs. The paper categorizes sources of complexity and then proceeds to propose a software architecture which promises to reduce unnecessary software complexity so that the resultant software is maximally focused on actual business rules.

9+The "Out of the Tarpit" paper, written in 2006, consolidates decades of software development research and experience to explain why software written today is chock-full of software bugs. The paper categorizes sources of complexity and then proceeds to propose a software architecture which promises to reduce unnecessary software complexity so that the resultant software is maximally focused on actual business rules. It is recommended to read [the paper](http://shaffner.us/cs/papers/tarpit.pdf) before reading the remainder of this document.

1010

1111## Laying the Foundations for Reduced Complexity

1212

@@ -49,7 +49,7 @@ Project:M36 does not, however, implement a completely new programming language f

4949

5050Project:M36 implements multiple interfaces:

5151

52−* an interactive console implementing [TutorialD](https://en.wikipedia.org/wiki/D_%28data_language_specification%29)

52+* an interactive console implementing [TutorialD](https://en.wikipedia.org/wiki/D_%28data_language_specification%29), a small language for learning about the relational algebra

5353* a native Haskell API

5454* a database driver for the [persistent framework](http://www.yesodweb.com/book/persistent)

5555

docs/server_mode.markdown+1−1

@@ -12,7 +12,7 @@ Note that the above invocation will serve and in-memory, transient "mydbname" da

1212

1313## Connecting an Interactive Client

1414

15−To start an interactive session with the server, run ```cabal run tutd -- --database mydbname --hostname 127.0.0.1```. This will open a TutorialD shell to the remote database and should operate exactly like a local session. Note that the import and export functions import and export from/to the client host's filesystem. There is currently no function to import or export from/to the server host's filesystem.

15+To start an interactive session with the server, run ```cabal run tutd -- --database mydbname --host 127.0.0.1```. This will open a TutorialD shell to the remote database and should operate exactly like a local session. Note that the import and export functions import and export from/to the client host's filesystem. There is currently no function to import or export from/to the server host's filesystem.

1616

1717## Connecting a Haskell Client

1818

project-m36.cabal+354−35

@@ -20,7 +20,8 @@ Library

2020 ,hashable

2121 ,haskeline

2222 ,directory

23− ,uuid

23+ --critical uuid bug in lesser versions https://www.reddit.com/r/haskell/comments/4myot5/psa_make_sure_to_use_uuid_1312/

24+ ,uuid >= 1.3.12

2425 ,cassava ==0.4.*

2526 ,text

2627 ,bytestring

@@ -35,7 +36,6 @@ Library

3536 ,filepath

3637 ,directory

3738 ,vector-binary-instances

38− ,unix

3939 ,temporary

4040 ,stm

4141 ,time

@@ -48,7 +48,7 @@ Library

4848 ,extended-reals

4949 ,network-transport

5050--required for persistent db driver

51− ,persistent

51+ ,persistent >= 2.2 && < 2.3

5252 ,persistent-template

5353 ,aeson

5454 ,path-pieces

@@ -89,9 +89,33 @@ Library

8989 ProjectM36.Client,

9090 ProjectM36.Persist,

9191 ProjectM36.AtomType,

92+ ProjectM36.AtomFunctions.Basic,

93+ ProjectM36.AtomFunctions.Primitive,

94+ ProjectM36.ConcreteTypeRep,

95+ ProjectM36.DataConstructorDef,

96+ ProjectM36.DataTypes.Basic,

97+ ProjectM36.DataTypes.Day,

98+ ProjectM36.DataTypes.Either,

99+ ProjectM36.DataTypes.Maybe,

100+ ProjectM36.DataTypes.Primitive,

101+ ProjectM36.MiscUtils,

102+ ProjectM36.Notifications,

103+ ProjectM36.Relation,

104+ ProjectM36.Server.RemoteCallTypes,

105+ ProjectM36.Session,

106+ ProjectM36.Sessions,

107+ ProjectM36.Transaction.Persist,

108+ ProjectM36.TypeConstructor,

109+ ProjectM36.TypeConstructorDef,

110+ ProjectM36.TransactionGraph.Merge,

92111 Database.Persist.ProjectM36

93112 GHC-Options: -Wall -rtsopts

94− C-sources: ProjectM36/DirectoryFsync.c

113+ if os(windows)

114+ Build-Depends: Win32 >= 2.3 && < 2.4

115+ Other-Modules: ProjectM36.Win32Handle

116+ else

117+ C-sources: ProjectM36/DirectoryFsync.c

118+ Build-Depends: unix

95119 Default-Language: Haskell2010

96120

97121Executable tutd

@@ -119,7 +143,6 @@ Executable tutd

119143 deepseq,

120144 binary,

121145 data-interval,

122− unix,

123146 parallel,

124147 cassava,

125148 gnuplot,

@@ -139,15 +162,67 @@ Executable tutd

139162 ProjectM36.Transaction,

140163 TutorialD.Interpreter,

141164 TutorialD.Interpreter.Base,

142− TutorialD.Interpreter.DatabaseExpr,

165+ TutorialD.Interpreter.DatabaseContextExpr,

143166 TutorialD.Interpreter.RODatabaseContextOperator,

144167 TutorialD.Interpreter.TransactionGraphOperator,

145168 TutorialD.Interpreter.DataTypes.Interval,

146− TutorialD.Interpreter.DataTypes.DateTime

169+ TutorialD.Interpreter.DataTypes.DateTime,

170+ ProjectM36.Atom,

171+ ProjectM36.AtomFunction,

172+ ProjectM36.AtomFunctions.Basic,

173+ ProjectM36.AtomFunctions.Primitive,

174+ ProjectM36.AtomType,

175+ ProjectM36.Attribute,

176+ ProjectM36.AttributeNames,

177+ ProjectM36.Client,

178+ ProjectM36.ConcreteTypeRep,

179+ ProjectM36.DataConstructorDef,

180+ ProjectM36.DataTypes.Basic,

181+ ProjectM36.DataTypes.Day,

182+ ProjectM36.DataTypes.Either,

183+ ProjectM36.DataTypes.Maybe,

184+ ProjectM36.DataTypes.Primitive,

185+ ProjectM36.DatabaseContext,

186+ ProjectM36.Key,

187+ ProjectM36.MiscUtils,

188+ ProjectM36.Notifications,

189+ ProjectM36.Persist,

190+ ProjectM36.Relation,

191+ ProjectM36.Relation.Parse.CSV,

192+ ProjectM36.Relation.Show.CSV,

193+ ProjectM36.Relation.Show.Gnuplot,

194+ ProjectM36.Relation.Show.Term,

195+ ProjectM36.Server.RemoteCallTypes,

196+ ProjectM36.Session,

197+ ProjectM36.Sessions,

198+ ProjectM36.StaticOptimizer,

199+ ProjectM36.Transaction.Persist,

200+ ProjectM36.TransactionGraph,

201+ ProjectM36.TransactionGraph.Persist,

202+ ProjectM36.Tuple,

203+ ProjectM36.TupleSet,

204+ ProjectM36.TypeConstructor,

205+ ProjectM36.TypeConstructorDef,

206+ ProjectM36.TransactionGraph.Merge,

207+ TutorialD.Interpreter.InformationOperator,

208+ TutorialD.Interpreter.Export.Base,

209+ TutorialD.Interpreter.Export.CSV,

210+ TutorialD.Interpreter.Import.Base,

211+ TutorialD.Interpreter.Import.CSV,

212+ TutorialD.Interpreter.Import.TutorialD,

213+ TutorialD.Interpreter.RelationalExpr,

214+ TutorialD.Interpreter.Types

147215 main-is: TutorialD/tutd.hs

148− GHC-Options: -Wall

149− C-sources: ProjectM36/DirectoryFsync.c

216+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

217+ GHC-Options: -Wall

150218 Default-Language: Haskell2010

219+ if os(windows)

220+ Build-Depends: Win32 >= 2.3 && < 2.4

221+ Other-Modules: ProjectM36.Win32Handle

222+ else

223+ C-sources: ProjectM36/DirectoryFsync.c

224+ Build-Depends: unix

225+

151226

152227Executable project-m36-server

153228 Build-Depends: base,

@@ -161,7 +236,6 @@ Executable project-m36-server

161236 binary,

162237 transformers,

163238 temporary,

164− unix,

165239 data-interval,

166240 deepseq,

167241 uuid,

@@ -186,116 +260,361 @@ Executable project-m36-server

186260 list-t,

187261 base64-bytestring

188262 Main-Is: ProjectM36/Server/project-m36-server.hs

263+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

189264 GHC-Options: -Wall -threaded -rtsopts

190265 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

191− C-sources: ProjectM36/DirectoryFsync.c

192266 Default-Language: Haskell2010

193−

267+ Other-Modules: ProjectM36.Atom,

268+ ProjectM36.AtomFunction,

269+ ProjectM36.AtomFunctions.Basic,

270+ ProjectM36.AtomFunctions.Primitive,

271+ ProjectM36.AtomType,

272+ ProjectM36.Attribute,

273+ ProjectM36.AttributeNames,

274+ ProjectM36.Base,

275+ ProjectM36.Client,

276+ ProjectM36.ConcreteTypeRep,

277+ ProjectM36.DataConstructorDef,

278+ ProjectM36.DataTypes.Basic,

279+ ProjectM36.DataTypes.Day,

280+ ProjectM36.DataTypes.Either,

281+ ProjectM36.DataTypes.Maybe,

282+ ProjectM36.DataTypes.Primitive,

283+ ProjectM36.DatabaseContext,

284+ ProjectM36.Error,

285+ ProjectM36.MiscUtils,

286+ ProjectM36.Notifications,

287+ ProjectM36.Persist,

288+ ProjectM36.Relation,

289+ ProjectM36.RelationalExpression,

290+ ProjectM36.Server,

291+ ProjectM36.Server.Config,

292+ ProjectM36.Server.EntryPoints,

293+ ProjectM36.Server.ParseArgs,

294+ ProjectM36.Server.RemoteCallTypes,

295+ ProjectM36.Session,

296+ ProjectM36.Sessions,

297+ ProjectM36.StaticOptimizer,

298+ ProjectM36.Transaction,

299+ ProjectM36.Transaction.Persist,

300+ ProjectM36.TransactionGraph,

301+ ProjectM36.TransactionGraph.Persist,

302+ ProjectM36.TransactionGraph.Merge,

303+ ProjectM36.Tuple,

304+ ProjectM36.TupleSet,

305+ ProjectM36.TypeConstructor,

306+ ProjectM36.TypeConstructorDef

307+ if os(windows)

308+ Build-Depends: Win32 >= 2.3 && < 2.4

309+ Other-Modules: ProjectM36.Win32Handle

310+ else

311+ C-sources: ProjectM36/DirectoryFsync.c

312+ Build-Depends: unix

313+

194314

195315Executable bigrel

196316 Default-Language: Haskell2010

197− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t

317+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t

198318 Other-Modules: ProjectM36.Base,

199319 ProjectM36.Relation

200320 ProjectM36.Tuple,

201321 ProjectM36.Error,

202− ProjectM36.Relation.Show.CSV

322+ ProjectM36.Relation.Show.CSV,

323+ ProjectM36.Atom,

324+ ProjectM36.AtomFunction,

325+ ProjectM36.AtomFunctions.Basic,

326+ ProjectM36.AtomFunctions.Primitive,

327+ ProjectM36.AtomType,

328+ ProjectM36.Attribute,

329+ ProjectM36.AttributeNames,

330+ ProjectM36.ConcreteTypeRep,

331+ ProjectM36.DataConstructorDef,

332+ ProjectM36.DataTypes.Basic,

333+ ProjectM36.DataTypes.Day,

334+ ProjectM36.DataTypes.Either,

335+ ProjectM36.DataTypes.Maybe,

336+ ProjectM36.DataTypes.Primitive,

337+ ProjectM36.DatabaseContext,

338+ ProjectM36.DateExamples,

339+ ProjectM36.Key,

340+ ProjectM36.MiscUtils,

341+ ProjectM36.Relation.Show.HTML,

342+ ProjectM36.RelationalExpression,

343+ ProjectM36.StaticOptimizer,

344+ ProjectM36.TupleSet,

345+ ProjectM36.TypeConstructor,

346+ ProjectM36.TypeConstructorDef,

347+ TutorialD.Interpreter.Base,

348+ TutorialD.Interpreter.DatabaseContextExpr,

349+ TutorialD.Interpreter.RelationalExpr,

350+ TutorialD.Interpreter.Types

203351 main-is: benchmark/bigrel.hs

204352 GHC-Options: -Wall -threaded -rtsopts

353+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

205354 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

206− C-sources: ProjectM36/DirectoryFsync.c

355+ if os(windows)

356+ Build-Depends: Win32 >= 2.3 && < 2.4

357+ Other-Modules: ProjectM36.Win32Handle

358+ else

359+ C-sources: ProjectM36/DirectoryFsync.c

360+ Build-Depends: unix

361+

207362

208363Test-Suite test-tutoriald

209364 Default-Language: Haskell2010

210365 type: exitcode-stdio-1.0

211366 main-is: test/TutorialD/Interpreter.hs

212− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t

367+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t

368+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.Client, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.Relation.Parse.CSV, ProjectM36.Relation.Show.CSV, ProjectM36.Relation.Show.Gnuplot, ProjectM36.Relation.Show.Term, ProjectM36.RelationalExpression, ProjectM36.Server.RemoteCallTypes, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.InformationOperator

213369 GHC-Options: -Wall

214− C-sources: ProjectM36/DirectoryFsync.c

370+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

371+ if os(windows)

372+ Build-Depends: Win32 >= 2.3 && < 2.4

373+ Other-Modules: ProjectM36.Win32Handle

374+ else

375+ C-sources: ProjectM36/DirectoryFsync.c

376+ Build-Depends: unix

377+

215378

216379Test-Suite test-relation

217380 Default-Language: Haskell2010

218381 type: exitcode-stdio-1.0

219382 main-is: test/Relation/Basic.hs

220− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

383+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

384+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, ProjectM36.RelationalExpression

221385 GHC-Options: -Wall

386+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

222387

223388Test-Suite test-static-optimizer

224389 Default-Language: Haskell2010

225390 type: exitcode-stdio-1.0

226391 main-is: test/Relation/StaticOptimizer.hs

227− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

392+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

393+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef

228394 GHC-Options: -Wall

395+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

229396

230397Test-Suite test-transactiongraph-persist

231398 Default-Language: Haskell2010

232399 type: exitcode-stdio-1.0

233400 main-is: test/TransactionGraph/Persist.hs

234− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

401+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

402+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr

235403 GHC-Options: -Wall

236− C-sources: ProjectM36/DirectoryFsync.c

404+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

405+ if os(windows)

406+ Build-Depends: Win32 >= 2.3 && < 2.4

407+ Other-Modules: ProjectM36.Win32Handle

408+ else

409+ C-sources: ProjectM36/DirectoryFsync.c

410+ Build-Depends: unix

411+

237412

238413Test-Suite test-relation-import-csv

239414 Default-Language: Haskell2010

240415 type: exitcode-stdio-1.0

241416 main-is: test/Relation/Import/CSV.hs

242− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

417+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

418+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.Relation.Parse.CSV, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef

243419 GHC-Options: -Wall

420+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

244421

245422Test-Suite test-tutoriald-import-tutoriald

246423 Default-Language: Haskell2010

247424 type: exitcode-stdio-1.0

248425 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs

249− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

426+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

427+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr

250428 GHC-Options: -Wall

429+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

251430

252431Test-Suite test-relation-export-csv

253432 Default-Language: Haskell2010

254433 type: exitcode-stdio-1.0

255434 main-is: test/Relation/Export/CSV.hs

256− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

257− GHC-Options: -Wall

435+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers

436+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.Relation.Parse.CSV, ProjectM36.Relation.Show.CSV, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef

437+ GHC-Options: -Wall

438+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

258439

259440Test-Suite test-persistent-driver

260441 Default-Language: Haskell2010

261442 type: exitcode-stdio-1.0

262443 main-is: test/persistent-driver/test.hs

444+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent >= 2.2 && < 2.3, either, path-pieces, http-api-data, stm-containers, list-t

445+ GHC-Options: -Wall

446+ Other-Modules: Database.Persist.ProjectM36, ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.Client, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.Error, ProjectM36.MiscUtils, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.Server.RemoteCallTypes, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef

447+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

448+ if os(windows)

449+ Build-Depends: Win32 >= 2.3 && < 2.4

450+ Other-Modules: ProjectM36.Win32Handle

451+ else

452+ C-sources: ProjectM36/DirectoryFsync.c

453+ Build-Depends: unix

454+

455+

456+

457+Test-Suite test-transactiongraph-merge

458+ Default-Language: Haskell2010

459+ type: exitcode-stdio-1.0

460+ main-is: test/TransactionGraph/Merge.hs

263461 Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers, list-t

462+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.Transaction, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Merge, ProjectM36.TransactionGraph.Show, ProjectM36.TransactionGraph.Show.Dot, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef

264463 GHC-Options: -Wall

464+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

265465 C-sources: ProjectM36/DirectoryFsync.c

266466

267467benchmark bench

268468 Default-Language: Haskell2010

269469 type: exitcode-stdio-1.0

270470 main-is: benchmark/Relation.hs

271− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, criterion, stm-containers

471+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, criterion, stm-containers

272472 GHC-Options: -Wall -rtsopts

473+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

273474

274475Test-Suite test-server

275476 Default-Language: Haskell2010

276477 type: exitcode-stdio-1.0

277478 main-is: test/Server/Main.hs

278− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t

479+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t

279480 GHC-Options: -Wall

280− C-sources: ProjectM36/DirectoryFsync.c

481+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

482+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.Client, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.Error, ProjectM36.MiscUtils, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.Server, ProjectM36.Server.Config, ProjectM36.Server.EntryPoints, ProjectM36.Server.RemoteCallTypes, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef

483+ if os(windows)

484+ Build-Depends: Win32 >= 2.3 && < 2.4

485+ Other-Modules: ProjectM36.Win32Handle

486+ else

487+ C-sources: ProjectM36/DirectoryFsync.c

488+ Build-Depends: unix

489+

490+

281491

282492Executable Example-SimpleClient

283493 Default-Language: Haskell2010

284− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t

494+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t

285495 Main-Is: examples/SimpleClient.hs

286496 GHC-Options: -Wall

287− C-sources: ProjectM36/DirectoryFsync.c

497+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

498+ Other-Modules: ProjectM36.Atom,

499+ ProjectM36.AtomFunction,

500+ ProjectM36.AtomFunctions.Basic,

501+ ProjectM36.AtomFunctions.Primitive,

502+ ProjectM36.AtomType,

503+ ProjectM36.Attribute,

504+ ProjectM36.AttributeNames,

505+ ProjectM36.Base,

506+ ProjectM36.Client,

507+ ProjectM36.ConcreteTypeRep,

508+ ProjectM36.DataConstructorDef,

509+ ProjectM36.DataTypes.Basic,

510+ ProjectM36.DataTypes.Day,

511+ ProjectM36.DataTypes.Either,

512+ ProjectM36.DataTypes.Maybe,

513+ ProjectM36.DataTypes.Primitive,

514+ ProjectM36.DatabaseContext,

515+ ProjectM36.Error,

516+ ProjectM36.MiscUtils,

517+ ProjectM36.Notifications,

518+ ProjectM36.Persist,

519+ ProjectM36.Relation,

520+ ProjectM36.Relation.Show.Term,

521+ ProjectM36.RelationalExpression,

522+ ProjectM36.Server.RemoteCallTypes,

523+ ProjectM36.Session,

524+ ProjectM36.Sessions,

525+ ProjectM36.StaticOptimizer,

526+ ProjectM36.Transaction,

527+ ProjectM36.Transaction.Persist,

528+ ProjectM36.TransactionGraph,

529+ ProjectM36.TransactionGraph.Persist,

530+ ProjectM36.TransactionGraph.Merge,

531+ ProjectM36.Tuple,

532+ ProjectM36.TupleSet,

533+ ProjectM36.TypeConstructor,

534+ ProjectM36.TypeConstructorDef

535+ if os(windows)

536+ Build-Depends: Win32 >= 2.3 && < 2.4

537+ Other-Modules: ProjectM36.Win32Handle

538+ else

539+ C-sources: ProjectM36/DirectoryFsync.c

540+ Build-Depends: unix

541+

542+

288543

289544Executable Example-PersistClient

290545 Default-Language: Haskell2010

291− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template

546+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template

292547 Main-Is: examples/PersistClient.hs

293548 GHC-Options: -Wall

294− C-sources: ProjectM36/DirectoryFsync.c

295−

549+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

550+ Other-Modules: Database.Persist.ProjectM36,

551+ ProjectM36.Atom,

552+ ProjectM36.AtomFunction,

553+ ProjectM36.AtomFunctions.Basic,

554+ ProjectM36.AtomFunctions.Primitive,

555+ ProjectM36.AtomType,

556+ ProjectM36.Attribute,

557+ ProjectM36.AttributeNames,

558+ ProjectM36.Base,

559+ ProjectM36.Client,

560+ ProjectM36.ConcreteTypeRep,

561+ ProjectM36.DataConstructorDef,

562+ ProjectM36.DataTypes.Basic,

563+ ProjectM36.DataTypes.Day,

564+ ProjectM36.DataTypes.Either,

565+ ProjectM36.DataTypes.Maybe,

566+ ProjectM36.DataTypes.Primitive,

567+ ProjectM36.DatabaseContext,

568+ ProjectM36.Error,

569+ ProjectM36.MiscUtils,

570+ ProjectM36.Notifications,

571+ ProjectM36.Persist,

572+ ProjectM36.Relation,

573+ ProjectM36.RelationalExpression,

574+ ProjectM36.Server.RemoteCallTypes,

575+ ProjectM36.Session,

576+ ProjectM36.Sessions,

577+ ProjectM36.StaticOptimizer,

578+ ProjectM36.Transaction,

579+ ProjectM36.Transaction.Persist,

580+ ProjectM36.TransactionGraph,

581+ ProjectM36.TransactionGraph.Persist,

582+ ProjectM36.TransactionGraph.Merge,

583+ ProjectM36.Tuple,

584+ ProjectM36.TupleSet,

585+ ProjectM36.TypeConstructor,

586+ ProjectM36.TypeConstructorDef

587+ if os(windows)

588+ Build-Depends: Win32 >= 2.3 && < 2.4

589+ Other-Modules: ProjectM36.Win32Handle

590+ else

591+ C-sources: ProjectM36/DirectoryFsync.c

592+ Build-Depends: unix

593+

594+Test-Suite test-scripts

595+ Default-Language: Haskell2010

596+ type: exitcode-stdio-1.0

597+ main-is: test/scripts.hs

598+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t

599+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types

600+ GHC-Options: -Wall

601+ CPP-Options: -DPROJECTM36_VERSION="v0.1"

602+ if os(windows)

603+ Build-Depends: Win32 >= 2.3 && < 2.4

604+ Other-Modules: ProjectM36.Win32Handle

605+ else

606+ C-sources: ProjectM36/DirectoryFsync.c

607+ Build-Depends: unix

608+

296609Executable project-m36-websocket-server

297610 Default-Language: Haskell2010

298− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, websockets

611+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, websockets, aeson

299612 Main-Is: ProjectM36/Server/WebSocket.hs

300613 GHC-Options: -Wall

301− C-sources: ProjectM36/DirectoryFsync.c

614+ if os(windows)

615+ Build-Depends: Win32 >= 2.3 && < 2.4

616+ Other-Modules: ProjectM36.Win32Handle

617+ else

618+ C-sources: ProjectM36/DirectoryFsync.c

619+ Build-Depends: unix

620+

stack.yamlnew file+40

@@ -0,0 +1,40 @@

1+# This file was automatically generated by stack init

2+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/

4+# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)

5+resolver: nightly-2016-04-10

7+# Local packages, usually specified by relative directory name

8+packages:

9+- '.'

10+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)

11+extra-deps:

12+- data-accessor-transformers-0.2.1.7

13+- data-interval-1.2.0

14+- extended-reals-0.2.1.0

15+- gnuplot-0.5.4.1

16+- text-1.2.2.1

17+

18+# Override default flag values for local packages and extra-deps

19+flags: {}

20+

21+# Extra package databases containing global packages

22+extra-package-dbs: []

23+

24+# Control whether we use the GHC we find on the path

25+# system-ghc: true

26+

27+# Require a specific version of stack, using version ranges

28+# require-stack-version: -any # Default

29+# require-stack-version: >= 1.0.0

30+

31+# Override the architecture used by stack, especially useful on Windows

32+# arch: i386

33+# arch: x86_64

34+

35+# Extra directories used by stack for building

36+# extra-include-dirs: [/path/to/dir]

37+# extra-lib-dirs: [/path/to/dir]

38+

39+# Allow a newer minor version of GHC than the snapshot specifies

40+# compiler-check: newer-minor

test/Relation/Basic.hs+14−2

@@ -5,20 +5,26 @@ import ProjectM36.Relation

55import ProjectM36.Error

66import ProjectM36.DateExamples

77import ProjectM36.DataTypes.Primitive

8+import ProjectM36.RelationalExpression

89import ProjectM36.Tuple

910import ProjectM36.Atom

11+import qualified ProjectM36.DatabaseContext as DBC

12+import Control.Monad.State

1013import qualified ProjectM36.Attribute as A

14+import qualified Data.Map as M

1115import qualified Data.Vector as V

1216import qualified Data.Set as S

1317import System.Exit

1418

19+

1520testList :: Test

1621testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,

1722 testMkRelation1,

1823 testRename1, testRename2,

1924 testRelation "suppliers" suppliersRel,

2025 testRelation "products" productsRel,

21− testRelation "supplierProducts" supplierProductsRel]

26+ testRelation "supplierProducts" supplierProductsRel,

27+ testMkRelationFromExprsBadAttrs]

2228

2329main :: IO ()

2430main = do

@@ -65,7 +71,7 @@ simpleRel = case mkRelation attrs tupleSet of

6571 where

6672 attrs = A.attributesFromList [Attribute "a" textAtomType, Attribute "b" textAtomType]

6773 tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [textAtom "spam", textAtom "spam2"])]

68−

74+

6975--rename tests

7076testRename1 :: Test

7177testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNamesMismatchError (S.singleton "a"))

@@ -82,3 +88,9 @@ testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTy

8288 testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [textAtom "v"],

8389 mkRelationTuple testAttrs $ V.fromList [intAtom 2]]

8490

91+testMkRelationFromExprsBadAttrs :: Test

92+testMkRelationFromExprsBadAttrs = TestCase $ do

93+ let context = DBC.empty

94+ case evalState (evalRelationalExpr (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "badAttr1" (PrimitiveTypeConstructor "Int" intAtomType)]) [TupleExpr (M.singleton "badAttr2" (NakedAtomExpr (intAtom 1)))])) context of

95+ Left err -> assertEqual "tuple type mismatch" (TupleAttributeTypeMismatchError (A.attributesFromList [Attribute "badAttr2" intAtomType])) err

96+ Right _ -> assertFailure "expected tuple type mismatch"

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.hsnew file+219

@@ -0,0 +1,219 @@

1+-- tests for transaction merging

2+{-# LANGUAGE OverloadedStrings #-}

3+import Test.HUnit

4+import ProjectM36.Base

5+import ProjectM36.Relation

6+import ProjectM36.Attribute

7+import ProjectM36.DataTypes.Primitive

8+import ProjectM36.Transaction

9+import ProjectM36.TransactionGraph

10+import ProjectM36.TransactionGraph.Show

11+import ProjectM36.TransactionGraph.Show.Dot

12+import ProjectM36.DateExamples

13+import ProjectM36.Error

14+import qualified Data.ByteString.Lazy as BS

15+import System.Exit

16+import Data.Word

17+import ProjectM36.RelationalExpression

18+import qualified Data.UUID as U

19+import qualified Data.Set as S

20+import qualified Data.Map as M

21+import qualified ProjectM36.DatabaseContext as DBC

22+import Control.Monad.State hiding (join)

23+import ProjectM36.Relation (relationTrue)

24+import Debug.Trace

25+

26+main :: IO ()

27+main = do

28+ tcounts <- runTestTT testList

29+ if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

30+

31+testList :: Test

32+testList = TestList [

33+ testSubGraphToFirstAncestorBasic,

34+ testSubGraphToFirstAncestorSnipBranch,

35+ testSelectedBranchMerge,

36+ testUnionMergeStrategy,

37+ testUnionPreferMergeStrategy

38+ ]

39+

40+-- | Create a transaction graph with two branches and no changes between them.

41+{-

42+root 1

43+|--- branchA aaaa

44+|--- branchB bbbb

45+-}

46+basicTransactionGraph :: IO TransactionGraph

47+basicTransactionGraph = do

48+ let bsGraph = bootstrapTransactionGraph uuidRoot DBC.empty --dateExamples

49+ rootTrans = case transactionForHead "master" bsGraph of

50+ Just trans -> trans

51+ Nothing -> error "bonk"

52+ uuidA = fakeUUID 10

53+ uuidB = fakeUUID 11

54+ uuidRoot = fakeUUID 1

55+ rootContext = transactionContext rootTrans

56+ (_, bsGraph') <- addTransaction "branchA" (Transaction uuidA (TransactionInfo uuidRoot S.empty) rootContext) bsGraph

57+ (_, bsGraph'') <- addTransaction "branchB" (Transaction uuidB (TransactionInfo uuidRoot S.empty) rootContext) bsGraph'

58+ pure bsGraph''

59+

60+addTransaction :: HeadName -> Transaction -> TransactionGraph -> IO (Transaction, TransactionGraph)

61+addTransaction headName transaction graph = case addTransactionToGraph headName transaction graph of

62+ Left err -> assertFailure (show err) >> error ""

63+ Right (t,g) -> pure (t,g)

64+

65+fakeUUID :: Word8 -> TransactionId

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

67+ Nothing -> error "impossible uuid"

68+ Just u -> u

69+ where w32 = BS.pack (replicate 4 x)

70+

71+assertEither :: (Show a) => Either a b -> IO b

72+assertEither x = case x of

73+ Left err -> assertFailure (show err) >> undefined

74+ Right val -> pure val

75+

76+assertGraph :: TransactionGraph -> IO ()

77+assertGraph graph = case validateGraph graph of

78+ Nothing -> pure ()

79+ Just errs -> assertFailure (show errs)

80+

81+assertMaybe :: Maybe a -> String -> IO a

82+assertMaybe x msg = case x of

83+ Nothing -> assertFailure msg >> undefined

84+ Just x' -> pure x'

85+

86+-- | Test that a subgraph of the basic graph is equal to the original graph (nothing to filter).

87+testSubGraphToFirstAncestorBasic :: Test

88+testSubGraphToFirstAncestorBasic = TestCase $ do

89+ graph <- basicTransactionGraph

90+ assertGraph graph

91+ transA <- assertMaybe (transactionForHead "branchA" graph) "failed to get branchA"

92+ transB <- assertMaybe (transactionForHead "branchB" graph) "failed to get branchB"

93+ subgraph <- assertEither $ subGraphOfFirstCommonAncestor graph (transactionHeadsForGraph graph) transA transB S.empty

94+ assertEqual "no graph changes" subgraph graph

95+

96+-- | Test that a branch anchored at the root transaction is removed when using the first ancestor function.

97+testSubGraphToFirstAncestorSnipBranch :: Test

98+testSubGraphToFirstAncestorSnipBranch = TestCase $ do

99+ baseGraph <- basicTransactionGraph

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

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

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

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

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

105+ assertGraph subgraph

106+ assertEqual "failed to snip branch" baseGraph subgraph

107+

108+-- | Test that the subgraph function recurses properly through multiple parent transactions.

109+testSubGraphToFirstAncestorMoreTransactions :: Test

110+testSubGraphToFirstAncestorMoreTransactions = TestCase $ do

111+ graph <- basicTransactionGraph

112+ assertGraph graph

113+

114+ -- add another relvar to branchB

115+ branchBTrans <- assertMaybe (transactionForHead "branchB" graph) "failed to get branchB head"

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

117+ (Just err, _) -> assertFailure (show err) >> undefined

118+ (Nothing, context) -> pure context

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

120+ -- add another transaction to branchA

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

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

123+

124+ --retrieve subgraph

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

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

127+ --verify that the subgraph includes both the heads and the common ancestor

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

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

130+

131+testSelectedBranchMerge :: Test

132+testSelectedBranchMerge = TestCase $ do

133+ graph <- basicTransactionGraph

134+ assertGraph graph

135+

136+ -- add another relvar to branchB

137+ branchBTrans <- assertMaybe (transactionForHead "branchB" graph) "failed to get branchB head"

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

139+ (Just err, _) -> assertFailure (show err) >> undefined

140+ (Nothing, context) -> pure context

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

142+ --create the merge transaction in the graph

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

144+

145+ (DisconnectedTransaction _ mergedContext, graph'') <- assertEither eGraph'

146+

147+ assertGraph graph''

148+ --validate that the branchB remains

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

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

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

152+

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

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

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

156+

157+-- try various individual component conflicts and check for resolution

158+testUnionPreferMergeStrategy :: Test

159+testUnionPreferMergeStrategy = TestCase $ do

160+ -- create a graph with a relvar conflict

161+ graph <- basicTransactionGraph

162+ branchATrans <- assertMaybe (transactionForHead "branchA" graph) "branchATrans"

163+ branchBTrans <- assertMaybe (transactionForHead "branchB" graph) "branchBTrans"

164+ branchBRelVar <- assertEither $ mkRelationFromList (attributesFromList [Attribute "conflict" intAtomType]) []

165+ let branchAContext = (transactionContext branchATrans) {relationVariables = M.insert conflictRelVarName branchARelVar (relationVariables (transactionContext branchATrans))}

166+ branchARelVar = relationTrue

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

168+ conflictRelVarName = "conflictRelVar"

169+

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'

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

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

174+ case merged of

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

176+ Right (DisconnectedTransaction _ mergeContext, _) -> do

177+ assertEqual "branchB relvar preferred in conflict" (Just branchBRelVar) (M.lookup conflictRelVarName (relationVariables mergeContext))

178+

179+-- try various individual component conflicts and check for merge failure

180+testUnionMergeStrategy :: Test

181+testUnionMergeStrategy = TestCase $ do

182+ graph <- basicTransactionGraph

183+ assertGraph graph

184+

185+ branchBTrans <- assertMaybe (transactionForHead "branchB" graph) "failed to get branchB head"

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

187+ -- add another relvar to branchB - branchBOnlyRelvar should appear in the merge

188+ -- add inclusion dependency in branchA

189+

190+ let updatedBranchBContext = (transactionContext branchBTrans) {relationVariables = M.insert branchBOnlyRelVarName branchBOnlyRelVar (relationVariables (transactionContext branchBTrans)) }

191+ updatedBranchAContext = (transactionContext branchATrans) {inclusionDependencies = M.insert branchAOnlyIncDepName branchAOnlyIncDep (inclusionDependencies (transactionContext branchATrans)) }

192+ branchBOnlyRelVar = relationTrue

193+ branchAOnlyIncDepName = "branchAOnlyIncDep"

194+ branchBOnlyRelVarName = "branchBOnlyRelVar"

195+ branchAOnlyIncDep = InclusionDependency (ExistingRelation relationTrue) (ExistingRelation relationTrue)

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

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

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

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

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

201+ case eMergeGraph of

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

203+ Right (mergeDiscon, mergeGraph) -> do

204+ -- check that the new merge transaction has the correct parents

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

206+ let mergeContext = transactionContext mergeTrans

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

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

209+ assertEqual "merge transaction relvars" (Just relationTrue) (M.lookup branchBOnlyRelVarName (relationVariables mergeContext))

210+ assertEqual "merge transaction incdeps" (Just branchAOnlyIncDep) (M.lookup branchAOnlyIncDepName (inclusionDependencies mergeContext))

211+ -- test an expected conflict- add branchBOnlyRelVar with same name but different attributes

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

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

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

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

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

217+ case failingMerge of

218+ Right _ -> assertFailure "expected merge failure"

219+ Left err -> assertEqual "merge failure" err (MergeTransactionError StrategyViolatesRelationVariableMergeError)

test/TransactionGraph/Persist.hs+9−9

@@ -11,7 +11,7 @@ import System.Exit

1111import Data.Either

1212import Data.UUID.V4 (nextRandom)

1313import System.FilePath

14−import TutorialD.Interpreter.DatabaseExpr

14+import TutorialD.Interpreter.DatabaseContextExpr

1515

1616main :: IO ()

1717main = do

@@ -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,18 +34,18 @@ 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."

4242 Just headTrans -> do

43− case interpretDatabaseExpr (transactionContext headTrans) "x:=s" of

43+ 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)

test/TutorialD/Interpreter.hs+23−3

@@ -1,5 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2−import TutorialD.Interpreter.DatabaseExpr

2+import TutorialD.Interpreter.DatabaseContextExpr

33import TutorialD.Interpreter

44import TutorialD.Interpreter.Base

55import Test.HUnit

@@ -33,7 +33,7 @@ main = do

3333 tcounts <- runTestTT (TestList tests)

3434 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

3535 where

36− tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest, testNotification, testTypeConstructors]

36+ tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest, testNotification, testTypeConstructors, testMergeTransactions]

3737 simpleRelTests = [("x:=true", Right relationTrue),

3838 ("x:=false", Right relationFalse),

3939 ("x:=true union false", Right relationTrue),

@@ -123,7 +123,7 @@ main = do

123123assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion

124124assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted

125125 where

126− interpreted = case interpretDatabaseExpr databaseContext tutd of

126+ interpreted = case interpretDatabaseContextExpr databaseContext tutd of

127127 Left err -> Left err

128128 Right context -> case M.lookup "x" (relationVariables context) of

129129 Nothing -> Left $ RelVarNotDefinedError "x"

@@ -297,3 +297,23 @@ testTypeConstructors = TestCase $ do

297297 executeTutorialD sessionId dbconn "data Tree a = Node a (Tree a) (Tree a) | EmptyNode"

298298 executeTutorialD sessionId dbconn "y:=relation{a Tree Int}{tuple{a Node 3 (Node 4 EmptyNode EmptyNode) EmptyNode},tuple{a Node 4 EmptyNode EmptyNode}}"

299299

300+testMergeTransactions :: Test

301+testMergeTransactions = TestCase $ do

302+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

303+ mapM_ (executeTutorialD sessionId dbconn) [

304+ ":branch branchA",

305+ "conflictrv := relation{conflict Int}{tuple{conflict 1}}",

306+ ":commit",

307+ ":jumphead master",

308+ ":branch branchB",

309+ "conflictrv := relation{conflict Int}{tuple{conflict 2}}",

310+ ":commit",

311+ ":mergetrans union branchA branchB"

312+ ]

313+ case mkRelationFromList (attributesFromList [Attribute "conflict" intAtomType]) [[intAtom 1],[intAtom 2]] of

314+ Left err -> assertFailure (show err)

315+ Right conflictCheck -> do

316+ eRv <- executeRelationalExpr sessionId dbconn (RelationVariable "conflictrv")

317+ case eRv of

318+ Left err -> assertFailure (show err)

319+ Right conflictrv -> assertEqual "conflict union merge relvar" conflictCheck conflictrv

test/scripts.hsnew file+26

@@ -0,0 +1,26 @@

1+-- read each .tutd file in the /scripts directory and execute it with the tutd interpreter

2+import Test.HUnit

3+import TutorialD.Interpreter.Import.TutorialD

4+import System.Directory

5+import Data.List (isSuffixOf)

6+import System.Exit

8+testList :: IO Test

9+testList = do

10+ let scriptsDir = "scripts/"

11+ dirFiles <- getDirectoryContents scriptsDir

12+ let scriptList = map (scriptsDir ++) $ filter (".tutd" `isSuffixOf`) dirFiles

13+ pure (TestList $ map testScript scriptList)

14+

15+main :: IO ()

16+main = do

17+ tests <- testList

18+ tcounts <- runTestTT tests

19+ if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

20+

21+testScript :: FilePath -> Test

22+testScript tutdFile = TestCase $ do

23+ eImport <- importTutorialD tutdFile

24+ case eImport of

25+ Left err -> assertFailure ("tutd import failure in " ++ tutdFile ++ ": " ++ show err)

26+ Right _ -> pure ()