1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

------------------------------------------------------------------------------
--- A simple library for graph visualization with
--- [Graphviz](http://www.graphviz.org/).
--- It provides a data structure to represent graphs and operations
--- to visualize them.
--- 
--- There is a convenient operation `viewDotGraph` which visualizes
--- a graph with the `dotviewcommand` specified in the rc file of
--- the Curry system. Thus, the value of the `dotviewcommand` field
--- in the rc file (e.g., `~/.pakcsrc` in case of PAKCS) should be
--- correctly defined. Here are some reasonable settings of this field:
--- 
---     dotviewcommand=dot -Tpdf > /tmp/dotxxx.pdf && xdg-open /tmp/dotxxx.pdf
---     dotviewcommand=neato -Tpdf > /tmp/dotxxx.pdf && xdg-open /tmp/dotxxx.pdf
---     dotviewcommand=circo -Tpdf > /tmp/dotxxx.pdf && xdg-open /tmp/dotxxx.pdf
---     dotviewcommand=fdp -Tpdf > /tmp/dotxxx.pdf && xdg-open /tmp/dotxxx.pdf
---
--- @author Michael Hanus
--- @version May 2023
------------------------------------------------------------------------------

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

------------------------------------------------------------------------------