Output.hs

module HGraph.Directed.Output
  ( toDot
  , DotStyle(..)
  , defaultDotStyle
  )
where

import HGraph.Directed
import Data.List
import qualified Data.Map as M

data DotStyle a = 
  DotStyle
  { graphName :: String
  , everyNode :: [(String, String)]
  , everyEdge :: [(String, String)]
  , nodeAttributes :: M.Map a [(String, String)]
  , edgeAttributes :: M.Map (a, a) [(String, String)]
  }

defaultDotStyle = DotStyle
  { graphName = ""
  , everyNode = []
  , everyEdge = []
  , nodeAttributes = M.empty
  , edgeAttributes = M.empty
  }

toDot d style = concat
  [ "digraph ", (graphName style), "{\n  "
  , if null $ everyNode style then "" else "node [" ++ attStr (everyNode style) ++ "];\n  "
  , if null $ everyEdge style then "" else "edge [" ++ attStr (everyEdge style) ++ "];\n  "
  , intercalate ";\n  " (map showV $ vertices d),  ";\n  "
  , intercalate ";\n  " (map showA $ arcs d) , ";\n}"
  ]
  where
    attStr xs = intercalate "," $ map (\(var,val) -> var ++ "=\"" ++ val ++ "\"") xs
    showV v
      | v `M.member` (nodeAttributes style) = show v ++ " [" ++ attStr ((nodeAttributes style) M.! v) ++ "]"
      | otherwise = show v
    showA (v,u)
      | (v,u) `M.member` (edgeAttributes style) = show v ++ " -> " ++ show u ++ " [" ++ attStr ((edgeAttributes style) M.! (v,u)) ++ "]"
      | otherwise = show v ++ " -> " ++ show u