{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module contains functionality for generating GraphViz graphs
module Language.REST.Dot
( mkGraph
, DiGraph(..)
, Edge(..)
, GraphType(..)
, Node(..)
, NodeID
) where
import GHC.Generics
import Data.Hashable
import Data.List
import qualified Data.Set as S
import Text.Printf
import System.Process
-- | A GraphViz directed graph
data DiGraph = DiGraph
String -- ^ Filename
(S.Set Node)
(S.Set Edge);
type NodeID = String
-- | The way the graph will be rendered
data GraphType =
Tree -- ^ Standard representation
| Dag -- ^ In 'Dag', If two equal terms `n` steps from the root are the same, they are
-- represented by the same node, even if they were reached via different
-- paths
| Min -- ^ Each unique term is represented by the same node
deriving (Read)
-- | A GraphViz node
data Node = Node
{ nodeID :: NodeID
, label :: String
, nodeStyle :: String
, labelColor :: String
} deriving (Eq, Ord, Show, Generic, Hashable)
-- A GraphViz edge
data Edge = Edge
{ from :: NodeID
, to :: NodeID
, edgeLabel :: String
, edgeColor :: String
, subLabel :: String
, edgeStyle :: String
} deriving (Eq, Ord, Show, Generic, Hashable)
nodeString :: Node -> String
nodeString (Node nid elabel style color) =
printf "\t%s [label=\"%s\"\nstyle=\"%s\"\ncolor=\"%s\"];" nid elabel style color
edgeString :: Edge -> String
edgeString (Edge efrom eto elabel color esubLabel style) =
let
sub = escape esubLabel
escape = concatMap go
where
go '\\' = "\\"
go '\n' = "
"
go '>' = ">"
go '<' = "<"
go o = [o]
labelPart =
if elabel /= ""
then printf "%s" (escape elabel)
else ""
in
printf "\t%s -> %s [label = <%s
%s>\ncolor=\"%s\"\nstyle=\"%s\"];" efrom eto labelPart sub color style
graphString :: DiGraph -> String
graphString (DiGraph name nodes edges) =
printf "digraph %s {\n%s\n\n%s\n}" name nodesString edgesString
where
nodesString :: String
nodesString = intercalate "\n" (map nodeString (S.toList nodes))
edgesString :: String
edgesString = intercalate "\n" (map edgeString (S.toList edges))
-- | @mkGraph name graph@ generates the @.dot@ file for @graph@, and renders
-- the resulting graph to a @png@ file using the @dot@ utility
mkGraph :: String -> DiGraph -> IO ()
mkGraph name graph = do
let dotfile = printf "graphs/%s.dot" name
let pngfile = printf "graphs/%s.png" name
writeFile dotfile (graphString graph)
result <- readProcessWithExitCode "dot" ["-Tpng", dotfile, "-o", pngfile] ""
print result