module Util.Graphviz(
Orient(..),
graphviz, graphviz'
) where
import Data.Graph.Inductive.Graph
import Data.List(intersperse)
data Orient = Portrait | Landscape deriving (Eq, Show)
graphviz' :: Graph g => g a b -> [(String,String)] -> (a -> [(String,String)]) -> (b -> [(String,String)]) -> String
graphviz' g headers fnode fedge = graphviz g "fgl" headers fnode fedge (8.5,11.0) (1,1) Landscape
sq :: String -> String
sq ('"':s) | last s == '"' = init s
| otherwise = s
sq ('\'':s) | last s == '\'' = init s
| otherwise = s
sq s = s
sl :: [(String,String)] -> String
sl [] = []
sl a = " [" ++ foldr ($) "]" (intersperse (',':) (map showEq a)) where
showEq :: (String,String) -> String -> String
showEq (x,y) = ((x ++ " = " ++ (show y)) ++)
graphviz :: Graph g => g a b
-> String
-> [(String,String)]
-> (a -> [(String,String)])
-> (b -> [(String,String)])
-> (Double, Double)
-> (Int, Int)
-> Orient
-> String
graphviz g t headers fnode fedge (w, h) p@(pw', ph') o =
let n = labNodes g
e = labEdges g
ns = concatMap sn n
es = concatMap se e
in "digraph "++sq t++" {\n"
++ concatMap (\x -> showEq x "\n") headers
++ns
++es
++"}"
where sn (n, a) | sa == "" = ""
| otherwise = '\t':(show n ++ sa ++ "\n")
where sa = sl (fnode a)
se (n1, n2, b) = '\t':(show n1 ++ " -> " ++ show n2 ++ sl (fedge b) ++ "\n")