module ProjectM36.Transaction where import ProjectM36.Base import qualified Data.Set as S import qualified Data.UUID as U import Data.Time.Clock import qualified Data.List.NonEmpty as NE parentIds :: Transaction -> S.Set TransactionId parentIds (Transaction _ tinfo _) = S.fromList (NE.toList (parents tinfo)) rootParent :: TransactionParents rootParent = singleParent U.nil singleParent :: TransactionId -> TransactionParents singleParent tid = tid NE.:| [] -- | 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. filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo filterTransactionInfoTransactions filterIds tinfo = tinfo { parents = case NE.filter (`S.member` filterIds) (parents tinfo) of [] -> rootParent xs -> NE.fromList xs} filterParent :: TransactionId -> S.Set TransactionId -> TransactionId filterParent parentId validIds = if S.member parentId validIds then parentId else U.nil -- | Remove any child or parent transaction references not in the valud UUID set. filterTransaction :: S.Set TransactionId -> Transaction -> Transaction filterTransaction filterIds (Transaction selfId tInfo context) = Transaction selfId (filterTransactionInfoTransactions filterIds tInfo) context -- | Return the singular context which is not virtual. concreteDatabaseContext :: Transaction -> DatabaseContext concreteDatabaseContext (Transaction _ _ (Schemas context _)) = context -- | Returns all schemas including the concrete schema. schemas :: Transaction -> Schemas schemas (Transaction _ _ schemas') = schemas' -- | Returns all subschemas which are isomorphic or sub-isomorphic to the concrete schema. subschemas :: Transaction -> Subschemas subschemas (Transaction _ _ (Schemas _ sschemas)) = sschemas fresh :: TransactionId -> UTCTime -> Schemas -> Transaction fresh freshId stamp' = Transaction freshId tinfo where tinfo = TransactionInfo {parents = rootParent, stamp = stamp', merkleHash = mempty } timestamp :: Transaction -> UTCTime timestamp (Transaction _ tinfo _) = stamp tinfo