git.iko.soy/project-m36
on 52182bc help sign in
project-m36/src/lib/ProjectM36/Transaction.hs
46 lines 3.1 kB history raw
1module ProjectM36.Transaction where
2import ProjectM36.Base
3import qualified Data.Set as S
4import qualified Data.UUID as U
5import Data.Time.Clock
7transactionTimestamp :: Transaction -> UTCTime
8transactionTimestamp (Transaction _ (TransactionInfo _ _ stamp) _) = stamp
9transactionTimestamp (Transaction _ (MergeTransactionInfo _ _ _ stamp) _) = stamp
11transactionParentIds :: Transaction -> S.Set TransactionId
12transactionParentIds (Transaction _ (TransactionInfo pId _ _) _) = S.singleton pId
13transactionParentIds (Transaction _ (MergeTransactionInfo pId1 pId2 _ _) _) = S.fromList [pId1, pId2]
15transactionChildIds :: Transaction -> S.Set TransactionId
16transactionChildIds (Transaction _ (TransactionInfo _ children _) _) = children
17transactionChildIds (Transaction _ (MergeTransactionInfo _ _ children _) _) = children
19-- | Create a new transaction which is identical to the original except that a new set of child transaction ids is added.
20transactionSetChildren :: Transaction -> S.Set TransactionId -> Transaction
21transactionSetChildren t@(Transaction _ (TransactionInfo pId _ stamp) schemas') childIds = Transaction (transactionId t) (TransactionInfo pId childIds stamp) schemas'
22transactionSetChildren t@(Transaction _ (MergeTransactionInfo pId1 pId2 _ stamp) schemas') childIds = Transaction (transactionId t) (MergeTransactionInfo pId1 pId2 childIds stamp) schemas'
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.
25filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo
26filterTransactionInfoTransactions filterIds (TransactionInfo parentId childIds stamp) = TransactionInfo (filterParent parentId filterIds) (S.intersection childIds filterIds) stamp
27filterTransactionInfoTransactions filterIds (MergeTransactionInfo parentIdA parentIdB childIds stamp) = MergeTransactionInfo (filterParent parentIdA filterIds) (filterParent parentIdB filterIds) (S.intersection childIds filterIds) stamp
29filterParent :: TransactionId -> S.Set TransactionId -> TransactionId
30filterParent parentId validIds = if S.member parentId validIds then parentId else U.nil
32-- | Remove any child or parent transaction references not in the valud UUID set.
33filterTransaction :: S.Set TransactionId -> Transaction -> Transaction
34filterTransaction filterIds (Transaction selfId tInfo context) = Transaction selfId (filterTransactionInfoTransactions filterIds tInfo) context
36-- | Return the singular context which is not virtual.
37concreteDatabaseContext :: Transaction -> DatabaseContext
38concreteDatabaseContext (Transaction _ _ (Schemas context _)) = context
40-- | Returns all schemas including the concrete schema.
41schemas :: Transaction -> Schemas
42schemas (Transaction _ _ schemas') = schemas'
44-- | Returns all subschemas which are isomorphic or sub-isomorphic to the concrete schema.
45subschemas :: Transaction -> Subschemas
46subschemas (Transaction _ _ (Schemas _ sschemas)) = sschemas