\section{Dot Graphs}

\begin{code}
module Dot where
\end{code}

%{{{ Attrs
\begin{code}
type Attr = (String,String)

escape :: Char -> ShowS
escape '\n' = ('\\' :) . ('n' :)
escape '\t' = ('\\' :) . ('t' :)
escape '\r' = ('\\' :) . ('r' :)
escape '\b' = ('\\' :) . ('b' :)
escape '\f' = ('\\' :) . ('f' :)
escape '\\' = ('\\' :) . ('\\' :)
escape '"'  = ('\\' :) . ('"' :)
escape c    = (c :)

showsString s = ('"' :) . flip (foldr escape) s . ('"' :)

showsAttr (name,value) = (name ++) . ('=' :) . showsString value

showsAttrs [] = id
showsAttrs attrs = (' ' :) . ('[' :) .
                   sepShowsList (',' :) showsAttr attrs .
                   (']' :) . (';' :)

type Attrs = [Attr]
\end{code}
%}}}

%{{{ data Stmt, DotGraph
\begin{code}
data Stmt = Setting Attr
          | NodeSettings Attrs
          | EdgeSettings Attrs
          | Node String Attrs
          | Edge String String Attrs
          | UndirEdge String String Attrs
          | Edges [String] Attrs
          | Subgraph String [Stmt]

data DotGraph = DotGraph String [Stmt]
\end{code}
%}}}


%{{{ instance Show Stmt
\begin{code}
instance Show Stmt where
  showsPrec _ = showsStmt (' ' :)
  showList = showsStmts (' ' :)

showsStmt = showsStmt0 False

showsNeatoStmt = showsStmt0 True

showsStmt0 undir indent = f where
  f (Setting attr) = showsAttr attr . (';' :)
  f (NodeSettings attrs) = ("node" ++) . showsAttrs attrs
  f (EdgeSettings attrs) = ("edge" ++) . showsAttrs attrs
  f (Node name attrs) = (name ++) . showsAttrs attrs
  f (UndirEdge src trg attrs) = 
     if undir then showsEdge undir src trg attrs else id
  f (Edge src trg attrs) = showsEdge undir src trg attrs
  f (Edges ns attrs) = sepShowsList (arrow undir) showsString ns . showsAttrs attrs
  f (Subgraph name stmts) =
      ("subgraph " ++) . (name ++) . (" {\n" ++) .
      showsStmts0 undir ((' ':) . indent) stmts .
      indent . ('}':)

noconstraint = ("constraint","false")

showsEdge undir src trg attrs =
   showsString src . arrow undir . showsString trg . showsAttrs attrs

arrow False = (" -> " ++)
arrow True  = (" -- " ++)

showsStmts = showsStmts0 False
showsNeatoStmts = showsStmts0 True

showsStmts0 undir indent [] = id
showsStmts0 undir indent (stmt:stmts) =
    indent . showsStmt0 undir indent stmt . ('\n' :) .
    showsStmts0 undir indent stmts
\end{code}
%}}}

%{{{ instance Show DotGraph
\begin{code}
instance Show DotGraph where
  showsPrec _ (DotGraph name stmts) =
    ("digraph " ++) . (name ++) . (" {\n" ++) .
   showsStmts (' ':) stmts . ('}':) . ('\n':)
  showList [] = id
  showList (g:gs) = shows g . showList gs
\end{code}
%}}}

\begin{code}
sepShowsList sep shows [] = id
sepShowsList sep shows [x] = shows x
sepShowsList sep shows (x:xs) = shows x . sep . sepShowsList sep shows xs
\end{code}

%{{{ EMACS lv
% Local Variables:
% folded-file: t
% fold-internal-margins: 0
% eval: (fold-set-marks "%{{{ " "%}}}")
% eval: (fold-whole-buffer)
% end:
%}}}