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

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

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