@@ -4,7 +4,8 @@ import ProjectM36.Base
44import ProjectM36.TransactionGraph
55import ProjectM36.Transaction
66import qualified Data.Set as S
7−
7+import qualified Data.Map as M
8+import qualified Data.Text as T
89
910showTransactionStructure :: Transaction -> TransactionGraph -> String
1011showTransactionStructure trans graph = headInfo ++ " " ++ show (transactionUUID trans) ++ " p" ++ parentTransactionsInfo ++ " c" ++ childTransactionsInfo
@@ -20,7 +21,19 @@ showGraphStructure graph@(TransactionGraph _ transSet) = S.foldr folder "" trans
2021 where
2122 folder trans acc = acc ++ showTransactionStructure trans graph ++ "\n"
2223
23−
24+graphAsDot :: TransactionGraph -> String
25+graphAsDot (TransactionGraph heads transSet) = "digraph {" ++ dot ++ headInfo ++ "}"
26+ where
27+ dot = S.foldr transactionAsDot "" transSet
28+ transactionAsDot trans acc = acc ++ childArrows trans ++ parentArrows trans
29+ arrows trans idSet = S.foldr (\c acc' -> acc' ++ oneArrow trans c) "" idSet
30+ childArrows trans = arrows trans (transactionChildren trans)
31+ parentArrows trans = arrows trans (transactionParentUUIDs trans)
32+ transLabel t = tidLabel (transactionUUID t)
33+ tidLabel l = "\"" ++ show l ++ "\""
34+ oneArrow trans tid = transLabel trans ++ " -> " ++ tidLabel tid ++ ";\n"
35+ headInfo = M.foldrWithKey (\headName t acc -> transLabel t ++ " [label=\"" ++ (show . transactionUUID) t ++ ":" ++ T.unpack headName ++ "\"];\n" ++ acc) "" heads
36+
2437
2538
2639