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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
{- |
Module : Data.GraphViz.Types.Canonical
Description : The canonical representation of Dot graphs.
Copyright : (c) Matthew Sackman, Ivan Lazar Miljenovic
License : 3-Clause BSD-style
Maintainer : Ivan.Miljenovic@gmail.com
A canonical Dot graph requires that within each graph/sub-graph,
the statements are in the following order:
* global attributes
* sub-graphs/clusters
* nodes
* edges
This Dot graph representation is ideally suited for converting
other data structures to Dot form (especially with the help of
@graphElemsToDot@ from "Data.GraphViz").
If you require arbitrary ordering of statements, then use
"Data.GraphViz.Types.Generalised".
The sample graph could be implemented (this is actually the result
of calling @canonicalise@ from "Data.GraphViz.Algorithms" on the
generalised one) as:
> DotGraph { strictGraph = False
> , directedGraph = True
> , graphID = Just (Str "G")
> , graphStatements = DotStmts { attrStmts = []
> , subGraphs = [ DotSG { isCluster = True
> , subGraphID = Just (Int 0)
> , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [ style filled
> , color LightGray
> , textLabel "process #1"]
> , NodeAttrs [style filled, color White]]}
> , subGraphs = []
> , nodeStmts = [ DotNode "a0" []
> , DotNode "a1" []
> , DotNode "a2" []
> , DotNode "a3" []]
> , edgeStmts = [ DotEdge "a0" "a1" []
> , DotEdge "a1" "a2" []
> , DotEdge "a2" "a3" []
> , DotEdge "a3" "a0" []]}}
> , DotSG { isCluster = True
> , subGraphID = Just (Int 1)
> , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [textLabel "process #2", color Blue]
> , NodeAttrs [style filled]]
> , subGraphs = []
> , nodeStmts = [ DotNode "b0" []
> , DotNode "b1" []
> , DotNode "b2" []
> , DotNode "b3" []]
> , edgeStmts = [ DotEdge "b0" "b1" []
> , DotEdge "b1" "b2" []
> , DotEdge "b2" "b3" []]}}]
> , nodeStmts = [ DotNode "end" [shape MSquare]
> , DotNode "start" [shape MDiamond]]
> , edgeStmts = [ DotEdge "start" "a0" []
> , DotEdge "start" "b0" []
> , DotEdge "a1" "b3" []
> , DotEdge "b2" "a3" []
> , DotEdge "a3" "end" []
> , DotEdge "b3" "end" []]}}
Note that whilst the above graph represents the same Dot graph as
specified in "Data.GraphViz.Types.Generalised", etc., it /may/ be
drawn slightly differently by the various Graphviz tools.
-}
module Data.GraphViz.Types.Canonical
( DotGraph(..)
-- * Sub-components of a @DotGraph@.
, DotStatements(..)
, DotSubGraph(..)
-- * Re-exported from @Data.GraphViz.Types@
, GraphID(..)
, GlobalAttributes(..)
, DotNode(..)
, DotEdge(..)
) where
import Data.GraphViz.Internal.State (AttributeType (..))
import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Parsing
import Data.GraphViz.Printing
import Data.GraphViz.Types.Internal.Common
import Control.Arrow ((&&&))
-- -----------------------------------------------------------------------------
-- | A Dot graph in canonical form.
data DotGraph n = DotGraph { strictGraph :: Bool -- ^ If 'True', no multiple edges are drawn.
, directedGraph :: Bool
, graphID :: Maybe GraphID
, graphStatements :: DotStatements n
}
deriving (Eq, Ord, Show, Read)
instance (PrintDot n) => PrintDot (DotGraph n) where
unqtDot = printStmtBased printGraphID' (const GraphAttribute)
graphStatements toDot
where
printGraphID' = printGraphID strictGraph directedGraph graphID
instance (ParseDot n) => ParseDot (DotGraph n) where
parseUnqt = parseGraphID DotGraph
<*> parseBracesBased GraphAttribute parseUnqt
parse = parseUnqt -- Don't want the option of quoting
-- | Assumed to be an injective mapping function.
instance Functor DotGraph where
fmap f g = g { graphStatements = fmap f $ graphStatements g }
-- -----------------------------------------------------------------------------
data DotStatements n = DotStmts { attrStmts :: [GlobalAttributes]
, subGraphs :: [DotSubGraph n]
, nodeStmts :: [DotNode n]
, edgeStmts :: [DotEdge n]
}
deriving (Eq, Ord, Show, Read)
instance (PrintDot n) => PrintDot (DotStatements n) where
unqtDot stmts = vcat $ sequence [ unqtDot $ attrStmts stmts
, unqtDot $ subGraphs stmts
, unqtDot $ nodeStmts stmts
, unqtDot $ edgeStmts stmts
]
instance (ParseDot n) => ParseDot (DotStatements n) where
parseUnqt = do atts <- tryParseList
newline'
sGraphs <- tryParseList
newline'
nodes <- tryParseList
newline'
edges <- tryParseList
return $ DotStmts atts sGraphs nodes edges
parse = parseUnqt -- Don't want the option of quoting
`adjustErr`
("Not a valid set of statements\n\t"++)
instance Functor DotStatements where
fmap f stmts = stmts { subGraphs = map (fmap f) $ subGraphs stmts
, nodeStmts = map (fmap f) $ nodeStmts stmts
, edgeStmts = map (fmap f) $ edgeStmts stmts
}
-- -----------------------------------------------------------------------------
data DotSubGraph n = DotSG { isCluster :: Bool
, subGraphID :: Maybe GraphID
, subGraphStmts :: DotStatements n
}
deriving (Eq, Ord, Show, Read)
instance (PrintDot n) => PrintDot (DotSubGraph n) where
unqtDot = printStmtBased printSubGraphID' subGraphAttrType
subGraphStmts toDot
unqtListToDot = printStmtBasedList printSubGraphID' subGraphAttrType
subGraphStmts toDot
listToDot = unqtListToDot
subGraphAttrType :: DotSubGraph n -> AttributeType
subGraphAttrType = bool SubGraphAttribute ClusterAttribute . isCluster
printSubGraphID' :: DotSubGraph n -> DotCode
printSubGraphID' = printSubGraphID (isCluster &&& subGraphID)
instance (ParseDot n) => ParseDot (DotSubGraph n) where
parseUnqt = parseSubGraph DotSG parseUnqt
`onFail`
-- Take "anonymous" DotSubGraphs into account.
fmap (DotSG False Nothing)
(parseBracesBased SubGraphAttribute parseUnqt)
parse = parseUnqt -- Don't want the option of quoting
`adjustErr`
("Not a valid Sub Graph\n\t"++)
parseUnqtList = sepBy (whitespace >> parseUnqt) newline'
parseList = parseUnqtList
instance Functor DotSubGraph where
fmap f sg = sg { subGraphStmts = fmap f $ subGraphStmts sg }
|
