-- | Simple graphviz output. module Util.Graphviz( Orient(..), graphviz, graphviz' ) where import Data.Graph.Inductive.Graph import Data.List(intersperse) data Orient = Portrait | Landscape deriving (Eq, Show) {- o2s :: Orient -> String o2s Portrait = "\trotate = \"0\"\n" o2s Landscape = "\trotate = \"90\"\n" i2d :: Int -> Double i2d = fromInteger . toInteger -} -- | Format a graph for graphviz with reasonable defaults: title of \"fgl\", -- 8.5x11 pages, one page, landscape orientation 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 -- ^ The graph to format -> String -- ^ The title of the graph -> [(String,String)] -> (a -> [(String,String)]) -> (b -> [(String,String)]) -> (Double, Double) -- ^ The size -- of the page -> (Int, Int) -- ^ The width and -- height of the page -- grid -> Orient -- ^ The orientation of -- the graph. -> 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 --sz w' h' = if o == Portrait then show w'++","++show h' else show h'++","++show w' --ps = show w++","++show h --(pw, ph) = if o == Portrait then p else (ph', pw') --gs = show ((w*(i2d pw))-m)++","++show ((h*(i2d ph))-m) --gs = sz (w*(i2d pw)) (h*(i2d ph)) in "digraph "++sq t++" {\n" -- ++"\tmargin = \"0\"\n" -- ++"\tpage = \""++ps++"\"\n" -- ++"\tsize = \""++gs++"\"\n" ++ concatMap (\x -> showEq x "\n") headers -- ++ o2s o -- ++"\tratio = \"fill\"\n" ++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")