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
|
module ShowDotGraph
( DotGraph(..), Node(..), Edge(..)
, viewDotGraph, getDotViewCmd, setDotViewCmd )
where
import Char (isAlphaNum)
import Distribution (rcFileName,getRcVar)
import IO
import IOExts
import List (intercalate)
import PropertyFile (updatePropertyFile)
data DotGraph = Graph String [Node] [Edge]
data Node = Node String [(String,String)]
data Edge = Edge String String [(String,String)]
viewDotGraph :: DotGraph -> IO ()
viewDotGraph = viewDot . showDotGraph
showDotGraph :: DotGraph -> String
showDotGraph (Graph name nodes edges) =
"digraph \"" ++ name ++ "\"" ++
"{\n" ++ concatMap node2dot nodes ++ concatMap edge2dot edges ++ "}\n"
where
node2dot (Node nname attrs) =
if null attrs
then showDotID nname ++ ";\n"
else showDotID nname ++
'[' : intercalate ","
(map (\ (n,v)->n++"=\""++v++"\"") attrs) ++ "]"
++ ";\n"
edge2dot (Edge i j attrs) =
showDotID i ++ " -> " ++ showDotID j ++
(if null attrs then "" else
'[' : intercalate ","
(map (\ (n,v)->n++"=\""++v++"\"") attrs) ++ "]")
++ ";\n"
showDotID :: String -> String
showDotID s | all isAlphaNum s = s
| otherwise = '"' : concatMap escapeDQ s ++ "\""
where
escapeDQ c = if c=='"' then "\\\"" else [c]
viewDot :: String -> IO ()
viewDot dottxt = do
dotview <- getDotViewCmd
dotstr <- connectToCommand dotview
hPutStr dotstr dottxt
hClose dotstr
getDotViewCmd :: IO String
getDotViewCmd = getRcVar "dotviewcommand" >>= return . maybe "" id
setDotViewCmd :: String -> IO ()
setDotViewCmd dvcmd = do
rcfile <- rcFileName
updatePropertyFile rcfile "dotviewcommand" dvcmd
|