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

--------------------------------------------------------------------------
--- 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.
---
--- @author Michael Hanus
--- @version December 2020
--------------------------------------------------------------------------

module ShowDotGraph
  ( DotGraph, dgraph, ugraph, Node(..), Edge(..)
  , viewDotGraph, showDotGraph, showDotGraphWithAttrs
  , getDotViewCmd, setDotViewCmd )
 where

import Char         ( isAlphaNum )
import Distribution ( rcFileName )
import IO
import IOExts
import List         ( intercalate, last )

import Data.PropertyFile ( getPropertyFromFile, updatePropertyFile )

--------------------------------------------------------------------------
-- Data types for graphs.

--- A Dot graph consists of a name and a list of nodes and edges.
--- It can be either directed (`DGraph`) or undirected (`UGraph`).
data DotGraph = DGraph String [Node] [Edge]
              | UGraph 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 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

--- 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)]

--------------------------------------------------------------------------
--- Visualize a DOT graph with the `dotviewcommand` specified in
--- the rc file of the Curry system.
-- A dependency graph consists of a list of triples of the form (n,as,ms),
-- where n is a node name, as (dot) attributes for node n, and ms the list
-- of direct dependents from n.
viewDotGraph :: DotGraph -> IO ()
viewDotGraph = viewDot . showDotGraph

--- Shows a Dot graph as a string of the DOT language.
showDotGraph :: DotGraph -> String
showDotGraph g = showDotGraphWithAttrs "" g

--- Shows a Dot graph as a string of the DOT language.
--- The second argument contains a string of graph attributes
--- of the DOT languages, e.g., `ordering=out;'.
showDotGraphWithAttrs :: String -> DotGraph -> String
showDotGraphWithAttrs attrs (DGraph name nodes edges) =
  "digraph \"" ++ name ++ "\"" ++ graphbody2dot True attrs nodes edges
showDotGraphWithAttrs attrs (UGraph name nodes edges) =
  "graph \"" ++ name ++ "\"" ++ graphbody2dot False attrs nodes edges

graphbody2dot :: Bool -> String -> [Node] -> [Edge] -> String
graphbody2dot directed attrs nodes edges =
  "{\n" ++ (if null attrs then "" else attrs ++ "\n")
        ++ concatMap node2dot nodes
        ++ concatMap (edge2dot directed) edges ++ "}\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 string of the DOT langugage with the `dotviewcommand`
--- from the rc file of the Curry system.
viewDot :: String -> IO ()
viewDot dottxt = do
    dotview <- getDotViewCmd
    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 <- rcFileName
  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 <- rcFileName
  updatePropertyFile rcfile "dotviewcommand" dvcmd

-------------------------------------------------------------------------
{-

Example settings in rc file:

dotviewcommand=dot -Tpdf > /tmp/dotxxx && acroread /tmp/dotxxx
dotviewcommand=neato -Tpdf > /tmp/dotxxx && acroread /tmp/dotxxx
dotviewcommand=circo -Tpdf > /tmp/dotxxx && acroread /tmp/dotxxx
dotviewcommand=fdp -Tpdf > /tmp/dotxxx && acroread /tmp/dotxxx

-}