module Language.Dot.Utils where
import Language.Dot.Graph
import Data.List
import Data.Maybe
adjacency (_,_,_, stmts) = adjacency' [] [] stmts
where
adjacency' _ _ [] = ([],[])
adjacency' nodeAttr edgeAttr (stmt:ss) =
case stmt of
(EdgeStatement subgraphs attributes) ->
let sgs = (map (subgraphAdjacency nodeAttr edgeAttr) subgraphs)
edges = concatMap snd sgs
nodes = map fst sgs
pathEdges = makePath ((reverse attributes) ++ edgeAttr) nodes
(ns, es) = adjacency' nodeAttr edgeAttr ss
in ((concat nodes) ++ ns, (edges ++ pathEdges) ++ es)
(NodeStatement name port attributes) ->
let (ns, es) = adjacency' nodeAttr edgeAttr ss
in ((Node (show name) (nodeAttr ++ attributes)) : ns, es)
(SubgraphStatement subgraph) -> case subgraph of
NodeRef name port ->
let (ns, es) = adjacency' nodeAttr edgeAttr ss
in ((Node (show name) nodeAttr) : ns, es)
Subgraph name stmts -> adjacency' nodeAttr edgeAttr stmts
(AttributeStatement attribute) -> adjacency' nodeAttr edgeAttr ss
(EdgeAttribute attributes) -> adjacency' nodeAttr ((reverse attributes) ++ edgeAttr) ss
(NodeAttribute attributes) -> adjacency' ((reverse attributes) ++ nodeAttr) edgeAttr ss
(GraphAttribute attributes) -> adjacency' nodeAttr edgeAttr ss
subgraphAdjacency nodeAttr edgeAttr (NodeRef name port) = ([Node (show name) []], [])
subgraphAdjacency nodeAttr edgeAttr (Subgraph name stmts) = adjacency' nodeAttr edgeAttr stmts
makePath edgeAttr [n1] = []
makePath edgeAttr (n0:n1:ns) = [Edge v0 v1 (reverse edgeAttr) | (Node v0 _) <- n0, (Node v1 _) <- n1] ++ makePath edgeAttr (n1:ns)
adjacencyToDot directed name elements = intercalate "\n" $
[ (if directed then "digraph" else "graph") ++ " \"" ++ fromMaybe "" name ++ "\" {"]
++
map outputElement elements
++ ["}"]
where
edge = if directed then "->" else "--"
outputElement (Node name attributes) = " \"" ++ name ++ "\"" ++ if null attributes then ";" else " [" ++ intercalate ", " (map outputAttribute attributes) ++ "];"
outputElement (Edge v u attributes) = " \"" ++ v ++ "\" " ++ edge ++" \"" ++ u ++ "\"" ++ if null attributes then ";" else " [" ++ intercalate ", " (map outputAttribute attributes) ++ "];"
outputAttribute (attr, val) = "\"" ++ (show attr) ++ "\" = \"" ++ (show val) ++ "\""