git.iko.soy/project-m36
on bfaecd2 help sign in
project-m36/src/lib/ProjectM36/Transaction.hs
49 lines 2.3 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
6import qualified Data.List.NonEmpty as NE
8parentIds :: Transaction -> S.Set TransactionId
9parentIds (Transaction _ tinfo _) = S.fromList (NE.toList (parents tinfo))
11rootParent :: TransactionParents
12rootParent = singleParent U.nil
14singleParent :: TransactionId -> TransactionParents
15singleParent tid = tid NE.:| []
17-- | 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.
18filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo
19filterTransactionInfoTransactions filterIds tinfo =
20 TransactionInfo { parents = case
21 NE.filter (\parent -> S.member parent filterIds) (parents tinfo) of
22 [] -> rootParent
23 xs -> NE.fromList xs,
24 stamp = stamp tinfo }
26filterParent :: TransactionId -> S.Set TransactionId -> TransactionId
27filterParent parentId validIds = if S.member parentId validIds then parentId else U.nil
29-- | Remove any child or parent transaction references not in the valud UUID set.
30filterTransaction :: S.Set TransactionId -> Transaction -> Transaction
31filterTransaction filterIds (Transaction selfId tInfo context) = Transaction selfId (filterTransactionInfoTransactions filterIds tInfo) context
33-- | Return the singular context which is not virtual.
34concreteDatabaseContext :: Transaction -> DatabaseContext
35concreteDatabaseContext (Transaction _ _ (Schemas context _)) = context
37-- | Returns all schemas including the concrete schema.
38schemas :: Transaction -> Schemas
39schemas (Transaction _ _ schemas') = schemas'
41-- | Returns all subschemas which are isomorphic or sub-isomorphic to the concrete schema.
42subschemas :: Transaction -> Subschemas
43subschemas (Transaction _ _ (Schemas _ sschemas)) = sschemas
45fresh :: TransactionId -> UTCTime -> Schemas -> Transaction
46fresh freshId stamp' newSchemas = Transaction freshId (TransactionInfo rootParent stamp') newSchemas
48timestamp :: Transaction -> UTCTime
49timestamp (Transaction _ tinfo _) = stamp tinfo