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 -> Set TransactionId
parentIds (Transaction TransactionId
_ TransactionInfo
tinfo Schemas
_) = forall a. Ord a => [a] -> Set a
S.fromList (forall a. NonEmpty a -> [a]
NE.toList (TransactionInfo -> TransactionParents
parents TransactionInfo
tinfo))

rootParent :: TransactionParents
rootParent :: TransactionParents
rootParent = TransactionId -> TransactionParents
singleParent TransactionId
U.nil

singleParent :: TransactionId -> TransactionParents
singleParent :: TransactionId -> TransactionParents
singleParent TransactionId
tid = TransactionId
tid forall a. a -> [a] -> NonEmpty a
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 :: Set TransactionId -> TransactionInfo -> TransactionInfo
filterTransactionInfoTransactions Set TransactionId
filterIds TransactionInfo
tinfo =
  TransactionInfo
tinfo { parents :: TransactionParents
parents = case
                      forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (forall a. Ord a => a -> Set a -> Bool
`S.member`  Set TransactionId
filterIds) (TransactionInfo -> TransactionParents
parents TransactionInfo
tinfo) of
                      [] -> TransactionParents
rootParent
                      [TransactionId]
xs -> forall a. [a] -> NonEmpty a
NE.fromList [TransactionId]
xs}

filterParent :: TransactionId -> S.Set TransactionId -> TransactionId
filterParent :: TransactionId -> Set TransactionId -> TransactionId
filterParent TransactionId
parentId Set TransactionId
validIds = if forall a. Ord a => a -> Set a -> Bool
S.member TransactionId
parentId Set TransactionId
validIds then TransactionId
parentId else TransactionId
U.nil

-- | Remove any child or parent transaction references not in the valud UUID set.
filterTransaction :: S.Set TransactionId -> Transaction -> Transaction
filterTransaction :: Set TransactionId -> Transaction -> Transaction
filterTransaction Set TransactionId
filterIds (Transaction TransactionId
selfId TransactionInfo
tInfo Schemas
context) = TransactionId -> TransactionInfo -> Schemas -> Transaction
Transaction TransactionId
selfId (Set TransactionId -> TransactionInfo -> TransactionInfo
filterTransactionInfoTransactions Set TransactionId
filterIds TransactionInfo
tInfo) Schemas
context

-- | Return the singular context which is not virtual.
concreteDatabaseContext :: Transaction -> DatabaseContext
concreteDatabaseContext :: Transaction -> DatabaseContext
concreteDatabaseContext (Transaction TransactionId
_ TransactionInfo
_ (Schemas DatabaseContext
context Subschemas
_)) = DatabaseContext
context

-- | Returns all schemas including the concrete schema.
schemas :: Transaction -> Schemas
schemas :: Transaction -> Schemas
schemas (Transaction TransactionId
_ TransactionInfo
_ Schemas
schemas') = Schemas
schemas'
    
-- | Returns all subschemas which are isomorphic or sub-isomorphic to the concrete schema.
subschemas :: Transaction -> Subschemas
subschemas :: Transaction -> Subschemas
subschemas (Transaction TransactionId
_ TransactionInfo
_ (Schemas DatabaseContext
_ Subschemas
sschemas)) = Subschemas
sschemas

fresh :: TransactionId -> UTCTime -> Schemas -> Transaction
fresh :: TransactionId -> UTCTime -> Schemas -> Transaction
fresh TransactionId
freshId UTCTime
stamp' = TransactionId -> TransactionInfo -> Schemas -> Transaction
Transaction TransactionId
freshId TransactionInfo
tinfo
  where
    tinfo :: TransactionInfo
tinfo = TransactionInfo {parents :: TransactionParents
parents = TransactionParents
rootParent,
                             stamp :: UTCTime
stamp = UTCTime
stamp',
                             merkleHash :: MerkleHash
merkleHash = forall a. Monoid a => a
mempty
                            }

timestamp :: Transaction -> UTCTime
timestamp :: Transaction -> UTCTime
timestamp (Transaction TransactionId
_ TransactionInfo
tinfo Schemas
_) = TransactionInfo -> UTCTime
stamp TransactionInfo
tinfo