module ProjectM36.TransactionGraph.Show where
import ProjectM36.Base
import ProjectM36.TransactionGraph
import qualified Data.Set as S

showTransactionStructure :: Transaction -> TransactionGraph -> String
showTransactionStructure :: Transaction -> TransactionGraph -> [Char]
showTransactionStructure Transaction
trans TransactionGraph
graph = [Char]
headInfo forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Transaction -> TransactionId
transactionId Transaction
trans) forall a. [a] -> [a] -> [a]
++ [Char]
" p" forall a. [a] -> [a] -> [a]
++ [Char]
parentTransactionsInfo
  where
    headInfo :: [Char]
headInfo = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" forall a. Show a => a -> [Char]
show (Transaction -> TransactionGraph -> Maybe HeadName
headNameForTransaction Transaction
trans TransactionGraph
graph)
    parentTransactionsInfo :: [Char]
parentTransactionsInfo = if Transaction -> Bool
isRootTransaction Transaction
trans then [Char]
"root" else case Transaction
-> TransactionGraph -> Either RelationalError (Set Transaction)
parentTransactions Transaction
trans TransactionGraph
graph of
      Left RelationalError
err -> forall a. Show a => a -> [Char]
show RelationalError
err
      Right Set Transaction
parentTransSet -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> TransactionId
transactionId) Set Transaction
parentTransSet

  
showGraphStructure :: TransactionGraph -> String
showGraphStructure :: TransactionGraph -> [Char]
showGraphStructure graph :: TransactionGraph
graph@(TransactionGraph TransactionHeads
_ Set Transaction
transSet) = forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr Transaction -> [Char] -> [Char]
folder [Char]
"" Set Transaction
transSet
  where
    folder :: Transaction -> [Char] -> [Char]
folder Transaction
trans [Char]
acc = [Char]
acc forall a. [a] -> [a] -> [a]
++ Transaction -> TransactionGraph -> [Char]
showTransactionStructure Transaction
trans TransactionGraph
graph forall a. [a] -> [a] -> [a]
++ [Char]
"\n"