git.iko.soy/project-m36
on d64cdeb help sign in
project-m36/src/lib/ProjectM36/TransactionGraph/Show/Dot.hs
22 lines 1.0 kB history raw
1module ProjectM36.TransactionGraph.Show.Dot where
2import ProjectM36.Transaction
3import ProjectM36.Base
4import qualified Data.Text as T
5import qualified Data.Set as S
6import qualified Data.Map as M
8graphAsDot :: TransactionGraph -> String
9graphAsDot (TransactionGraph heads transSet) = "digraph {" ++ dot ++ headInfo ++ "}"
10 where
11 dot = S.foldr transactionAsDot "" transSet
12 transactionAsDot trans acc = acc ++ childArrows trans ++ parentArrows trans
13 arrows trans = S.foldr (\c acc' -> acc' ++ oneArrow trans c) ""
14 childArrows trans = arrows trans (transactionChildIds trans)
15 parentArrows trans = arrows trans (transactionParentIds trans)
16 transLabel t = tidLabel (transactionId t)
17 tidLabel l = "\"" ++ show l ++ "\""
18 oneArrow trans tid = transLabel trans ++ " -> " ++ tidLabel tid ++ ";"
19 headInfo = M.foldrWithKey (\headName t acc -> transLabel t ++ " [label=\"" ++ (show . transactionId) t ++ ":" ++ T.unpack headName ++ "\"];" ++ acc) "" heads