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

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

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