|
sourcecode:
|
module Data.GraphViz
( DotGraph, dgraph, dgraphWithAttrs, ugraph, ugraphWithAttrs
, Node(..), Edge(..)
, viewDotGraph, showDotGraph, showDotGraphWithAttrs
, getDotViewCmd, setDotViewCmd )
where
import Data.List ( intercalate, last )
import System.IO ( stderr, hClose, hPutStr, hPutStrLn )
import Data.PropertyFile ( getPropertyFromFile, updatePropertyFile )
import System.CurryPath ( curryrcFileName )
import System.IOExts ( connectToCommand )
------------------------------------------------------------------------------
-- Data types for graphs.
--- A Dot graph consists of a name, a list of graph attributes,
--- and lists of nodes and edges.
--- It can be either directed (`DGraph`) or undirected (`UGraph`).
data DotGraph = DGraph String [(String,String)] [Node] [Edge]
| UGraph String [(String,String)] [Node] [Edge]
--- Constructs a directed graph from a name and a list of nodes and edges.
dgraph :: String -> [Node] -> [Edge] -> DotGraph
dgraph name nodes edges = DGraph name [] nodes edges
--- Constructs a directed graph from a name, a list of attributes,
--- and lists of nodes and edges.
--- The attributes are graph attributes of the DOT language, e.g.,
--- `[("ordering","out"), ("fontsize","10")]`.
dgraphWithAttrs :: String -> [(String,String)] -> [Node] -> [Edge] -> DotGraph
dgraphWithAttrs = DGraph
--- Constructs an undirected graph from a name and a list of nodes and edges.
ugraph :: String -> [Node] -> [Edge] -> DotGraph
ugraph name nodes edges = UGraph name [] nodes edges
--- Constructs an undirected graph from a name, a list of attributes,
--- and lists of nodes and edges.
--- The attributes are graph attributes of the DOT language, e.g.,
--- `[("ordering","out"), ("fontsize","10")]`.
ugraphWithAttrs :: String -> [(String,String)] -> [Node] -> [Edge] -> DotGraph
ugraphWithAttrs = UGraph
--- A node of a dot graph consists of a name and a list of attributes
--- for this node.
data Node = Node String [(String,String)]
--- An edge of a dot graph consists of the names of the source and target node
--- and a list of attributes for this edge.
data Edge = Edge String String [(String,String)]
------------------------------------------------------------------------------
--- Shows a Dot graph as a string of the DOT language.
showDotGraph :: DotGraph -> String
showDotGraph (DGraph name attrs nodes edges) =
"digraph \"" ++ name ++ "\"" ++ graphbody2dot True attrs nodes edges
showDotGraph (UGraph name attrs nodes edges) =
"graph \"" ++ name ++ "\"" ++ graphbody2dot False attrs nodes edges
graphbody2dot :: Bool -> [(String,String)] -> [Node] -> [Edge] -> String
graphbody2dot directed attrs nodes edges =
"{\n" ++ concatMap attr2dot attrs
++ concatMap node2dot nodes
++ concatMap (edge2dot directed) edges ++ "}\n"
--- Deprecated. Use `dgraphWithAttrs` or `ugraphWithAttrs` to construct
--- graphs with attributes.
showDotGraphWithAttrs :: String -> DotGraph -> String
showDotGraphWithAttrs oldattrs dotgraph = case dotgraph of
DGraph name attrs nodes edges ->
"digraph \"" ++ name ++ "\"" ++ attrsbody2dot True attrs nodes edges
UGraph name attrs nodes edges ->
"graph \"" ++ name ++ "\"" ++ attrsbody2dot False attrs nodes edges
where
attrsbody2dot directed attrs nodes edges =
"{\n" ++ (if null oldattrs then "" else oldattrs ++ "\n")
++ concatMap attr2dot attrs
++ concatMap node2dot nodes
++ concatMap (edge2dot directed) edges ++ "}\n"
attr2dot :: (String,String) -> String
attr2dot (name,value) =
showDotID name ++ "=" ++ showDotID value ++ ";\n"
node2dot :: Node -> String
node2dot (Node nname attrs) =
showDotID nname ++ showDotAttrs attrs ++ ";\n"
edge2dot :: Bool -> Edge -> String
edge2dot directed (Edge i j attrs) =
showDotID i ++ edgeOp ++ showDotID j ++ showDotAttrs attrs ++ ";\n"
where
edgeOp = if directed then " -> " else " -- "
showDotAttrs :: [(String, String)] -> String
showDotAttrs attrs =
if null attrs then ""
else '[' : intercalate "," (map showDotAttr attrs) ++ "]"
--- Shows an attribute of a graph as a string of the DOT language.
--- If the attribute name is `label` and its value is enclosed in
--- angle brackets, it is shown as an HTML-like label, otherwise it is
--- enclosed in quotation marks.
showDotAttr :: (String,String) -> String
showDotAttr (name,value)
| name == "label" && not (null value) && head value == '<' && last value == '>'
= "label=" ++ value
| otherwise
= name ++ "=\"" ++ value ++ "\""
showDotID :: String -> String
showDotID s | all isAlphaNum s = s
| otherwise = '"' : concatMap escapeDQ s ++ "\""
where
escapeDQ c = if c=='"' then "\\\"" else [c]
------------------------------------------------------------------------------
--- Visualize a DOT graph with the `dotviewcommand` specified in
--- the rc file of the Curry system.
viewDotGraph :: DotGraph -> IO ()
viewDotGraph = viewDot . showDotGraph
--- Visualize a string of the DOT langugage with the `dotviewcommand`
--- from the rc file of the Curry system.
viewDot :: String -> IO ()
viewDot dottxt = do
dotview <- getDotViewCmd
if null dotview
then hPutStrLn stderr
"No definition for 'dotviewcommand' found in rc file"
else do
dotstr <- connectToCommand dotview
hPutStr dotstr dottxt
hClose dotstr
------------------------------------------------------------------------------
--- Read the command for viewing dot files from the rc file of the
--- Curry system.
getDotViewCmd :: IO String
getDotViewCmd = do
rcfile <- curryrcFileName
getPropertyFromFile rcfile "dotviewcommand" >>= return . maybe "" id
--- Sets the command for viewing dot files in the rc file of the
--- Curry system.
setDotViewCmd :: String -> IO ()
setDotViewCmd dvcmd = do
rcfile <- curryrcFileName
updatePropertyFile rcfile "dotviewcommand" dvcmd
------------------------------------------------------------------------------
|