Graphviz.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}

module StackedDag.Graphviz where

import qualified Data.Text.Lazy as T
import qualified Data.String as S
import qualified Data.GraphViz as G
import qualified Data.GraphViz.Attributes.Complete as GT
import StackedDag.Base

genEdgesFromDot :: T.Text -> (Labels T.Text String,Edges T.Text)
genEdgesFromDot dot = (labels,edges)
  where
   dg :: G.DotGraph T.Text
   dg = G.parseDotGraph dot
   edges = mkEdges $ map (\v -> ( (G.fromNode v),([ (G.toNode v)]))) $ G.graphEdges dg
   getl' :: G.Attribute -> Maybe String
   getl' attr = case attr of
     (GT.Label (GT.StrLabel name)) -> Just (T.unpack name)
     (GT.Label name) -> Just (show name)
     _ -> Nothing
   getl :: G.Attributes -> String
   getl attrs = maybe "" id $ foldl (\s i-> s `mappend` getl' i) Nothing attrs
   labels = mkLabels $ map (\v -> ((G.nodeID v),getl (G.nodeAttributes v))) $ G.graphNodes dg


genAsciiFromDot :: T.Text -> T.Text
genAsciiFromDot dot = S.fromString $ uncurry edgesToText $ genEdgesFromDot dot