1module Data.GraphViz.Attributes
2       (Attribute(..), Attributes, usedByGraphs, usedBySubGraphs,
3        usedByClusters, usedByNodes, usedByEdges, EscString, URL(..),
4        ArrowType(..), AspectType(..), Rect(..), ClusterMode(..),
5        DirType(..), DEConstraints(..), DPoint(..), ModeType(..),
6        Model(..), Label(..), Point(..), Overlap(..), LayerRange(..),
7        LayerID(..), LayerList(..), OutputMode(..), Pack(..), PackMode(..),
8        Pos(..), EdgeType(..), PageDir(..), Spline(..), QuadType(..),
9        Root(..), RankType(..), RankDir(..), Shape(..), SmoothType(..),
10        StartType(..), STStyle(..), StyleItem(..), StyleName(..),
11        PortPos(..), CompassPoint(..), ViewPort(..), FocusType(..),
12        VerticalPlacement(..), ScaleType(..), Justification(..),
13        Ratios(..), module Data.GraphViz.Attributes.Colors, ArrowShape(..),
14        ArrowModifier(..), ArrowFill(..), ArrowSide(..), box, crow,
15        diamond, dotArrow, inv, noArrow, normal, tee, vee, oDot, invDot,
16        invODot, oBox, oDiamond, eDiamond, openArr, halfOpen, emptyArr,
17        invEmpty, noMods, openMod, defLayerSep, notLayerSep)
18       where
19import Data.GraphViz.Attributes.Colors
20import Data.GraphViz.Util
21import Data.GraphViz.Parsing
22import Data.GraphViz.Printing
23import Data.Char (toLower)
24import Data.Maybe (isJust)
25import Control.Arrow (first)
26import Control.Monad (liftM, liftM2)
27
28data Attribute = Damping Double
29               | K Double
30               | URL URL
31               | ArrowHead ArrowType
32               | ArrowSize Double
33               | ArrowTail ArrowType
34               | Aspect AspectType
35               | Bb Rect
36               | BgColor Color
37               | Center Bool
38               | Charset String
39               | ClusterRank ClusterMode
40               | ColorScheme ColorScheme
41               | Color [Color]
42               | Comment String
43               | Compound Bool
44               | Concentrate Bool
45               | Constraint Bool
46               | Decorate Bool
47               | DefaultDist Double
48               | Dimen Int
49               | Dim Int
50               | Dir DirType
51               | DirEdgeConstraints DEConstraints
52               | Distortion Double
53               | DPI Double
54               | EdgeURL URL
55               | EdgeTarget EscString
56               | EdgeTooltip EscString
57               | Epsilon Double
58               | ESep DPoint
59               | FillColor Color
60               | FixedSize Bool
61               | FontColor Color
62               | FontName String
63               | FontNames String
64               | FontPath String
65               | FontSize Double
66               | Group String
67               | HeadURL URL
68               | HeadClip Bool
69               | HeadLabel Label
70               | HeadPort PortPos
71               | HeadTarget EscString
72               | HeadTooltip EscString
73               | Height Double
74               | ID Label
75               | Image String
76               | ImageScale ScaleType
77               | LabelURL URL
78               | LabelAngle Double
79               | LabelDistance Double
80               | LabelFloat Bool
81               | LabelFontColor Color
82               | LabelFontName String
83               | LabelFontSize Double
84               | LabelJust Justification
85               | LabelLoc VerticalPlacement
86               | LabelTarget EscString
87               | LabelTooltip EscString
88               | Label Label
89               | Landscape Bool
90               | LayerSep String
91               | Layers LayerList
92               | Layer LayerRange
93               | Layout String
94               | Len Double
95               | LevelsGap Double
96               | Levels Int
97               | LHead String
98               | LPos Point
99               | LTail String
100               | Margin DPoint
101               | MaxIter Int
102               | MCLimit Double
103               | MinDist Double
104               | MinLen Int
105               | Model Model
106               | Mode ModeType
107               | Mosek Bool
108               | NodeSep Double
109               | NoJustify Bool
110               | Normalize Bool
111               | Nslimit1 Double
112               | Nslimit Double
113               | Ordering String
114               | Orientation Double
115               | OutputOrder OutputMode
116               | OverlapScaling Double
117               | Overlap Overlap
118               | PackMode PackMode
119               | Pack Pack
120               | Pad DPoint
121               | PageDir PageDir
122               | Page Point
123               | PenColor Color
124               | PenWidth Double
125               | Peripheries Int
126               | Pin Bool
127               | Pos Pos
128               | QuadTree QuadType
129               | Quantum Double
130               | RankDir RankDir
131               | RankSep Double
132               | Rank RankType
133               | Ratio Ratios
134               | Rects Rect
135               | Regular Bool
136               | ReMinCross Bool
137               | RepulsiveForce Double
138               | Root Root
139               | Rotate Int
140               | SameHead String
141               | SameTail String
142               | SamplePoints Int
143               | SearchSize Int
144               | Sep DPoint
145               | ShapeFile String
146               | Shape Shape
147               | ShowBoxes Int
148               | Sides Int
149               | Size Point
150               | Skew Double
151               | Smoothing SmoothType
152               | SortV Int
153               | Splines EdgeType
154               | Start StartType
155               | StyleSheet String
156               | Style [StyleItem]
157               | TailURL URL
158               | TailClip Bool
159               | TailLabel Label
160               | TailPort PortPos
161               | TailTarget EscString
162               | TailTooltip EscString
163               | Target EscString
164               | Tooltip EscString
165               | TrueColor Bool
166               | Vertices [Point]
167               | ViewPort ViewPort
168               | VoroMargin Double
169               | Weight Double
170               | Width Double
171               | Z Double
172                   deriving (Eq, Ord, Show, Read)
173
174type Attributes = [Attribute]
175
176instance PrintDot Attribute where
177        unqtDot (Damping v) = printField "Damping" v
178        unqtDot (K v) = printField "K" v
179        unqtDot (URL v) = printField "URL" v
180        unqtDot (ArrowHead v) = printField "arrowhead" v
181        unqtDot (ArrowSize v) = printField "arrowsize" v
182        unqtDot (ArrowTail v) = printField "arrowtail" v
183        unqtDot (Aspect v) = printField "aspect" v
184        unqtDot (Bb v) = printField "bb" v
185        unqtDot (BgColor v) = printField "bgcolor" v
186        unqtDot (Center v) = printField "center" v
187        unqtDot (Charset v) = printField "charset" v
188        unqtDot (ClusterRank v) = printField "clusterrank" v
189        unqtDot (ColorScheme v) = printField "colorscheme" v
190        unqtDot (Color v) = printField "color" v
191        unqtDot (Comment v) = printField "comment" v
192        unqtDot (Compound v) = printField "compound" v
193        unqtDot (Concentrate v) = printField "concentrate" v
194        unqtDot (Constraint v) = printField "constraint" v
195        unqtDot (Decorate v) = printField "decorate" v
196        unqtDot (DefaultDist v) = printField "defaultdist" v
197        unqtDot (Dimen v) = printField "dimen" v
198        unqtDot (Dim v) = printField "dim" v
199        unqtDot (Dir v) = printField "dir" v
200        unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v
201        unqtDot (Distortion v) = printField "distortion" v
202        unqtDot (DPI v) = printField "dpi" v
203        unqtDot (EdgeURL v) = printField "edgeURL" v
204        unqtDot (EdgeTarget v) = printField "edgetarget" v
205        unqtDot (EdgeTooltip v) = printField "edgetooltip" v
206        unqtDot (Epsilon v) = printField "epsilon" v
207        unqtDot (ESep v) = printField "esep" v
208        unqtDot (FillColor v) = printField "fillcolor" v
209        unqtDot (FixedSize v) = printField "fixedsize" v
210        unqtDot (FontColor v) = printField "fontcolor" v
211        unqtDot (FontName v) = printField "fontname" v
212        unqtDot (FontNames v) = printField "fontnames" v
213        unqtDot (FontPath v) = printField "fontpath" v
214        unqtDot (FontSize v) = printField "fontsize" v
215        unqtDot (Group v) = printField "group" v
216        unqtDot (HeadURL v) = printField "headURL" v
217        unqtDot (HeadClip v) = printField "headclip" v
218        unqtDot (HeadLabel v) = printField "headlabel" v
219        unqtDot (HeadPort v) = printField "headport" v
220        unqtDot (HeadTarget v) = printField "headtarget" v
221        unqtDot (HeadTooltip v) = printField "headtooltip" v
222        unqtDot (Height v) = printField "height" v
223        unqtDot (ID v) = printField "id" v
224        unqtDot (Image v) = printField "image" v
225        unqtDot (ImageScale v) = printField "imagescale" v
226        unqtDot (LabelURL v) = printField "labelURL" v
227        unqtDot (LabelAngle v) = printField "labelangle" v
228        unqtDot (LabelDistance v) = printField "labeldistance" v
229        unqtDot (LabelFloat v) = printField "labelfloat" v
230        unqtDot (LabelFontColor v) = printField "labelfontcolor" v
231        unqtDot (LabelFontName v) = printField "labelfontname" v
232        unqtDot (LabelFontSize v) = printField "labelfontsize" v
233        unqtDot (LabelJust v) = printField "labeljust" v
234        unqtDot (LabelLoc v) = printField "labelloc" v
235        unqtDot (LabelTarget v) = printField "labeltarget" v
236        unqtDot (LabelTooltip v) = printField "labeltooltip" v
237        unqtDot (Label v) = printField "label" v
238        unqtDot (Landscape v) = printField "landscape" v
239        unqtDot (LayerSep v) = printField "layersep" v
240        unqtDot (Layers v) = printField "layers" v
241        unqtDot (Layer v) = printField "layer" v
242        unqtDot (Layout v) = printField "layout" v
243        unqtDot (Len v) = printField "len" v
244        unqtDot (LevelsGap v) = printField "levelsgap" v
245        unqtDot (Levels v) = printField "levels" v
246        unqtDot (LHead v) = printField "lhead" v
247        unqtDot (LPos v) = printField "lp" v
248        unqtDot (LTail v) = printField "ltail" v
249        unqtDot (Margin v) = printField "margin" v
250        unqtDot (MaxIter v) = printField "maxiter" v
251        unqtDot (MCLimit v) = printField "mclimit" v
252        unqtDot (MinDist v) = printField "mindist" v
253        unqtDot (MinLen v) = printField "minlen" v
254        unqtDot (Model v) = printField "model" v
255        unqtDot (Mode v) = printField "mode" v
256        unqtDot (Mosek v) = printField "mosek" v
257        unqtDot (NodeSep v) = printField "nodesep" v
258        unqtDot (NoJustify v) = printField "nojustify" v
259        unqtDot (Normalize v) = printField "normalize" v
260        unqtDot (Nslimit1 v) = printField "nslimit1" v
261        unqtDot (Nslimit v) = printField "nslimit" v
262        unqtDot (Ordering v) = printField "ordering" v
263        unqtDot (Orientation v) = printField "orientation" v
264        unqtDot (OutputOrder v) = printField "outputorder" v
265        unqtDot (OverlapScaling v) = printField "overlap_scaling" v
266        unqtDot (Overlap v) = printField "overlap" v
267        unqtDot (PackMode v) = printField "packmode" v
268        unqtDot (Pack v) = printField "pack" v
269        unqtDot (Pad v) = printField "pad" v
270        unqtDot (PageDir v) = printField "pagedir" v
271        unqtDot (Page v) = printField "page" v
272        unqtDot (PenColor v) = printField "pencolor" v
273        unqtDot (PenWidth v) = printField "penwidth" v
274        unqtDot (Peripheries v) = printField "peripheries" v
275        unqtDot (Pin v) = printField "pin" v
276        unqtDot (Pos v) = printField "pos" v
277        unqtDot (QuadTree v) = printField "quadtree" v
278        unqtDot (Quantum v) = printField "quantum" v
279        unqtDot (RankDir v) = printField "rankdir" v
280        unqtDot (RankSep v) = printField "ranksep" v
281        unqtDot (Rank v) = printField "rank" v
282        unqtDot (Ratio v) = printField "ratio" v
283        unqtDot (Rects v) = printField "rects" v
284        unqtDot (Regular v) = printField "regular" v
285        unqtDot (ReMinCross v) = printField "remincross" v
286        unqtDot (RepulsiveForce v) = printField "repulsiveforce" v
287        unqtDot (Root v) = printField "root" v
288        unqtDot (Rotate v) = printField "rotate" v
289        unqtDot (SameHead v) = printField "samehead" v
290        unqtDot (SameTail v) = printField "sametail" v
291        unqtDot (SamplePoints v) = printField "samplepoints" v
292        unqtDot (SearchSize v) = printField "searchsize" v
293        unqtDot (Sep v) = printField "sep" v
294        unqtDot (ShapeFile v) = printField "shapefile" v
295        unqtDot (Shape v) = printField "shape" v
296        unqtDot (ShowBoxes v) = printField "showboxes" v
297        unqtDot (Sides v) = printField "sides" v
298        unqtDot (Size v) = printField "size" v
299        unqtDot (Skew v) = printField "skew" v
300        unqtDot (Smoothing v) = printField "smoothing" v
301        unqtDot (SortV v) = printField "sortv" v
302        unqtDot (Splines v) = printField "splines" v
303        unqtDot (Start v) = printField "start" v
304        unqtDot (StyleSheet v) = printField "stylesheet" v
305        unqtDot (Style v) = printField "style" v
306        unqtDot (TailURL v) = printField "tailURL" v
307        unqtDot (TailClip v) = printField "tailclip" v
308        unqtDot (TailLabel v) = printField "taillabel" v
309        unqtDot (TailPort v) = printField "tailport" v
310        unqtDot (TailTarget v) = printField "tailtarget" v
311        unqtDot (TailTooltip v) = printField "tailtooltip" v
312        unqtDot (Target v) = printField "target" v
313        unqtDot (Tooltip v) = printField "tooltip" v
314        unqtDot (TrueColor v) = printField "truecolor" v
315        unqtDot (Vertices v) = printField "vertices" v
316        unqtDot (ViewPort v) = printField "viewport" v
317        unqtDot (VoroMargin v) = printField "voro_margin" v
318        unqtDot (Weight v) = printField "weight" v
319        unqtDot (Width v) = printField "width" v
320        unqtDot (Z v) = printField "z" v
321        listToDot = unqtListToDot
322
323instance ParseDot Attribute where
324        parseUnqt
325          = oneOf
326              [liftM Damping $ parseField "Damping", liftM K $ parseField "K",
327               liftM URL $ parseFields ["URL", "href"],
328               liftM ArrowHead $ parseField "arrowhead",
329               liftM ArrowSize $ parseField "arrowsize",
330               liftM ArrowTail $ parseField "arrowtail",
331               liftM Aspect $ parseField "aspect", liftM Bb $ parseField "bb",
332               liftM BgColor $ parseField "bgcolor",
333               liftM Center $ parseFieldBool "center",
334               liftM Charset $ parseField "charset",
335               liftM ClusterRank $ parseField "clusterrank",
336               liftM ColorScheme $ parseField "colorscheme",
337               liftM Color $ parseField "color",
338               liftM Comment $ parseField "comment",
339               liftM Compound $ parseFieldBool "compound",
340               liftM Concentrate $ parseFieldBool "concentrate",
341               liftM Constraint $ parseFieldBool "constraint",
342               liftM Decorate $ parseFieldBool "decorate",
343               liftM DefaultDist $ parseField "defaultdist",
344               liftM Dimen $ parseField "dimen", liftM Dim $ parseField "dim",
345               liftM Dir $ parseField "dir",
346               liftM DirEdgeConstraints $
347                 parseFieldDef EdgeConstraints "diredgeconstraints",
348               liftM Distortion $ parseField "distortion",
349               liftM DPI $ parseFields ["dpi", "resolution"],
350               liftM EdgeURL $ parseFields ["edgeURL", "edgehref"],
351               liftM EdgeTarget $ parseField "edgetarget",
352               liftM EdgeTooltip $ parseField "edgetooltip",
353               liftM Epsilon $ parseField "epsilon",
354               liftM ESep $ parseField "esep",
355               liftM FillColor $ parseField "fillcolor",
356               liftM FixedSize $ parseFieldBool "fixedsize",
357               liftM FontColor $ parseField "fontcolor",
358               liftM FontName $ parseField "fontname",
359               liftM FontNames $ parseField "fontnames",
360               liftM FontPath $ parseField "fontpath",
361               liftM FontSize $ parseField "fontsize",
362               liftM Group $ parseField "group",
363               liftM HeadURL $ parseFields ["headURL", "headhref"],
364               liftM HeadClip $ parseFieldBool "headclip",
365               liftM HeadLabel $ parseField "headlabel",
366               liftM HeadPort $ parseField "headport",
367               liftM HeadTarget $ parseField "headtarget",
368               liftM HeadTooltip $ parseField "headtooltip",
369               liftM Height $ parseField "height", liftM ID $ parseField "id",
370               liftM Image $ parseField "image",
371               liftM ImageScale $ parseFieldDef UniformScale "imagescale",
372               liftM LabelURL $ parseFields ["labelURL", "labelhref"],
373               liftM LabelAngle $ parseField "labelangle",
374               liftM LabelDistance $ parseField "labeldistance",
375               liftM LabelFloat $ parseFieldBool "labelfloat",
376               liftM LabelFontColor $ parseField "labelfontcolor",
377               liftM LabelFontName $ parseField "labelfontname",
378               liftM LabelFontSize $ parseField "labelfontsize",
379               liftM LabelJust $ parseField "labeljust",
380               liftM LabelLoc $ parseField "labelloc",
381               liftM LabelTarget $ parseField "labeltarget",
382               liftM LabelTooltip $ parseField "labeltooltip",
383               liftM Label $ parseField "label",
384               liftM Landscape $ parseFieldBool "landscape",
385               liftM LayerSep $ parseField "layersep",
386               liftM Layers $ parseField "layers",
387               liftM Layer $ parseField "layer",
388               liftM Layout $ parseField "layout", liftM Len $ parseField "len",
389               liftM LevelsGap $ parseField "levelsgap",
390               liftM Levels $ parseField "levels",
391               liftM LHead $ parseField "lhead", liftM LPos $ parseField "lp",
392               liftM LTail $ parseField "ltail",
393               liftM Margin $ parseField "margin",
394               liftM MaxIter $ parseField "maxiter",
395               liftM MCLimit $ parseField "mclimit",
396               liftM MinDist $ parseField "mindist",
397               liftM MinLen $ parseField "minlen",
398               liftM Model $ parseField "model", liftM Mode $ parseField "mode",
399               liftM Mosek $ parseFieldBool "mosek",
400               liftM NodeSep $ parseField "nodesep",
401               liftM NoJustify $ parseFieldBool "nojustify",
402               liftM Normalize $ parseFieldBool "normalize",
403               liftM Nslimit1 $ parseField "nslimit1",
404               liftM Nslimit $ parseField "nslimit",
405               liftM Ordering $ parseField "ordering",
406               liftM Orientation $ parseField "orientation",
407               liftM OutputOrder $ parseField "outputorder",
408               liftM OverlapScaling $ parseField "overlap_scaling",
409               liftM Overlap $ parseFieldDef KeepOverlaps "overlap",
410               liftM PackMode $ parseField "packmode",
411               liftM Pack $ parseFieldDef DoPack "pack",
412               liftM Pad $ parseField "pad", liftM PageDir $ parseField "pagedir",
413               liftM Page $ parseField "page",
414               liftM PenColor $ parseField "pencolor",
415               liftM PenWidth $ parseField "penwidth",
416               liftM Peripheries $ parseField "peripheries",
417               liftM Pin $ parseFieldBool "pin", liftM Pos $ parseField "pos",
418               liftM QuadTree $ parseFieldDef NormalQT "quadtree",
419               liftM Quantum $ parseField "quantum",
420               liftM RankDir $ parseField "rankdir",
421               liftM RankSep $ parseField "ranksep",
422               liftM Rank $ parseField "rank", liftM Ratio $ parseField "ratio",
423               liftM Rects $ parseField "rects",
424               liftM Regular $ parseFieldBool "regular",
425               liftM ReMinCross $ parseFieldBool "remincross",
426               liftM RepulsiveForce $ parseField "repulsiveforce",
427               liftM Root $ parseFieldDef IsCentral "root",
428               liftM Rotate $ parseField "rotate",
429               liftM SameHead $ parseField "samehead",
430               liftM SameTail $ parseField "sametail",
431               liftM SamplePoints $ parseField "samplepoints",
432               liftM SearchSize $ parseField "searchsize",
433               liftM Sep $ parseField "sep",
434               liftM ShapeFile $ parseField "shapefile",
435               liftM Shape $ parseField "shape",
436               liftM ShowBoxes $ parseField "showboxes",
437               liftM Sides $ parseField "sides", liftM Size $ parseField "size",
438               liftM Skew $ parseField "skew",
439               liftM Smoothing $ parseField "smoothing",
440               liftM SortV $ parseField "sortv",
441               liftM Splines $ parseFieldDef SplineEdges "splines",
442               liftM Start $ parseField "start",
443               liftM StyleSheet $ parseField "stylesheet",
444               liftM Style $ parseField "style",
445               liftM TailURL $ parseFields ["tailURL", "tailhref"],
446               liftM TailClip $ parseFieldBool "tailclip",
447               liftM TailLabel $ parseField "taillabel",
448               liftM TailPort $ parseField "tailport",
449               liftM TailTarget $ parseField "tailtarget",
450               liftM TailTooltip $ parseField "tailtooltip",
451               liftM Target $ parseField "target",
452               liftM Tooltip $ parseField "tooltip",
453               liftM TrueColor $ parseFieldBool "truecolor",
454               liftM Vertices $ parseField "vertices",
455               liftM ViewPort $ parseField "viewport",
456               liftM VoroMargin $ parseField "voro_margin",
457               liftM Weight $ parseField "weight",
458               liftM Width $ parseField "width", liftM Z $ parseField "z"]
459        parse = parseUnqt
460        parseList = parseUnqtList
461
462usedByGraphs :: Attribute -> Bool
463usedByGraphs Damping{} = True
464usedByGraphs K{} = True
465usedByGraphs URL{} = True
466usedByGraphs Aspect{} = True
467usedByGraphs Bb{} = True
468usedByGraphs BgColor{} = True
469usedByGraphs Center{} = True
470usedByGraphs Charset{} = True
471usedByGraphs ClusterRank{} = True
472usedByGraphs ColorScheme{} = True
473usedByGraphs Comment{} = True
474usedByGraphs Compound{} = True
475usedByGraphs Concentrate{} = True
476usedByGraphs DefaultDist{} = True
477usedByGraphs Dimen{} = True
478usedByGraphs Dim{} = True
479usedByGraphs DirEdgeConstraints{} = True
480usedByGraphs DPI{} = True
481usedByGraphs Epsilon{} = True
482usedByGraphs ESep{} = True
483usedByGraphs FontColor{} = True
484usedByGraphs FontName{} = True
485usedByGraphs FontNames{} = True
486usedByGraphs FontPath{} = True
487usedByGraphs FontSize{} = True
488usedByGraphs ID{} = True
489usedByGraphs LabelJust{} = True
490usedByGraphs LabelLoc{} = True
491usedByGraphs Label{} = True
492usedByGraphs Landscape{} = True
493usedByGraphs LayerSep{} = True
494usedByGraphs Layers{} = True
495usedByGraphs Layout{} = True
496usedByGraphs LevelsGap{} = True
497usedByGraphs Levels{} = True
498usedByGraphs LPos{} = True
499usedByGraphs Margin{} = True
500usedByGraphs MaxIter{} = True
501usedByGraphs MCLimit{} = True
502usedByGraphs MinDist{} = True
503usedByGraphs Model{} = True
504usedByGraphs Mode{} = True
505usedByGraphs Mosek{} = True
506usedByGraphs NodeSep{} = True
507usedByGraphs NoJustify{} = True
508usedByGraphs Normalize{} = True
509usedByGraphs Nslimit1{} = True
510usedByGraphs Nslimit{} = True
511usedByGraphs Ordering{} = True
512usedByGraphs OutputOrder{} = True
513usedByGraphs OverlapScaling{} = True
514usedByGraphs Overlap{} = True
515usedByGraphs PackMode{} = True
516usedByGraphs Pack{} = True
517usedByGraphs Pad{} = True
518usedByGraphs PageDir{} = True
519usedByGraphs Page{} = True
520usedByGraphs QuadTree{} = True
521usedByGraphs Quantum{} = True
522usedByGraphs RankDir{} = True
523usedByGraphs RankSep{} = True
524usedByGraphs Ratio{} = True
525usedByGraphs ReMinCross{} = True
526usedByGraphs RepulsiveForce{} = True
527usedByGraphs Root{} = True
528usedByGraphs Rotate{} = True
529usedByGraphs SearchSize{} = True
530usedByGraphs Sep{} = True
531usedByGraphs ShowBoxes{} = True
532usedByGraphs Size{} = True
533usedByGraphs Smoothing{} = True
534usedByGraphs SortV{} = True
535usedByGraphs Splines{} = True
536usedByGraphs Start{} = True
537usedByGraphs StyleSheet{} = True
538usedByGraphs Target{} = True
539usedByGraphs TrueColor{} = True
540usedByGraphs ViewPort{} = True
541usedByGraphs VoroMargin{} = True
542usedByGraphs _ = False
543
544usedByClusters :: Attribute -> Bool
545usedByClusters K{} = True
546usedByClusters URL{} = True
547usedByClusters BgColor{} = True
548usedByClusters ColorScheme{} = True
549usedByClusters Color{} = True
550usedByClusters FillColor{} = True
551usedByClusters FontColor{} = True
552usedByClusters FontName{} = True
553usedByClusters FontSize{} = True
554usedByClusters LabelJust{} = True
555usedByClusters LabelLoc{} = True
556usedByClusters Label{} = True
557usedByClusters LPos{} = True
558usedByClusters NoJustify{} = True
559usedByClusters PenColor{} = True
560usedByClusters PenWidth{} = True
561usedByClusters Peripheries{} = True
562usedByClusters Rank{} = True
563usedByClusters SortV{} = True
564usedByClusters Style{} = True
565usedByClusters Target{} = True
566usedByClusters Tooltip{} = True
567usedByClusters _ = False
568
569usedBySubGraphs :: Attribute -> Bool
570usedBySubGraphs Rank{} = True
571usedBySubGraphs _ = False
572
573usedByNodes :: Attribute -> Bool
574usedByNodes URL{} = True
575usedByNodes ColorScheme{} = True
576usedByNodes Color{} = True
577usedByNodes Comment{} = True
578usedByNodes Distortion{} = True
579usedByNodes FillColor{} = True
580usedByNodes FixedSize{} = True
581usedByNodes FontColor{} = True
582usedByNodes FontName{} = True
583usedByNodes FontSize{} = True
584usedByNodes Group{} = True
585usedByNodes Height{} = True
586usedByNodes ID{} = True
587usedByNodes Image{} = True
588usedByNodes ImageScale{} = True
589usedByNodes LabelLoc{} = True
590usedByNodes Label{} = True
591usedByNodes Layer{} = True
592usedByNodes Margin{} = True
593usedByNodes NoJustify{} = True
594usedByNodes Orientation{} = True
595usedByNodes PenWidth{} = True
596usedByNodes Peripheries{} = True
597usedByNodes Pin{} = True
598usedByNodes Pos{} = True
599usedByNodes Rects{} = True
600usedByNodes Regular{} = True
601usedByNodes Root{} = True
602usedByNodes SamplePoints{} = True
603usedByNodes ShapeFile{} = True
604usedByNodes Shape{} = True
605usedByNodes ShowBoxes{} = True
606usedByNodes Sides{} = True
607usedByNodes Skew{} = True
608usedByNodes SortV{} = True
609usedByNodes Style{} = True
610usedByNodes Target{} = True
611usedByNodes Tooltip{} = True
612usedByNodes Vertices{} = True
613usedByNodes Width{} = True
614usedByNodes Z{} = True
615usedByNodes _ = False
616
617usedByEdges :: Attribute -> Bool
618usedByEdges URL{} = True
619usedByEdges ArrowHead{} = True
620usedByEdges ArrowSize{} = True
621usedByEdges ArrowTail{} = True
622usedByEdges ColorScheme{} = True
623usedByEdges Color{} = True
624usedByEdges Comment{} = True
625usedByEdges Constraint{} = True
626usedByEdges Decorate{} = True
627usedByEdges Dir{} = True
628usedByEdges EdgeURL{} = True
629usedByEdges EdgeTarget{} = True
630usedByEdges EdgeTooltip{} = True
631usedByEdges FontColor{} = True
632usedByEdges FontName{} = True
633usedByEdges FontSize{} = True
634usedByEdges HeadURL{} = True
635usedByEdges HeadClip{} = True
636usedByEdges HeadLabel{} = True
637usedByEdges HeadPort{} = True
638usedByEdges HeadTarget{} = True
639usedByEdges HeadTooltip{} = True
640usedByEdges ID{} = True
641usedByEdges LabelURL{} = True
642usedByEdges LabelAngle{} = True
643usedByEdges LabelDistance{} = True
644usedByEdges LabelFloat{} = True
645usedByEdges LabelFontColor{} = True
646usedByEdges LabelFontName{} = True
647usedByEdges LabelFontSize{} = True
648usedByEdges LabelTarget{} = True
649usedByEdges LabelTooltip{} = True
650usedByEdges Label{} = True
651usedByEdges Layer{} = True
652usedByEdges Len{} = True
653usedByEdges LHead{} = True
654usedByEdges LPos{} = True
655usedByEdges LTail{} = True
656usedByEdges MinLen{} = True
657usedByEdges NoJustify{} = True
658usedByEdges PenWidth{} = True
659usedByEdges Pos{} = True
660usedByEdges SameHead{} = True
661usedByEdges SameTail{} = True
662usedByEdges ShowBoxes{} = True
663usedByEdges Style{} = True
664usedByEdges TailURL{} = True
665usedByEdges TailClip{} = True
666usedByEdges TailLabel{} = True
667usedByEdges TailPort{} = True
668usedByEdges TailTarget{} = True
669usedByEdges TailTooltip{} = True
670usedByEdges Target{} = True
671usedByEdges Tooltip{} = True
672usedByEdges Weight{} = True
673usedByEdges _ = False
674
675type EscString = String
676
677newtype URL = UStr{urlString :: EscString}
678                deriving (Eq, Ord, Show, Read)
679
680instance PrintDot URL where
681        unqtDot = wrap (char '<') (char '>') . text . urlString
682
683instance ParseDot URL where
684        parseUnqt
685          = liftM UStr $
686              bracket (character open) (character close)
687                (many1 $ satisfy ((/=) close))
688          where open = '<'
689                close = '>'
690        parse = parseUnqt
691
692newtype ArrowType = AType [(ArrowModifier, ArrowShape)]
693                      deriving (Eq, Ord, Show, Read)
694
695box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee ::
696     ArrowType
697
698oDot, invDot, invODot, oBox, oDiamond :: ArrowType
699
700eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType
701normal = AType [(noMods, Normal)]
702inv = AType [(noMods, Inv)]
703dotArrow = AType [(noMods, DotArrow)]
704invDot = AType [(noMods, Inv), (noMods, DotArrow)]
705oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)]
706invODot = AType [(noMods, Inv), (openMod, DotArrow)]
707noArrow = AType [(noMods, NoArrow)]
708tee = AType [(noMods, Tee)]
709emptyArr = AType [(openMod, Normal)]
710invEmpty = AType [(noMods, Inv), (openMod, Normal)]
711diamond = AType [(noMods, Diamond)]
712oDiamond = AType [(openMod, Diamond)]
713eDiamond = oDiamond
714crow = AType [(noMods, Crow)]
715box = AType [(noMods, Box)]
716oBox = AType [(openMod, Box)]
717openArr = vee
718halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]
719vee = AType [(noMods, Vee)]
720
721instance PrintDot ArrowType where
722        unqtDot (AType mas) = hcat $ map appMod mas
723          where appMod (m, a) = unqtDot m <> unqtDot a
724
725instance ParseDot ArrowType where
726        parseUnqt
727          = do mas <- many1 $
728                        do m <- parseUnqt
729                           a <- parseUnqt
730                           return (m, a)
731               return $ AType mas
732              `onFail` specialArrowParse
733
734specialArrowParse :: Parse ArrowType
735specialArrowParse
736  = oneOf
737      [stringRep eDiamond "ediamond", stringRep openArr "open",
738       stringRep halfOpen "halfopen", stringRep emptyArr "empty",
739       stringRep invEmpty "invempty"]
740
741data ArrowShape = Box
742                | Crow
743                | Diamond
744                | DotArrow
745                | Inv
746                | NoArrow
747                | Normal
748                | Tee
749                | Vee
750                    deriving (Eq, Ord, Bounded, Enum, Show, Read)
751
752instance PrintDot ArrowShape where
753        unqtDot Box = unqtDot "box"
754        unqtDot Crow = unqtDot "crow"
755        unqtDot Diamond = unqtDot "diamond"
756        unqtDot DotArrow = unqtDot "dot"
757        unqtDot Inv = unqtDot "inv"
758        unqtDot NoArrow = unqtDot "none"
759        unqtDot Normal = unqtDot "normal"
760        unqtDot Tee = unqtDot "tee"
761        unqtDot Vee = unqtDot "vee"
762
763instance ParseDot ArrowShape where
764        parseUnqt
765          = oneOf
766              [stringRep Box "box", stringRep Crow "crow",
767               stringRep Diamond "diamond", stringRep DotArrow "dot",
768               stringRep Inv "inv", stringRep NoArrow "none",
769               stringRep Normal "normal", stringRep Tee "tee",
770               stringRep Vee "vee"]
771
772data ArrowModifier = ArrMod{arrowFill :: ArrowFill,
773                            arrowSide :: ArrowSide}
774                       deriving (Eq, Ord, Show, Read)
775
776noMods :: ArrowModifier
777noMods = ArrMod FilledArrow BothSides
778
779openMod :: ArrowModifier
780openMod = ArrMod OpenArrow BothSides
781
782instance PrintDot ArrowModifier where
783        unqtDot (ArrMod f s) = unqtDot f <> unqtDot s
784
785instance ParseDot ArrowModifier where
786        parseUnqt
787          = do f <- parseUnqt
788               s <- parseUnqt
789               return $ ArrMod f s
790
791data ArrowFill = OpenArrow
792               | FilledArrow
793                   deriving (Eq, Ord, Bounded, Enum, Show, Read)
794
795instance PrintDot ArrowFill where
796        unqtDot OpenArrow = char 'o'
797        unqtDot FilledArrow = empty
798
799instance ParseDot ArrowFill where
800        parseUnqt
801          = liftM (bool FilledArrow OpenArrow . isJust) $
802              optional (character 'o')
803        parse = parseUnqt
804
805data ArrowSide = LeftSide
806               | RightSide
807               | BothSides
808                   deriving (Eq, Ord, Bounded, Enum, Show, Read)
809
810instance PrintDot ArrowSide where
811        unqtDot LeftSide = char 'l'
812        unqtDot RightSide = char 'r'
813        unqtDot BothSides = empty
814
815instance ParseDot ArrowSide where
816        parseUnqt
817          = liftM getSideType $ optional (oneOf $ map character ['l', 'r'])
818          where getSideType
819                  = maybe BothSides (bool RightSide LeftSide . (==) 'l')
820        parse = parseUnqt
821
822data AspectType = RatioOnly Double
823                | RatioPassCount Double Int
824                    deriving (Eq, Ord, Show, Read)
825
826instance PrintDot AspectType where
827        unqtDot (RatioOnly r) = unqtDot r
828        unqtDot (RatioPassCount r p) = commaDel r p
829        toDot at@RatioOnly{} = unqtDot at
830        toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at
831
832instance ParseDot AspectType where
833        parseUnqt
834          = liftM (uncurry RatioPassCount) commaSepUnqt `onFail`
835              liftM RatioOnly parseUnqt
836        parse
837          = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)
838              `onFail` liftM RatioOnly parse
839
840data Rect = Rect Point Point
841              deriving (Eq, Ord, Show, Read)
842
843instance PrintDot Rect where
844        unqtDot (Rect p1 p2) = commaDel p1 p2
845        toDot = doubleQuotes . unqtDot
846
847instance ParseDot Rect where
848        parseUnqt = liftM (uncurry Rect) commaSepUnqt
849        parse = quotedParse parseUnqt
850
851data ClusterMode = Local
852                 | Global
853                 | NoCluster
854                     deriving (Eq, Ord, Bounded, Enum, Show, Read)
855
856instance PrintDot ClusterMode where
857        unqtDot Local = unqtDot "local"
858        unqtDot Global = unqtDot "global"
859        unqtDot NoCluster = unqtDot "none"
860
861instance ParseDot ClusterMode where
862        parseUnqt
863          = oneOf
864              [stringRep Local "local", stringRep Global "global",
865               stringRep NoCluster "none"]
866
867data DirType = Forward
868             | Back
869             | Both
870             | NoDir
871                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
872
873instance PrintDot DirType where
874        unqtDot Forward = unqtDot "forward"
875        unqtDot Back = unqtDot "back"
876        unqtDot Both = unqtDot "both"
877        unqtDot NoDir = unqtDot "none"
878
879instance ParseDot DirType where
880        parseUnqt
881          = oneOf
882              [stringRep Forward "forward", stringRep Back "back",
883               stringRep Both "both", stringRep NoDir "none"]
884
885data DEConstraints = EdgeConstraints
886                   | NoConstraints
887                   | HierConstraints
888                       deriving (Eq, Ord, Bounded, Enum, Show, Read)
889
890instance PrintDot DEConstraints where
891        unqtDot EdgeConstraints = unqtDot True
892        unqtDot NoConstraints = unqtDot False
893        unqtDot HierConstraints = text "hier"
894
895instance ParseDot DEConstraints where
896        parseUnqt
897          = liftM (bool NoConstraints EdgeConstraints) parse `onFail`
898              stringRep HierConstraints "hier"
899
900data DPoint = DVal Double
901            | PVal Point
902                deriving (Eq, Ord, Show, Read)
903
904instance PrintDot DPoint where
905        unqtDot (DVal d) = unqtDot d
906        unqtDot (PVal p) = unqtDot p
907        toDot (DVal d) = toDot d
908        toDot (PVal p) = toDot p
909
910instance ParseDot DPoint where
911        parseUnqt = liftM PVal parseUnqt `onFail` liftM DVal parseUnqt
912        parse = liftM PVal parse `onFail` liftM DVal parse
913
914data ModeType = Major
915              | KK
916              | Hier
917              | IpSep
918                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
919
920instance PrintDot ModeType where
921        unqtDot Major = text "major"
922        unqtDot KK = text "KK"
923        unqtDot Hier = text "hier"
924        unqtDot IpSep = text "ipsep"
925
926instance ParseDot ModeType where
927        parseUnqt
928          = oneOf
929              [stringRep Major "major", stringRep KK "KK", stringRep Hier "hier",
930               stringRep IpSep "ipsep"]
931
932data Model = ShortPath
933           | SubSet
934           | Circuit
935               deriving (Eq, Ord, Bounded, Enum, Show, Read)
936
937instance PrintDot Model where
938        unqtDot ShortPath = text "shortpath"
939        unqtDot SubSet = text "subset"
940        unqtDot Circuit = text "circuit"
941
942instance ParseDot Model where
943        parseUnqt
944          = oneOf
945              [stringRep ShortPath "shortpath", stringRep SubSet "subset",
946               stringRep Circuit "circuit"]
947
948data Label = StrLabel EscString
949           | URLLabel URL
950               deriving (Eq, Ord, Show, Read)
951
952instance PrintDot Label where
953        unqtDot (StrLabel s) = unqtDot s
954        unqtDot (URLLabel u) = unqtDot u
955        toDot (StrLabel s) = toDot s
956        toDot (URLLabel u) = toDot u
957
958instance ParseDot Label where
959        parseUnqt
960          = liftM StrLabel parseUnqt `onFail` liftM URLLabel parseUnqt
961        parse = liftM StrLabel parse `onFail` liftM URLLabel parse
962
963data Point = Point Int Int
964           | PointD Double Double
965               deriving (Eq, Ord, Show, Read)
966
967instance PrintDot Point where
968        unqtDot (Point x y) = commaDel x y
969        unqtDot (PointD x y) = commaDel x y
970        toDot = doubleQuotes . unqtDot
971        unqtListToDot = hsep . map unqtDot
972        listToDot = doubleQuotes . unqtListToDot
973
974instance ParseDot Point where
975        parseUnqt
976          = intDblPoint `onFail` liftM (uncurry Point) commaSepUnqt `onFail`
977              liftM (uncurry PointD) commaSepUnqt
978          where intDblPoint
979                  = liftM (uncurry PointD . first fI) $
980                      commaSep' parseUnqt parseStrictFloat
981
982                fI :: Int -> Double
983                fI = fromIntegral
984        parse = quotedParse parseUnqt
985        parseUnqtList = sepBy1 parseUnqt whitespace
986
987data Overlap = KeepOverlaps
988             | RemoveOverlaps
989             | ScaleOverlaps
990             | ScaleXYOverlaps
991             | PrismOverlap (Maybe Int)
992             | CompressOverlap
993             | VpscOverlap
994             | IpsepOverlap
995                 deriving (Eq, Ord, Show, Read)
996
997instance PrintDot Overlap where
998        unqtDot KeepOverlaps = unqtDot True
999        unqtDot RemoveOverlaps = unqtDot False
1000        unqtDot ScaleOverlaps = text "scale"
1001        unqtDot ScaleXYOverlaps = text "scalexy"
1002        unqtDot (PrismOverlap i)
1003          = maybe id (flip (<>) . unqtDot) i $ text "prism"
1004        unqtDot CompressOverlap = text "compress"
1005        unqtDot VpscOverlap = text "vpsc"
1006        unqtDot IpsepOverlap = text "ipsep"
1007
1008instance ParseDot Overlap where
1009        parseUnqt
1010          = oneOf
1011              [stringRep KeepOverlaps "true", stringRep RemoveOverlaps "false",
1012               stringRep ScaleXYOverlaps "scalexy",
1013               stringRep ScaleOverlaps "scale",
1014               string "prism" >> liftM PrismOverlap (optional parse),
1015               stringRep CompressOverlap "compress", stringRep VpscOverlap "vpsc",
1016               stringRep IpsepOverlap "ipsep"]
1017
1018data LayerRange = LRID LayerID
1019                | LRS LayerID String LayerID
1020                    deriving (Eq, Ord, Show, Read)
1021
1022instance PrintDot LayerRange where
1023        unqtDot (LRID lid) = unqtDot lid
1024        unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2
1025        toDot (LRID lid) = toDot lid
1026        toDot lrs = doubleQuotes $ unqtDot lrs
1027
1028instance ParseDot LayerRange where
1029        parseUnqt
1030          = do id1 <- parseUnqt
1031               s <- parseLayerSep
1032               id2 <- parseUnqt
1033               return $ LRS id1 s id2
1034              `onFail` liftM LRID parseUnqt
1035        parse
1036          = quotedParse
1037              (do id1 <- parseUnqt
1038                  s <- parseLayerSep
1039                  id2 <- parseUnqt
1040                  return $ LRS id1 s id2)
1041              `onFail` liftM LRID parse
1042
1043parseLayerSep :: Parse String
1044parseLayerSep = many1 . oneOf $ map character defLayerSep
1045
1046defLayerSep :: [Char]
1047defLayerSep = [' ', ':', '\t']
1048
1049parseLayerName :: Parse String
1050parseLayerName
1051  = many1 . orQuote $
1052      satisfy (liftM2 (&&) notLayerSep ((/=) quoteChar))
1053
1054parseLayerName' :: Parse String
1055parseLayerName' = stringBlock `onFail` quotedParse parseLayerName
1056
1057notLayerSep :: Char -> Bool
1058notLayerSep = flip notElem defLayerSep
1059
1060data LayerID = AllLayers
1061             | LRInt Int
1062             | LRName String
1063                 deriving (Eq, Ord, Show, Read)
1064
1065instance PrintDot LayerID where
1066        unqtDot AllLayers = text "all"
1067        unqtDot (LRInt n) = unqtDot n
1068        unqtDot (LRName nm) = unqtDot nm
1069        toDot (LRName nm) = toDot nm
1070        toDot li = unqtDot li
1071
1072instance ParseDot LayerID where
1073        parseUnqt = liftM checkLayerName parseLayerName
1074        parse
1075          = oneOf [liftM checkLayerName parseLayerName', liftM LRInt parse]
1076
1077checkLayerName :: String -> LayerID
1078checkLayerName str = maybe checkAll LRInt $ stringToInt str
1079  where checkAll
1080          = if map toLower str == "all" then AllLayers else LRName str
1081
1082data LayerList = LL String [(String, String)]
1083                   deriving (Eq, Ord, Show, Read)
1084
1085instance PrintDot LayerList where
1086        unqtDot (LL l1 ols) = unqtDot l1 <> hcat (map subLL ols)
1087          where subLL (s, l) = unqtDot s <> unqtDot l
1088        toDot (LL l1 []) = toDot l1
1089        toDot ll = doubleQuotes $ unqtDot ll
1090
1091instance ParseDot LayerList where
1092        parseUnqt
1093          = do l1 <- parseLayerName
1094               ols <- many $
1095                        do s <- parseLayerSep
1096                           lnm <- parseLayerName
1097                           return (s, lnm)
1098               return $ LL l1 ols
1099        parse
1100          = quotedParse parseUnqt `onFail`
1101              liftM (flip LL []) (parseLayerName' `onFail` numString)
1102
1103data OutputMode = BreadthFirst
1104                | NodesFirst
1105                | EdgesFirst
1106                    deriving (Eq, Ord, Bounded, Enum, Show, Read)
1107
1108instance PrintDot OutputMode where
1109        unqtDot BreadthFirst = text "breadthfirst"
1110        unqtDot NodesFirst = text "nodesfirst"
1111        unqtDot EdgesFirst = text "edgesfirst"
1112
1113instance ParseDot OutputMode where
1114        parseUnqt
1115          = oneOf
1116              [stringRep BreadthFirst "breadthfirst",
1117               stringRep NodesFirst "nodesfirst",
1118               stringRep EdgesFirst "edgesfirst"]
1119
1120data Pack = DoPack
1121          | DontPack
1122          | PackMargin Int
1123              deriving (Eq, Ord, Show, Read)
1124
1125instance PrintDot Pack where
1126        unqtDot DoPack = unqtDot True
1127        unqtDot DontPack = unqtDot False
1128        unqtDot (PackMargin m) = unqtDot m
1129
1130instance ParseDot Pack where
1131        parseUnqt
1132          = oneOf
1133              [liftM PackMargin parseUnqt, liftM (bool DontPack DoPack) onlyBool]
1134
1135data PackMode = PackNode
1136              | PackClust
1137              | PackGraph
1138              | PackArray Bool Bool (Maybe Int)
1139                  deriving (Eq, Ord, Show, Read)
1140
1141instance PrintDot PackMode where
1142        unqtDot PackNode = text "node"
1143        unqtDot PackClust = text "clust"
1144        unqtDot PackGraph = text "graph"
1145        unqtDot (PackArray c u mi)
1146          = addNum . isU . isC . isUnder $ text "array"
1147          where addNum = maybe id (flip (<>) . unqtDot) mi
1148                isUnder = if c || u then flip (<>) $ char '_' else id
1149                isC = if c then flip (<>) $ char 'c' else id
1150                isU = if u then flip (<>) $ char 'u' else id
1151
1152instance ParseDot PackMode where
1153        parseUnqt
1154          = oneOf
1155              [stringRep PackNode "node", stringRep PackClust "clust",
1156               stringRep PackGraph "graph",
1157               do string "array"
1158                  mcu <- optional $
1159                           do character '_'
1160                              many1 $ satisfy isCU
1161                  let c = hasCharacter mcu 'c'
1162                      u = hasCharacter mcu 'u'
1163                  mi <- optional parseUnqt
1164                  return $ PackArray c u mi]
1165          where hasCharacter ms c = maybe False (elem c) ms
1166                isCU = flip elem ['c', 'u']
1167
1168data Pos = PointPos Point
1169         | SplinePos [Spline]
1170             deriving (Eq, Ord, Show, Read)
1171
1172instance PrintDot Pos where
1173        unqtDot (PointPos p) = unqtDot p
1174        unqtDot (SplinePos ss) = unqtDot ss
1175        toDot (PointPos p) = toDot p
1176        toDot (SplinePos ss) = toDot ss
1177
1178instance ParseDot Pos where
1179        parseUnqt
1180          = do splns <- parseUnqt
1181               case splns of
1182                   [Spline Nothing Nothing [p]] -> return $ PointPos p
1183                   _ -> return $ SplinePos splns
1184        parse = quotedParse parseUnqt
1185
1186data EdgeType = SplineEdges
1187              | LineEdges
1188              | NoEdges
1189              | PolyLine
1190              | CompoundEdge
1191                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
1192
1193instance PrintDot EdgeType where
1194        unqtDot SplineEdges = toDot True
1195        unqtDot LineEdges = toDot False
1196        unqtDot NoEdges = empty
1197        unqtDot PolyLine = text "polyline"
1198        unqtDot CompoundEdge = text "compound"
1199        toDot NoEdges = doubleQuotes empty
1200        toDot et = unqtDot et
1201
1202instance ParseDot EdgeType where
1203        parseUnqt
1204          = oneOf
1205              [liftM (bool LineEdges SplineEdges) parse,
1206               stringRep SplineEdges "spline", stringRep LineEdges "line",
1207               stringRep PolyLine "polyline", stringRep CompoundEdge "compound"]
1208        parse = stringRep NoEdges "\"\"" `onFail` optionalQuoted parseUnqt
1209
1210data PageDir = Bl
1211             | Br
1212             | Tl
1213             | Tr
1214             | Rb
1215             | Rt
1216             | Lb
1217             | Lt
1218                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
1219
1220instance PrintDot PageDir where
1221        unqtDot Bl = text "BL"
1222        unqtDot Br = text "BR"
1223        unqtDot Tl = text "TL"
1224        unqtDot Tr = text "TR"
1225        unqtDot Rb = text "RB"
1226        unqtDot Rt = text "RT"
1227        unqtDot Lb = text "LB"
1228        unqtDot Lt = text "LT"
1229
1230instance ParseDot PageDir where
1231        parseUnqt
1232          = oneOf
1233              [stringRep Bl "BL", stringRep Br "BR", stringRep Tl "TL",
1234               stringRep Tr "TR", stringRep Rb "RB", stringRep Rt "RT",
1235               stringRep Lb "LB", stringRep Lt "LT"]
1236
1237data Spline = Spline (Maybe Point) (Maybe Point) [Point]
1238                deriving (Eq, Ord, Show, Read)
1239
1240instance PrintDot Spline where
1241        unqtDot (Spline ms me ps) = addS . addE . hsep $ map unqtDot ps
1242          where addP t = maybe id ((<+>) . commaDel t)
1243                addS = addP 's' ms
1244                addE = addP 'e' me
1245        toDot = doubleQuotes . unqtDot
1246        unqtListToDot = hcat . punctuate semi . map unqtDot
1247        listToDot = doubleQuotes . unqtListToDot
1248
1249instance ParseDot Spline where
1250        parseUnqt
1251          = do ms <- parseP 's'
1252               me <- parseP 'e'
1253               ps <- sepBy1 parseUnqt whitespace
1254               return $ Spline ms me ps
1255          where parseP t
1256                  = optional $
1257                      do character t
1258                         parseComma
1259                         parseUnqt `discard` whitespace
1260        parse = quotedParse parseUnqt
1261        parseUnqtList = sepBy1 parseUnqt (character ';')
1262
1263data QuadType = NormalQT
1264              | FastQT
1265              | NoQT
1266                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
1267
1268instance PrintDot QuadType where
1269        unqtDot NormalQT = text "normal"
1270        unqtDot FastQT = text "fast"
1271        unqtDot NoQT = text "none"
1272
1273instance ParseDot QuadType where
1274        parseUnqt
1275          = oneOf
1276              [stringRep NormalQT "normal", stringRep FastQT "fast",
1277               stringRep NoQT "none", character '2' >> return FastQT,
1278               liftM (bool NoQT NormalQT) parse]
1279
1280data Root = IsCentral
1281          | NotCentral
1282          | NodeName String
1283              deriving (Eq, Ord, Show, Read)
1284
1285instance PrintDot Root where
1286        unqtDot IsCentral = unqtDot True
1287        unqtDot NotCentral = unqtDot False
1288        unqtDot (NodeName n) = unqtDot n
1289        toDot (NodeName n) = toDot n
1290        toDot r = unqtDot r
1291
1292instance ParseDot Root where
1293        parseUnqt
1294          = liftM (bool NotCentral IsCentral) onlyBool `onFail`
1295              liftM NodeName parseUnqt
1296        parse
1297          = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool)
1298              `onFail` liftM NodeName parse
1299
1300data RankType = SameRank
1301              | MinRank
1302              | SourceRank
1303              | MaxRank
1304              | SinkRank
1305                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
1306
1307instance PrintDot RankType where
1308        unqtDot SameRank = text "same"
1309        unqtDot MinRank = text "min"
1310        unqtDot SourceRank = text "source"
1311        unqtDot MaxRank = text "max"
1312        unqtDot SinkRank = text "sink"
1313
1314instance ParseDot RankType where
1315        parseUnqt
1316          = oneOf
1317              [stringRep SameRank "same", stringRep MinRank "min",
1318               stringRep SourceRank "source", stringRep MaxRank "max",
1319               stringRep SinkRank "sink"]
1320
1321data RankDir = FromTop
1322             | FromLeft
1323             | FromBottom
1324             | FromRight
1325                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
1326
1327instance PrintDot RankDir where
1328        unqtDot FromTop = text "TB"
1329        unqtDot FromLeft = text "LR"
1330        unqtDot FromBottom = text "BT"
1331        unqtDot FromRight = text "RL"
1332
1333instance ParseDot RankDir where
1334        parseUnqt
1335          = oneOf
1336              [stringRep FromTop "TB", stringRep FromLeft "LR",
1337               stringRep FromBottom "BT", stringRep FromRight "RL"]
1338
1339data Shape = BoxShape
1340           | Polygon
1341           | Ellipse
1342           | Circle
1343           | PointShape
1344           | Egg
1345           | Triangle
1346           | PlainText
1347           | DiamondShape
1348           | Trapezium
1349           | Parallelogram
1350           | House
1351           | Pentagon
1352           | Hexagon
1353           | Septagon
1354           | Octagon
1355           | DoubleCircle
1356           | DoubleOctagon
1357           | TripleOctagon
1358           | InvTriangle
1359           | InvTrapezium
1360           | InvHouse
1361           | MDiamond
1362           | MSquare
1363           | MCircle
1364           | Note
1365           | Tab
1366           | Folder
1367           | Box3D
1368           | Component
1369               deriving (Eq, Ord, Bounded, Enum, Show, Read)
1370
1371instance PrintDot Shape where
1372        unqtDot BoxShape = text "box"
1373        unqtDot Polygon = text "polygon"
1374        unqtDot Ellipse = text "ellipse"
1375        unqtDot Circle = text "circle"
1376        unqtDot PointShape = text "point"
1377        unqtDot Egg = text "egg"
1378        unqtDot Triangle = text "triangle"
1379        unqtDot PlainText = text "plaintext"
1380        unqtDot DiamondShape = text "diamond"
1381        unqtDot Trapezium = text "trapezium"
1382        unqtDot Parallelogram = text "parallelogram"
1383        unqtDot House = text "house"
1384        unqtDot Pentagon = text "pentagon"
1385        unqtDot Hexagon = text "hexagon"
1386        unqtDot Septagon = text "septagon"
1387        unqtDot Octagon = text "octagon"
1388        unqtDot DoubleCircle = text "doublecircle"
1389        unqtDot DoubleOctagon = text "doubleoctagon"
1390        unqtDot TripleOctagon = text "tripleoctagon"
1391        unqtDot InvTriangle = text "invtriangle"
1392        unqtDot InvTrapezium = text "invtrapezium"
1393        unqtDot InvHouse = text "invhouse"
1394        unqtDot MDiamond = text "Mdiamond"
1395        unqtDot MSquare = text "Msquare"
1396        unqtDot MCircle = text "Mcircle"
1397        unqtDot Note = text "note"
1398        unqtDot Tab = text "tab"
1399        unqtDot Folder = text "folder"
1400        unqtDot Box3D = text "box3d"
1401        unqtDot Component = text "component"
1402
1403instance ParseDot Shape where
1404        parseUnqt
1405          = oneOf
1406              [stringRep Box3D "box3d",
1407               stringReps BoxShape ["box", "rectangle", "rect"],
1408               stringRep Polygon "polygon", stringRep Ellipse "ellipse",
1409               stringRep Circle "circle", stringRep PointShape "point",
1410               stringRep Egg "egg", stringRep Triangle "triangle",
1411               stringReps PlainText ["plaintext", "none"],
1412               stringRep DiamondShape "diamond", stringRep Trapezium "trapezium",
1413               stringRep Parallelogram "parallelogram", stringRep House "house",
1414               stringRep Pentagon "pentagon", stringRep Hexagon "hexagon",
1415               stringRep Septagon "septagon", stringRep Octagon "octagon",
1416               stringRep DoubleCircle "doublecircle",
1417               stringRep DoubleOctagon "doubleoctagon",
1418               stringRep TripleOctagon "tripleoctagon",
1419               stringRep InvTriangle "invtriangle",
1420               stringRep InvTrapezium "invtrapezium",
1421               stringRep InvHouse "invhouse", stringRep MDiamond "Mdiamond",
1422               stringRep MSquare "Msquare", stringRep MCircle "Mcircle",
1423               stringRep Note "note", stringRep Tab "tab",
1424               stringRep Folder "folder", stringRep Component "component"]
1425
1426data SmoothType = NoSmooth
1427                | AvgDist
1428                | GraphDist
1429                | PowerDist
1430                | RNG
1431                | Spring
1432                | TriangleSmooth
1433                    deriving (Eq, Ord, Bounded, Enum, Show, Read)
1434
1435instance PrintDot SmoothType where
1436        unqtDot NoSmooth = text "none"
1437        unqtDot AvgDist = text "avg_dist"
1438        unqtDot GraphDist = text "graph_dist"
1439        unqtDot PowerDist = text "power_dist"
1440        unqtDot RNG = text "rng"
1441        unqtDot Spring = text "spring"
1442        unqtDot TriangleSmooth = text "triangle"
1443
1444instance ParseDot SmoothType where
1445        parseUnqt
1446          = oneOf
1447              [stringRep NoSmooth "none", stringRep AvgDist "avg_dist",
1448               stringRep GraphDist "graph_dist", stringRep PowerDist "power_dist",
1449               stringRep RNG "rng", stringRep Spring "spring",
1450               stringRep TriangleSmooth "triangle"]
1451
1452data StartType = StartStyle STStyle
1453               | StartSeed Int
1454               | StartStyleSeed STStyle Int
1455                   deriving (Eq, Ord, Show, Read)
1456
1457instance PrintDot StartType where
1458        unqtDot (StartStyle ss) = unqtDot ss
1459        unqtDot (StartSeed s) = unqtDot s
1460        unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s
1461
1462instance ParseDot StartType where
1463        parseUnqt
1464          = oneOf
1465              [do ss <- parseUnqt
1466                  s <- parseUnqt
1467                  return $ StartStyleSeed ss s,
1468               liftM StartStyle parseUnqt, liftM StartSeed parseUnqt]
1469
1470data STStyle = RegularStyle
1471             | SelfStyle
1472             | RandomStyle
1473                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
1474
1475instance PrintDot STStyle where
1476        unqtDot RegularStyle = text "regular"
1477        unqtDot SelfStyle = text "self"
1478        unqtDot RandomStyle = text "random"
1479
1480instance ParseDot STStyle where
1481        parseUnqt
1482          = oneOf
1483              [stringRep RegularStyle "regular", stringRep SelfStyle "self",
1484               stringRep RandomStyle "random"]
1485
1486data StyleItem = SItem StyleName [String]
1487                   deriving (Eq, Ord, Show, Read)
1488
1489instance PrintDot StyleItem where
1490        unqtDot (SItem nm args)
1491          | null args = dnm
1492          | otherwise = dnm <> parens args'
1493          where dnm = unqtDot nm
1494                args' = hcat . punctuate comma $ map unqtDot args
1495        toDot si@(SItem nm args)
1496          | null args = toDot nm
1497          | otherwise = doubleQuotes $ unqtDot si
1498        unqtListToDot = hcat . punctuate comma . map unqtDot
1499        listToDot [SItem nm []] = toDot nm
1500        listToDot sis = doubleQuotes $ unqtListToDot sis
1501
1502instance ParseDot StyleItem where
1503        parseUnqt
1504          = do nm <- parseUnqt
1505               args <- tryParseList' parseArgs
1506               return $ SItem nm args
1507        parse
1508          = quotedParse (liftM2 SItem parseUnqt parseArgs) `onFail`
1509              liftM (flip SItem []) parse
1510        parseUnqtList = sepBy1 parseUnqt parseComma
1511        parseList = quotedParse parseUnqtList `onFail` liftM return parse
1512
1513parseArgs :: Parse [String]
1514parseArgs
1515  = bracketSep (character '(') parseComma (character ')')
1516      parseStyleName
1517
1518data StyleName = Dashed
1519               | Dotted
1520               | Solid
1521               | Bold
1522               | Invisible
1523               | Filled
1524               | Diagonals
1525               | Rounded
1526               | DD String
1527                   deriving (Eq, Ord, Show, Read)
1528
1529instance PrintDot StyleName where
1530        unqtDot Dashed = text "dashed"
1531        unqtDot Dotted = text "dotted"
1532        unqtDot Solid = text "solid"
1533        unqtDot Bold = text "bold"
1534        unqtDot Invisible = text "invis"
1535        unqtDot Filled = text "filled"
1536        unqtDot Diagonals = text "diagonals"
1537        unqtDot Rounded = text "rounded"
1538        unqtDot (DD nm) = unqtDot nm
1539        toDot (DD nm) = toDot nm
1540        toDot sn = unqtDot sn
1541
1542instance ParseDot StyleName where
1543        parseUnqt = liftM checkDD parseStyleName
1544        parse
1545          = liftM checkDD $
1546              quotedParse parseStyleName `onFail`
1547                do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ', ']']
1548                   r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',', ']'])
1549                   return $ f : r
1550
1551checkDD :: String -> StyleName
1552checkDD str
1553  = case map toLower str of
1554        "dashed" -> Dashed
1555        "dotted" -> Dotted
1556        "solid" -> Solid
1557        "bold" -> Bold
1558        "invis" -> Invisible
1559        "filled" -> Filled
1560        "diagonals" -> Diagonals
1561        "rounded" -> Rounded
1562        _ -> DD str
1563
1564parseStyleName :: Parse String
1565parseStyleName
1566  = do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ']
1567       r <- many (orQuote $ noneOf [quoteChar, '(', ')', ','])
1568       return $ f : r
1569
1570newtype PortPos = PP CompassPoint
1571                    deriving (Eq, Ord, Show, Read)
1572
1573instance PrintDot PortPos where
1574        unqtDot (PP cp) = unqtDot cp
1575        toDot (PP cp) = toDot cp
1576
1577instance ParseDot PortPos where
1578        parseUnqt = liftM PP parseUnqt
1579
1580data CompassPoint = North
1581                  | NorthEast
1582                  | East
1583                  | SouthEast
1584                  | South
1585                  | SouthWest
1586                  | West
1587                  | NorthWest
1588                  | CenterPoint
1589                  | NoCP
1590                      deriving (Eq, Ord, Bounded, Enum, Show, Read)
1591
1592instance PrintDot CompassPoint where
1593        unqtDot NorthEast = text "ne"
1594        unqtDot NorthWest = text "nw"
1595        unqtDot North = text "n"
1596        unqtDot East = text "e"
1597        unqtDot SouthEast = text "se"
1598        unqtDot SouthWest = text "sw"
1599        unqtDot South = text "s"
1600        unqtDot West = text "w"
1601        unqtDot CenterPoint = text "c"
1602        unqtDot NoCP = text "_"
1603
1604instance ParseDot CompassPoint where
1605        parseUnqt
1606          = oneOf
1607              [stringRep NorthEast "ne", stringRep NorthWest "nw",
1608               stringRep North "n", stringRep SouthEast "se",
1609               stringRep SouthWest "sw", stringRep South "s", stringRep East "e",
1610               stringRep West "w", stringRep CenterPoint "c", stringRep NoCP "_"]
1611
1612data ViewPort = VP{wVal :: Double, hVal :: Double, zVal :: Double,
1613                   focus :: Maybe FocusType}
1614                  deriving (Eq, Ord, Show, Read)
1615
1616instance PrintDot ViewPort where
1617        unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot) $ focus vp
1618          where vs
1619                  = hcat . punctuate comma $
1620                      map (unqtDot . flip ($) vp) [wVal, hVal, zVal]
1621        toDot = doubleQuotes . unqtDot
1622
1623instance ParseDot ViewPort where
1624        parseUnqt
1625          = do wv <- parseUnqt
1626               parseComma
1627               hv <- parseUnqt
1628               parseComma
1629               zv <- parseUnqt
1630               mf <- optional $ parseComma >> parseUnqt
1631               return $ VP wv hv zv mf
1632        parse = quotedParse parseUnqt
1633
1634data FocusType = XY Point
1635               | NodeFocus String
1636                   deriving (Eq, Ord, Show, Read)
1637
1638instance PrintDot FocusType where
1639        unqtDot (XY p) = unqtDot p
1640        unqtDot (NodeFocus nm) = unqtDot nm
1641        toDot (XY p) = toDot p
1642        toDot (NodeFocus nm) = toDot nm
1643
1644instance ParseDot FocusType where
1645        parseUnqt = liftM XY parseUnqt `onFail` liftM NodeFocus parseUnqt
1646        parse = liftM XY parse `onFail` liftM NodeFocus parse
1647
1648data VerticalPlacement = VTop
1649                       | VCenter
1650                       | VBottom
1651                           deriving (Eq, Ord, Bounded, Enum, Show, Read)
1652
1653instance PrintDot VerticalPlacement where
1654        unqtDot VTop = char 't'
1655        unqtDot VCenter = char 'c'
1656        unqtDot VBottom = char 'b'
1657
1658instance ParseDot VerticalPlacement where
1659        parseUnqt
1660          = oneOf
1661              [stringRep VTop "t", stringRep VCenter "c", stringRep VBottom "b"]
1662
1663data ScaleType = UniformScale
1664               | NoScale
1665               | FillWidth
1666               | FillHeight
1667               | FillBoth
1668                   deriving (Eq, Ord, Bounded, Enum, Show, Read)
1669
1670instance PrintDot ScaleType where
1671        unqtDot UniformScale = unqtDot True
1672        unqtDot NoScale = unqtDot False
1673        unqtDot FillWidth = text "width"
1674        unqtDot FillHeight = text "height"
1675        unqtDot FillBoth = text "both"
1676
1677instance ParseDot ScaleType where
1678        parseUnqt
1679          = oneOf
1680              [stringRep UniformScale "true", stringRep NoScale "false",
1681               stringRep FillWidth "width", stringRep FillHeight "height",
1682               stringRep FillBoth "both"]
1683
1684data Justification = JLeft
1685                   | JRight
1686                   | JCenter
1687                       deriving (Eq, Ord, Bounded, Enum, Show, Read)
1688
1689instance PrintDot Justification where
1690        unqtDot JLeft = char 'l'
1691        unqtDot JRight = char 'r'
1692        unqtDot JCenter = char 'c'
1693
1694instance ParseDot Justification where
1695        parseUnqt
1696          = oneOf
1697              [stringRep JLeft "l", stringRep JRight "r", stringRep JCenter "c"]
1698
1699data Ratios = AspectRatio Double
1700            | FillRatio
1701            | CompressRatio
1702            | ExpandRatio
1703            | AutoRatio
1704                deriving (Eq, Ord, Show, Read)
1705
1706instance PrintDot Ratios where
1707        unqtDot (AspectRatio r) = unqtDot r
1708        unqtDot FillRatio = text "fill"
1709        unqtDot CompressRatio = text "compress"
1710        unqtDot ExpandRatio = text "expand"
1711        unqtDot AutoRatio = text "auto"
1712
1713instance ParseDot Ratios where
1714        parseUnqt
1715          = oneOf
1716              [liftM AspectRatio parseUnqt, stringRep FillRatio "fill",
1717               stringRep CompressRatio "compress", stringRep ExpandRatio "expand",
1718               stringRep AutoRatio "auto"]
1719