{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

module DataFlow.Graphviz.Renderer (
  renderGraphviz
  ) where

import Data.Char
import Data.List.Utils
import Text.Printf

import DataFlow.PrettyRenderer
import DataFlow.Graphviz

convertNewline :: String -> String
convertNewline = replace "\n" "<br/>"

class Renderable t where
  render :: t -> Renderer ()

instance Renderable Attr where
  render (Attr i1 i2) = writeln $ printf "%s = %s;" i1 (convertNewline i2)

instance Renderable AttrList where
  render = mapM_ render

instance Renderable Port where
  render (Port (Just id') c) =
    write $ printf "%s:%s" (show id') (map toLower $ show c)
  render (Port Nothing c) =
    write $ map toLower $ show c

instance Renderable NodeID where
  render (NodeID id' (Just port)) = do
    write id'
    write ":"
    render port
  render (NodeID id' Nothing) = write id'

instance Renderable Subgraph where
  render (Subgraph id' []) =
    writeln $ printf "subgraph %s {}" id'
  render (Subgraph id' stmts) = do
    writeln $ printf "subgraph %s {" id'
    withIndent $ render stmts
    writeln "}"

instance Renderable EdgeOperator where
  render Arrow = write " -> "
  render Line = write " -- "

instance Renderable EdgeOperand where
  render (IDOperand nodeId) = render nodeId
  render (SubgraphOperand sg) = render sg

instance Renderable EdgeExpr where
  render (EdgeExpr o1 operator o2) = do
    render o1
    render operator
    render o2

instance Renderable AttrStmtType where
  render = write . map toLower . show

inBrackets :: Renderer () -> Renderer ()
inBrackets r = do
  writeln " ["
  withIndent r
  writeln "]"

instance Renderable Stmt where
  render (NodeStmt id' []) = do
    write id'
    writeln ""
  render (NodeStmt id' attrs) = do
    write id'
    inBrackets $ render attrs
  render (EdgeStmt expr []) = do
    render expr
    writeln ";"
  render (EdgeStmt expr attrs) = do
    render expr
    inBrackets $ render attrs
  render (AttrStmt t []) = do
    render t
    writeln " []"
  render (AttrStmt t attrs) = do
    render t
    inBrackets $ render attrs
  render (EqualsStmt i1 i2) = do
    write i1
    write " = "
    write i2
    writeln ";"
  render (SubgraphStmt sg) = render sg

instance Renderable StmtList where
  render = mapM_ render

instance Renderable Graph where
  render (Digraph id' stmts) = do
    writeln $ printf "digraph %s {" id'
    withIndent $ render stmts
    writeln "}"

renderGraphviz :: Graph -> String
renderGraphviz = renderWithIndent . render