1{- |
2   Module      : Data.GraphViz.Attributes
3   Description : Definition of the Graphviz attributes.
4   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic
5   License     : 3-Clause BSD-style
6   Maintainer  : Ivan.Miljenovic@gmail.com
7
8   This module defines the various attributes that different parts of
9   a Graphviz graph can have.  These attributes are based on the
10   documentation found at:
11     <http://graphviz.org/doc/info/attrs.html>
12
13   For more information on usage, etc. please see that document.
14
15   A summary of known current constraints\/limitations\/differences:
16
17   * There might still be a few cases where quotes are still not
18     escaped/parsed correctly; if you find such a situation, please
19     let me know; however, you should be able to use 'String' values
20     directly without having to worry about when quotes are required
21     or extra escaping of quote characters as 'PrintDot' and
22     'ParseDot' instances for 'String' should take care of that
23     for you.
24
25   * Note that for an edge, in /Dot/ parlance if the edge goes from
26     /A/ to /B/, then /A/ is the tail node and /B/ is the head node
27     (since /A/ is at the tail end of the arrow).
28
29   * ColorList and PointfList are defined as actual lists (but
30     'LayerList' is not).  Note that for the Color 'Attribute' for
31     node values, only a single Color is valid; edges are allowed
32     multiple colors with one spline/arrow per color in the list (but
33     you must have at least one 'Color' in the list).  This might be
34     changed in future.
35
36   * Style is implemented as a list of 'StyleItem' values; note that
37     empty lists are not allowed.
38
39   * A lot of values have a possible value of @none@.  These now
40     have custom constructors.  In fact, most constructors have been
41     expanded upon to give an idea of what they represent rather than
42     using generic terms.
43
44   * @PointF@ and 'Point' have been combined, and feature support for pure
45     'Int'-based co-ordinates as well as 'Double' ones (i.e. no floating
46     point-only points for Point).  The optional '!' and third value
47     for Point are not available.
48
49   * 'Rect' uses two 'Point' values to denote the lower-left and
50     top-right corners.
51
52   * The two 'LabelLoc' attributes have been combined.
53
54   * The defined 'LayerSep' is not used to parse 'LayerRange' or
55     'LayerList'; the default (@[' ', ':', '\t']@) is instead used.
56
57   * @SplineType@ has been replaced with @['Spline']@.
58
59   * Only polygon-based 'Shape's are available.
60
61   * 'PortPos' only has the 'CompassPoint' option, not
62     @PortName[:CompassPoint]@ (since record shapes aren't allowed,
63     and parsing HTML-like labels could be problematic).
64
65   * Not every 'Attribute' is fully documented/described.  However,
66     all those which have specific allowed values should be covered.
67
68   * Deprecated 'Overlap' algorithms are not defined.
69
70   * The global @Orientation@ attribute is not defined, as it is
71     difficult to distinguish from the node-based 'Orientation'
72     'Attribute'; also, its behaviour is duplicated by 'Rotate'.
73
74 -}
75module Data.GraphViz.Attributes
76    ( -- * The actual /Dot/ attributes.
77      Attribute(..)
78    , Attributes
79      -- ** Validity functions on @Attribute@ values.
80    , usedByGraphs
81    , usedBySubGraphs
82    , usedByClusters
83    , usedByNodes
84    , usedByEdges
85      -- * Value types for @Attribute@s.
86    , EscString
87    , URL(..)
88    , ArrowType(..)
89    , AspectType(..)
90    , Rect(..)
91    , ClusterMode(..)
92    , DirType(..)
93    , DEConstraints(..)
94    , DPoint(..)
95    , ModeType(..)
96    , Model(..)
97    , Label(..)
98    , Point(..)
99    , Overlap(..)
100    , LayerRange(..)
101    , LayerID(..)
102    , LayerList(..)
103    , OutputMode(..)
104    , Pack(..)
105    , PackMode(..)
106    , Pos(..)
107    , EdgeType(..)
108    , PageDir(..)
109    , Spline(..)
110    , QuadType(..)
111    , Root(..)
112    , RankType(..)
113    , RankDir(..)
114    , Shape(..)
115    , SmoothType(..)
116    , StartType(..)
117    , STStyle(..)
118    , StyleItem(..)
119    , StyleName(..)
120    , PortPos(..)
121    , CompassPoint(..)
122    , ViewPort(..)
123    , FocusType(..)
124    , VerticalPlacement(..)
125    , ScaleType(..)
126    , Justification(..)
127    , Ratios(..)
128    , module Data.GraphViz.Attributes.Colors
129      -- * Types representing the Dot grammar for @ArrowType@.
130    , ArrowShape(..)
131    , ArrowModifier(..)
132    , ArrowFill(..)
133    , ArrowSide(..)
134      -- ** Default @ArrowType@ aliases.
135      -- *** The 9 primitive @ArrowShape@s.
136    , box
137    , crow
138    , diamond
139    , dotArrow
140    , inv
141    , noArrow
142    , normal
143    , tee
144    , vee
145      -- *** 5 derived Arrows.
146    , oDot
147    , invDot
148    , invODot
149    , oBox
150    , oDiamond
151      -- *** 5 supported cases for backwards compatibility
152    , eDiamond
153    , openArr
154    , halfOpen
155    , emptyArr
156    , invEmpty
157      -- ** @ArrowModifier@ instances
158    , noMods
159    , openMod
160      -- * Other exported functions\/values
161    , defLayerSep
162    , notLayerSep
163    ) where
164
165import Data.GraphViz.Attributes.Colors
166import Data.GraphViz.Util
167import Data.GraphViz.Parsing
168import Data.GraphViz.Printing
169
170import Data.Char(toLower)
171import Data.Maybe(isJust)
172import Control.Arrow(first)
173import Control.Monad(liftM, liftM2)
174
175-- -----------------------------------------------------------------------------
176
177{- |
178
179   These attributes have been implemented in a /permissive/ manner:
180   that is, rather than split them up based on which type of value
181   they are allowed, they have all been included in the one data type,
182   with functions to determine if they are indeed valid for what
183   they're being applied to.
184
185   To interpret the /Valid for/ listings:
186
187     [@G@] Valid for Graphs.
188
189     [@C@] Valid for Clusters.
190
191     [@S@] Valid for Sub-Graphs (and also Clusters).
192
193     [@N@] Valid for Nodes.
194
195     [@E@] Valid for Edges.
196
197   The /Default/ listings are those that the various Graphviz commands
198   use if that 'Attribute' isn't specified (in cases where this is
199   /none/, this is equivalent to a 'Nothing' value; that is, no value
200   is used).  The /Parsing Default/ listings represent what value is
201   used (i.e. corresponds to 'True') when the 'Attribute' name is
202   listed on its own in /Dot/ source code.
203-}
204data Attribute
205    = Damping Double                   -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only
206    | K Double                         -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only
207    | URL URL                          -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only
208    | ArrowHead ArrowType              -- ^ /Valid for/: E; /Default/: @'normal'@
209    | ArrowSize Double                 -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
210    | ArrowTail ArrowType              -- ^ /Valid for/: E; /Default/: @'normal'@
211    | Aspect AspectType                -- ^ /Valid for/: G; /Notes/: dot only
212    | Bb Rect                          -- ^ /Valid for/: G; /Notes/: write only
213    | BgColor Color                    -- ^ /Valid for/: GC; /Default/: X11Color 'Transparent'
214    | Center Bool                      -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
215    | Charset String                   -- ^ /Valid for/: G; /Default/: @\"UTF-8\"@
216    | ClusterRank ClusterMode          -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only
217    | ColorScheme ColorScheme          -- ^ /Valid for/: ENCG; /Default/: @'X11'@
218    | Color [Color]                    -- ^ /Valid for/: ENC; /Default/: @X11Color 'Black'@
219    | Comment String                   -- ^ /Valid for/: ENG; /Default/: @\"\"@
220    | Compound Bool                    -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only
221    | Concentrate Bool                 -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
222    | Constraint Bool                  -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: dot only
223    | Decorate Bool                    -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
224    | DefaultDist Double               -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(|V|)@; /Minimum/: @epsilon@; /Notes/: neato only
225    | Dimen Int                        -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only
226    | Dim Int                          -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only
227    | Dir DirType                      -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)
228    | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only
229    | Distortion Double                -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
230    | DPI Double                       -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym
231    | EdgeURL URL                      -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
232    | EdgeTarget EscString             -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
233    | EdgeTooltip EscString            -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
234    | Epsilon Double                   -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only
235    | ESep DPoint                      -- ^ /Valid for/: G; /Default/: @+3@; /Notes/: not dot
236    | FillColor Color                  -- ^ /Valid for/: NC; /Default/: @X11Color 'LightGray'@ (nodes), @X11Color 'Black'@ (clusters)
237    | FixedSize Bool                   -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'
238    | FontColor Color                  -- ^ /Valid for/: ENGC; /Default/: @X11Color 'Black'@
239    | FontName String                  -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@
240    | FontNames String                 -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only
241    | FontPath String                  -- ^ /Valid for/: G; /Default/: system-dependent
242    | FontSize Double                  -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@
243    | Group String                     -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only
244    | HeadURL URL                      -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
245    | HeadClip Bool                    -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
246    | HeadLabel Label                  -- ^ /Valid for/: E; /Default/: @\"\"@
247    | HeadPort PortPos                 -- ^ /Valid for/: E; /Default/: @'PP' 'CenterPoint'@
248    | HeadTarget EscString             -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
249    | HeadTooltip EscString            -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
250    | Height Double                    -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@
251    | ID Label                         -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only
252    | Image String                     -- ^ /Valid for/: N; /Default/: @\"\"@
253    | ImageScale ScaleType             -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'
254    | LabelURL URL                     -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
255    | LabelAngle Double                -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@
256    | LabelDistance Double             -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
257    | LabelFloat Bool                  -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
258    | LabelFontColor Color             -- ^ /Valid for/: E; /Default/: @X11Color 'Black'@
259    | LabelFontName String             -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@
260    | LabelFontSize Double             -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@
261    | LabelJust Justification          -- ^ /Valid for/: GC; /Default/: @'JCenter'@
262    | LabelLoc VerticalPlacement       -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)
263    | LabelTarget EscString            -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
264    | LabelTooltip EscString           -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
265    | Label Label                      -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)
266    | Landscape Bool                   -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
267    | LayerSep String                  -- ^ /Valid for/: G; /Default/: @\" :\t\"@
268    | Layers LayerList                 -- ^ /Valid for/: G; /Default/: @\"\"@
269    | Layer LayerRange                 -- ^ /Valid for/: EN; /Default/: @\"\"@
270    | Layout String                    -- ^ /Valid for/: G; /Default/: @\"\"@
271    | Len Double                       -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only
272    | LevelsGap Double                 -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only
273    | Levels Int                       -- ^ /Valid for/: G; /Default/: @MAXINT@; /Minimum/: @0@; /Notes/: sfdp only
274    | LHead String                     -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
275    | LPos Point                       -- ^ /Valid for/: EGC; /Notes/: write only
276    | LTail String                     -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
277    | Margin DPoint                    -- ^ /Valid for/: NG; /Default/: device-dependent
278    | MaxIter Int                      -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp); /Notes/: fdp, neato only
279    | MCLimit Double                   -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: dot only
280    | MinDist Double                   -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: circo only
281    | MinLen Int                       -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: dot only
282    | Model Model                      -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only
283    | Mode ModeType                    -- ^ /Valid for/: G; /Default/: @'Major'@; /Notes/: neato only
284    | Mosek Bool                       -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: neato only; requires the Mosek software
285    | NodeSep Double                   -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@; /Notes/: dot only
286    | NoJustify Bool                   -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True'
287    | Normalize Bool                   -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: not dot
288    | Nslimit1 Double                  -- ^ /Valid for/: G; /Notes/: dot only
289    | Nslimit Double                   -- ^ /Valid for/: G; /Notes/: dot only
290    | Ordering String                  -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: dot only
291    | Orientation Double               -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@
292    | OutputOrder OutputMode           -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@
293    | OverlapScaling Double            -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only
294    | Overlap Overlap                  -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot
295    | PackMode PackMode                -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot
296    | Pack Pack                        -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'DoPack'; /Notes/: not dot
297    | Pad DPoint                       -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)
298    | PageDir PageDir                  -- ^ /Valid for/: G; /Default/: @'BL'@
299    | Page Point                       -- ^ /Valid for/: G
300    | PenColor Color                   -- ^ /Valid for/: C; /Default/: @X11Color 'Black'@
301    | PenWidth Double                  -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@
302    | Peripheries Int                  -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0
303    | Pin Bool                         -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only
304    | Pos Pos                          -- ^ /Valid for/: EN
305    | QuadTree QuadType                -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only
306    | Quantum Double                   -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@
307    | RankDir RankDir                  -- ^ /Valid for/: G; /Default/: @'TB'@; /Notes/: dot only
308    | RankSep Double                   -- ^ /Valid for/: G; /Default/: @0.5@ (dot), @1.0@ (twopi); /Minimum/: 0.02; /Notes/: twopi, dot only
309    | Rank RankType                    -- ^ /Valid for/: S; /Notes/: dot only
310    | Ratio Ratios                     -- ^ /Valid for/: G
311    | Rects Rect                       -- ^ /Valid for/: N; /Notes/: write only
312    | Regular Bool                     -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'
313    | ReMinCross Bool                  -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only
314    | RepulsiveForce Double            -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: sfdp only
315    | Root Root                        -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: circo, twopi only
316    | Rotate Int                       -- ^ /Valid for/: G; /Default/: @0@
317    | SameHead String                  -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
318    | SameTail String                  -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
319    | SamplePoints Int                 -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)
320    | SearchSize Int                   -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only
321    | Sep DPoint                       -- ^ /Valid for/: G; /Default/: @+4@; /Notes/: not dot
322    | ShapeFile String                 -- ^ /Valid for/: N; /Default/: @\"\"@
323    | Shape Shape                      -- ^ /Valid for/: N; /Default/: @'Ellipse'@
324    | ShowBoxes Int                    -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only
325    | Sides Int                        -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@
326    | Size Point                       -- ^ /Valid for/: G
327    | Skew Double                      -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
328    | Smoothing SmoothType             -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only
329    | SortV Int                        -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@
330    | Splines EdgeType                 -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges'
331    | Start StartType                  -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: fdp, neato only
332    | StyleSheet String                -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only
333    | Style [StyleItem]                -- ^ /Valid for/: ENC
334    | TailURL URL                      -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
335    | TailClip Bool                    -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
336    | TailLabel Label                  -- ^ /Valid for/: E; /Default/: @\"\"@
337    | TailPort PortPos                 -- ^ /Valid for/: E; /Default/: center
338    | TailTarget EscString             -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
339    | TailTooltip EscString            -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
340    | Target EscString                 -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only
341    | Tooltip EscString                -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only
342    | TrueColor Bool                   -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only
343    | Vertices [Point]                 -- ^ /Valid for/: N; /Notes/: write only
344    | ViewPort ViewPort                -- ^ /Valid for/: G; /Default/: none
345    | VoroMargin Double                -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not dot
346    | Weight Double                    -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0@ (dot), @1@ (neato,fdp,sfdp)
347    | Width Double                     -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@
348    | Z Double                         -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-MAXFLOAT@, @-1000@
349      deriving (Eq, Ord, Show, Read)
350
351type Attributes = [Attribute]
352
353instance PrintDot Attribute where
354    unqtDot (Damping v)            = printField "Damping" v
355    unqtDot (K v)                  = printField "K" v
356    unqtDot (URL v)                = printField "URL" v
357    unqtDot (ArrowHead v)          = printField "arrowhead" v
358    unqtDot (ArrowSize v)          = printField "arrowsize" v
359    unqtDot (ArrowTail v)          = printField "arrowtail" v
360    unqtDot (Aspect v)             = printField "aspect" v
361    unqtDot (Bb v)                 = printField "bb" v
362    unqtDot (BgColor v)            = printField "bgcolor" v
363    unqtDot (Center v)             = printField "center" v
364    unqtDot (Charset v)            = printField "charset" v
365    unqtDot (ClusterRank v)        = printField "clusterrank" v
366    unqtDot (ColorScheme v)        = printField "colorscheme" v
367    unqtDot (Color v)              = printField "color" v
368    unqtDot (Comment v)            = printField "comment" v
369    unqtDot (Compound v)           = printField "compound" v
370    unqtDot (Concentrate v)        = printField "concentrate" v
371    unqtDot (Constraint v)         = printField "constraint" v
372    unqtDot (Decorate v)           = printField "decorate" v
373    unqtDot (DefaultDist v)        = printField "defaultdist" v
374    unqtDot (Dimen v)              = printField "dimen" v
375    unqtDot (Dim v)                = printField "dim" v
376    unqtDot (Dir v)                = printField "dir" v
377    unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v
378    unqtDot (Distortion v)         = printField "distortion" v
379    unqtDot (DPI v)                = printField "dpi" v
380    unqtDot (EdgeURL v)            = printField "edgeURL" v
381    unqtDot (EdgeTarget v)         = printField "edgetarget" v
382    unqtDot (EdgeTooltip v)        = printField "edgetooltip" v
383    unqtDot (Epsilon v)            = printField "epsilon" v
384    unqtDot (ESep v)               = printField "esep" v
385    unqtDot (FillColor v)          = printField "fillcolor" v
386    unqtDot (FixedSize v)          = printField "fixedsize" v
387    unqtDot (FontColor v)          = printField "fontcolor" v
388    unqtDot (FontName v)           = printField "fontname" v
389    unqtDot (FontNames v)          = printField "fontnames" v
390    unqtDot (FontPath v)           = printField "fontpath" v
391    unqtDot (FontSize v)           = printField "fontsize" v
392    unqtDot (Group v)              = printField "group" v
393    unqtDot (HeadURL v)            = printField "headURL" v
394    unqtDot (HeadClip v)           = printField "headclip" v
395    unqtDot (HeadLabel v)          = printField "headlabel" v
396    unqtDot (HeadPort v)           = printField "headport" v
397    unqtDot (HeadTarget v)         = printField "headtarget" v
398    unqtDot (HeadTooltip v)        = printField "headtooltip" v
399    unqtDot (Height v)             = printField "height" v
400    unqtDot (ID v)                 = printField "id" v
401    unqtDot (Image v)              = printField "image" v
402    unqtDot (ImageScale v)         = printField "imagescale" v
403    unqtDot (LabelURL v)           = printField "labelURL" v
404    unqtDot (LabelAngle v)         = printField "labelangle" v
405    unqtDot (LabelDistance v)      = printField "labeldistance" v
406    unqtDot (LabelFloat v)         = printField "labelfloat" v
407    unqtDot (LabelFontColor v)     = printField "labelfontcolor" v
408    unqtDot (LabelFontName v)      = printField "labelfontname" v
409    unqtDot (LabelFontSize v)      = printField "labelfontsize" v
410    unqtDot (LabelJust v)          = printField "labeljust" v
411    unqtDot (LabelLoc v)           = printField "labelloc" v
412    unqtDot (LabelTarget v)        = printField "labeltarget" v
413    unqtDot (LabelTooltip v)       = printField "labeltooltip" v
414    unqtDot (Label v)              = printField "label" v
415    unqtDot (Landscape v)          = printField "landscape" v
416    unqtDot (LayerSep v)           = printField "layersep" v
417    unqtDot (Layers v)             = printField "layers" v
418    unqtDot (Layer v)              = printField "layer" v
419    unqtDot (Layout v)             = printField "layout" v
420    unqtDot (Len v)                = printField "len" v
421    unqtDot (LevelsGap v)          = printField "levelsgap" v
422    unqtDot (Levels v)             = printField "levels" v
423    unqtDot (LHead v)              = printField "lhead" v
424    unqtDot (LPos v)               = printField "lp" v
425    unqtDot (LTail v)              = printField "ltail" v
426    unqtDot (Margin v)             = printField "margin" v
427    unqtDot (MaxIter v)            = printField "maxiter" v
428    unqtDot (MCLimit v)            = printField "mclimit" v
429    unqtDot (MinDist v)            = printField "mindist" v
430    unqtDot (MinLen v)             = printField "minlen" v
431    unqtDot (Model v)              = printField "model" v
432    unqtDot (Mode v)               = printField "mode" v
433    unqtDot (Mosek v)              = printField "mosek" v
434    unqtDot (NodeSep v)            = printField "nodesep" v
435    unqtDot (NoJustify v)          = printField "nojustify" v
436    unqtDot (Normalize v)          = printField "normalize" v
437    unqtDot (Nslimit1 v)           = printField "nslimit1" v
438    unqtDot (Nslimit v)            = printField "nslimit" v
439    unqtDot (Ordering v)           = printField "ordering" v
440    unqtDot (Orientation v)        = printField "orientation" v
441    unqtDot (OutputOrder v)        = printField "outputorder" v
442    unqtDot (OverlapScaling v)     = printField "overlap_scaling" v
443    unqtDot (Overlap v)            = printField "overlap" v
444    unqtDot (PackMode v)           = printField "packmode" v
445    unqtDot (Pack v)               = printField "pack" v
446    unqtDot (Pad v)                = printField "pad" v
447    unqtDot (PageDir v)            = printField "pagedir" v
448    unqtDot (Page v)               = printField "page" v
449    unqtDot (PenColor v)           = printField "pencolor" v
450    unqtDot (PenWidth v)           = printField "penwidth" v
451    unqtDot (Peripheries v)        = printField "peripheries" v
452    unqtDot (Pin v)                = printField "pin" v
453    unqtDot (Pos v)                = printField "pos" v
454    unqtDot (QuadTree v)           = printField "quadtree" v
455    unqtDot (Quantum v)            = printField "quantum" v
456    unqtDot (RankDir v)            = printField "rankdir" v
457    unqtDot (RankSep v)            = printField "ranksep" v
458    unqtDot (Rank v)               = printField "rank" v
459    unqtDot (Ratio v)              = printField "ratio" v
460    unqtDot (Rects v)              = printField "rects" v
461    unqtDot (Regular v)            = printField "regular" v
462    unqtDot (ReMinCross v)         = printField "remincross" v
463    unqtDot (RepulsiveForce v)     = printField "repulsiveforce" v
464    unqtDot (Root v)               = printField "root" v
465    unqtDot (Rotate v)             = printField "rotate" v
466    unqtDot (SameHead v)           = printField "samehead" v
467    unqtDot (SameTail v)           = printField "sametail" v
468    unqtDot (SamplePoints v)       = printField "samplepoints" v
469    unqtDot (SearchSize v)         = printField "searchsize" v
470    unqtDot (Sep v)                = printField "sep" v
471    unqtDot (ShapeFile v)          = printField "shapefile" v
472    unqtDot (Shape v)              = printField "shape" v
473    unqtDot (ShowBoxes v)          = printField "showboxes" v
474    unqtDot (Sides v)              = printField "sides" v
475    unqtDot (Size v)               = printField "size" v
476    unqtDot (Skew v)               = printField "skew" v
477    unqtDot (Smoothing v)          = printField "smoothing" v
478    unqtDot (SortV v)              = printField "sortv" v
479    unqtDot (Splines v)            = printField "splines" v
480    unqtDot (Start v)              = printField "start" v
481    unqtDot (StyleSheet v)         = printField "stylesheet" v
482    unqtDot (Style v)              = printField "style" v
483    unqtDot (TailURL v)            = printField "tailURL" v
484    unqtDot (TailClip v)           = printField "tailclip" v
485    unqtDot (TailLabel v)          = printField "taillabel" v
486    unqtDot (TailPort v)           = printField "tailport" v
487    unqtDot (TailTarget v)         = printField "tailtarget" v
488    unqtDot (TailTooltip v)        = printField "tailtooltip" v
489    unqtDot (Target v)             = printField "target" v
490    unqtDot (Tooltip v)            = printField "tooltip" v
491    unqtDot (TrueColor v)          = printField "truecolor" v
492    unqtDot (Vertices v)           = printField "vertices" v
493    unqtDot (ViewPort v)           = printField "viewport" v
494    unqtDot (VoroMargin v)         = printField "voro_margin" v
495    unqtDot (Weight v)             = printField "weight" v
496    unqtDot (Width v)              = printField "width" v
497    unqtDot (Z v)                  = printField "z" v
498
499    listToDot = unqtListToDot
500
501instance ParseDot Attribute where
502    parseUnqt = oneOf [ liftM Damping            $ parseField "Damping"
503                      , liftM K                  $ parseField "K"
504                      , liftM URL                $ parseFields ["URL", "href"]
505                      , liftM ArrowHead          $ parseField "arrowhead"
506                      , liftM ArrowSize          $ parseField "arrowsize"
507                      , liftM ArrowTail          $ parseField "arrowtail"
508                      , liftM Aspect             $ parseField "aspect"
509                      , liftM Bb                 $ parseField "bb"
510                      , liftM BgColor            $ parseField "bgcolor"
511                      , liftM Center             $ parseFieldBool "center"
512                      , liftM Charset            $ parseField "charset"
513                      , liftM ClusterRank        $ parseField "clusterrank"
514                      , liftM ColorScheme        $ parseField "colorscheme"
515                      , liftM Color              $ parseField "color"
516                      , liftM Comment            $ parseField "comment"
517                      , liftM Compound           $ parseFieldBool "compound"
518                      , liftM Concentrate        $ parseFieldBool "concentrate"
519                      , liftM Constraint         $ parseFieldBool "constraint"
520                      , liftM Decorate           $ parseFieldBool "decorate"
521                      , liftM DefaultDist        $ parseField "defaultdist"
522                      , liftM Dimen              $ parseField "dimen"
523                      , liftM Dim                $ parseField "dim"
524                      , liftM Dir                $ parseField "dir"
525                      , liftM DirEdgeConstraints $ parseFieldDef EdgeConstraints "diredgeconstraints"
526                      , liftM Distortion         $ parseField "distortion"
527                      , liftM DPI                $ parseFields ["dpi", "resolution"]
528                      , liftM EdgeURL            $ parseFields ["edgeURL", "edgehref"]
529                      , liftM EdgeTarget         $ parseField "edgetarget"
530                      , liftM EdgeTooltip        $ parseField "edgetooltip"
531                      , liftM Epsilon            $ parseField "epsilon"
532                      , liftM ESep               $ parseField "esep"
533                      , liftM FillColor          $ parseField "fillcolor"
534                      , liftM FixedSize          $ parseFieldBool "fixedsize"
535                      , liftM FontColor          $ parseField "fontcolor"
536                      , liftM FontName           $ parseField "fontname"
537                      , liftM FontNames          $ parseField "fontnames"
538                      , liftM FontPath           $ parseField "fontpath"
539                      , liftM FontSize           $ parseField "fontsize"
540                      , liftM Group              $ parseField "group"
541                      , liftM HeadURL            $ parseFields ["headURL", "headhref"]
542                      , liftM HeadClip           $ parseFieldBool "headclip"
543                      , liftM HeadLabel          $ parseField "headlabel"
544                      , liftM HeadPort           $ parseField "headport"
545                      , liftM HeadTarget         $ parseField "headtarget"
546                      , liftM HeadTooltip        $ parseField "headtooltip"
547                      , liftM Height             $ parseField "height"
548                      , liftM ID                 $ parseField "id"
549                      , liftM Image              $ parseField "image"
550                      , liftM ImageScale         $ parseFieldDef UniformScale "imagescale"
551                      , liftM LabelURL           $ parseFields ["labelURL", "labelhref"]
552                      , liftM LabelAngle         $ parseField "labelangle"
553                      , liftM LabelDistance      $ parseField "labeldistance"
554                      , liftM LabelFloat         $ parseFieldBool "labelfloat"
555                      , liftM LabelFontColor     $ parseField "labelfontcolor"
556                      , liftM LabelFontName      $ parseField "labelfontname"
557                      , liftM LabelFontSize      $ parseField "labelfontsize"
558                      , liftM LabelJust          $ parseField "labeljust"
559                      , liftM LabelLoc           $ parseField "labelloc"
560                      , liftM LabelTarget        $ parseField "labeltarget"
561                      , liftM LabelTooltip       $ parseField "labeltooltip"
562                      , liftM Label              $ parseField "label"
563                      , liftM Landscape          $ parseFieldBool "landscape"
564                      , liftM LayerSep           $ parseField "layersep"
565                      , liftM Layers             $ parseField "layers"
566                      , liftM Layer              $ parseField "layer"
567                      , liftM Layout             $ parseField "layout"
568                      , liftM Len                $ parseField "len"
569                      , liftM LevelsGap          $ parseField "levelsgap"
570                      , liftM Levels             $ parseField "levels"
571                      , liftM LHead              $ parseField "lhead"
572                      , liftM LPos               $ parseField "lp"
573                      , liftM LTail              $ parseField "ltail"
574                      , liftM Margin             $ parseField "margin"
575                      , liftM MaxIter            $ parseField "maxiter"
576                      , liftM MCLimit            $ parseField "mclimit"
577                      , liftM MinDist            $ parseField "mindist"
578                      , liftM MinLen             $ parseField "minlen"
579                      , liftM Model              $ parseField "model"
580                      , liftM Mode               $ parseField "mode"
581                      , liftM Mosek              $ parseFieldBool "mosek"
582                      , liftM NodeSep            $ parseField "nodesep"
583                      , liftM NoJustify          $ parseFieldBool "nojustify"
584                      , liftM Normalize          $ parseFieldBool "normalize"
585                      , liftM Nslimit1           $ parseField "nslimit1"
586                      , liftM Nslimit            $ parseField "nslimit"
587                      , liftM Ordering           $ parseField "ordering"
588                      , liftM Orientation        $ parseField "orientation"
589                      , liftM OutputOrder        $ parseField "outputorder"
590                      , liftM OverlapScaling     $ parseField "overlap_scaling"
591                      , liftM Overlap            $ parseFieldDef KeepOverlaps "overlap"
592                      , liftM PackMode           $ parseField "packmode"
593                      , liftM Pack               $ parseFieldDef DoPack "pack"
594                      , liftM Pad                $ parseField "pad"
595                      , liftM PageDir            $ parseField "pagedir"
596                      , liftM Page               $ parseField "page"
597                      , liftM PenColor           $ parseField "pencolor"
598                      , liftM PenWidth           $ parseField "penwidth"
599                      , liftM Peripheries        $ parseField "peripheries"
600                      , liftM Pin                $ parseFieldBool "pin"
601                      , liftM Pos                $ parseField "pos"
602                      , liftM QuadTree           $ parseFieldDef NormalQT "quadtree"
603                      , liftM Quantum            $ parseField "quantum"
604                      , liftM RankDir            $ parseField "rankdir"
605                      , liftM RankSep            $ parseField "ranksep"
606                      , liftM Rank               $ parseField "rank"
607                      , liftM Ratio              $ parseField "ratio"
608                      , liftM Rects              $ parseField "rects"
609                      , liftM Regular            $ parseFieldBool "regular"
610                      , liftM ReMinCross         $ parseFieldBool "remincross"
611                      , liftM RepulsiveForce     $ parseField "repulsiveforce"
612                      , liftM Root               $ parseFieldDef IsCentral "root"
613                      , liftM Rotate             $ parseField "rotate"
614                      , liftM SameHead           $ parseField "samehead"
615                      , liftM SameTail           $ parseField "sametail"
616                      , liftM SamplePoints       $ parseField "samplepoints"
617                      , liftM SearchSize         $ parseField "searchsize"
618                      , liftM Sep                $ parseField "sep"
619                      , liftM ShapeFile          $ parseField "shapefile"
620                      , liftM Shape              $ parseField "shape"
621                      , liftM ShowBoxes          $ parseField "showboxes"
622                      , liftM Sides              $ parseField "sides"
623                      , liftM Size               $ parseField "size"
624                      , liftM Skew               $ parseField "skew"
625                      , liftM Smoothing          $ parseField "smoothing"
626                      , liftM SortV              $ parseField "sortv"
627                      , liftM Splines            $ parseFieldDef SplineEdges "splines"
628                      , liftM Start              $ parseField "start"
629                      , liftM StyleSheet         $ parseField "stylesheet"
630                      , liftM Style              $ parseField "style"
631                      , liftM TailURL            $ parseFields ["tailURL", "tailhref"]
632                      , liftM TailClip           $ parseFieldBool "tailclip"
633                      , liftM TailLabel          $ parseField "taillabel"
634                      , liftM TailPort           $ parseField "tailport"
635                      , liftM TailTarget         $ parseField "tailtarget"
636                      , liftM TailTooltip        $ parseField "tailtooltip"
637                      , liftM Target             $ parseField "target"
638                      , liftM Tooltip            $ parseField "tooltip"
639                      , liftM TrueColor          $ parseFieldBool "truecolor"
640                      , liftM Vertices           $ parseField "vertices"
641                      , liftM ViewPort           $ parseField "viewport"
642                      , liftM VoroMargin         $ parseField "voro_margin"
643                      , liftM Weight             $ parseField "weight"
644                      , liftM Width              $ parseField "width"
645                      , liftM Z                  $ parseField "z"
646                      ]
647
648    parse = parseUnqt
649
650    parseList = parseUnqtList
651
652-- | Determine if this Attribute is valid for use with Graphs.
653usedByGraphs                      :: Attribute -> Bool
654usedByGraphs Damping{}            = True
655usedByGraphs K{}                  = True
656usedByGraphs URL{}                = True
657usedByGraphs Aspect{}             = True
658usedByGraphs Bb{}                 = True
659usedByGraphs BgColor{}            = True
660usedByGraphs Center{}             = True
661usedByGraphs Charset{}            = True
662usedByGraphs ClusterRank{}        = True
663usedByGraphs ColorScheme{}        = True
664usedByGraphs Comment{}            = True
665usedByGraphs Compound{}           = True
666usedByGraphs Concentrate{}        = True
667usedByGraphs DefaultDist{}        = True
668usedByGraphs Dimen{}              = True
669usedByGraphs Dim{}                = True
670usedByGraphs DirEdgeConstraints{} = True
671usedByGraphs DPI{}                = True
672usedByGraphs Epsilon{}            = True
673usedByGraphs ESep{}               = True
674usedByGraphs FontColor{}          = True
675usedByGraphs FontName{}           = True
676usedByGraphs FontNames{}          = True
677usedByGraphs FontPath{}           = True
678usedByGraphs FontSize{}           = True
679usedByGraphs ID{}                 = True
680usedByGraphs LabelJust{}          = True
681usedByGraphs LabelLoc{}           = True
682usedByGraphs Label{}              = True
683usedByGraphs Landscape{}          = True
684usedByGraphs LayerSep{}           = True
685usedByGraphs Layers{}             = True
686usedByGraphs Layout{}             = True
687usedByGraphs LevelsGap{}          = True
688usedByGraphs Levels{}             = True
689usedByGraphs LPos{}               = True
690usedByGraphs Margin{}             = True
691usedByGraphs MaxIter{}            = True
692usedByGraphs MCLimit{}            = True
693usedByGraphs MinDist{}            = True
694usedByGraphs Model{}              = True
695usedByGraphs Mode{}               = True
696usedByGraphs Mosek{}              = True
697usedByGraphs NodeSep{}            = True
698usedByGraphs NoJustify{}          = True
699usedByGraphs Normalize{}          = True
700usedByGraphs Nslimit1{}           = True
701usedByGraphs Nslimit{}            = True
702usedByGraphs Ordering{}           = True
703usedByGraphs OutputOrder{}        = True
704usedByGraphs OverlapScaling{}     = True
705usedByGraphs Overlap{}            = True
706usedByGraphs PackMode{}           = True
707usedByGraphs Pack{}               = True
708usedByGraphs Pad{}                = True
709usedByGraphs PageDir{}            = True
710usedByGraphs Page{}               = True
711usedByGraphs QuadTree{}           = True
712usedByGraphs Quantum{}            = True
713usedByGraphs RankDir{}            = True
714usedByGraphs RankSep{}            = True
715usedByGraphs Ratio{}              = True
716usedByGraphs ReMinCross{}         = True
717usedByGraphs RepulsiveForce{}     = True
718usedByGraphs Root{}               = True
719usedByGraphs Rotate{}             = True
720usedByGraphs SearchSize{}         = True
721usedByGraphs Sep{}                = True
722usedByGraphs ShowBoxes{}          = True
723usedByGraphs Size{}               = True
724usedByGraphs Smoothing{}          = True
725usedByGraphs SortV{}              = True
726usedByGraphs Splines{}            = True
727usedByGraphs Start{}              = True
728usedByGraphs StyleSheet{}         = True
729usedByGraphs Target{}             = True
730usedByGraphs TrueColor{}          = True
731usedByGraphs ViewPort{}           = True
732usedByGraphs VoroMargin{}         = True
733usedByGraphs _                    = False
734
735-- | Determine if this Attribute is valid for use with Clusters.
736usedByClusters               :: Attribute -> Bool
737usedByClusters K{}           = True
738usedByClusters URL{}         = True
739usedByClusters BgColor{}     = True
740usedByClusters ColorScheme{} = True
741usedByClusters Color{}       = True
742usedByClusters FillColor{}   = True
743usedByClusters FontColor{}   = True
744usedByClusters FontName{}    = True
745usedByClusters FontSize{}    = True
746usedByClusters LabelJust{}   = True
747usedByClusters LabelLoc{}    = True
748usedByClusters Label{}       = True
749usedByClusters LPos{}        = True
750usedByClusters NoJustify{}   = True
751usedByClusters PenColor{}    = True
752usedByClusters PenWidth{}    = True
753usedByClusters Peripheries{} = True
754usedByClusters Rank{}        = True
755usedByClusters SortV{}       = True
756usedByClusters Style{}       = True
757usedByClusters Target{}      = True
758usedByClusters Tooltip{}     = True
759usedByClusters _             = False
760
761-- | Determine if this Attribute is valid for use with SubGraphs.
762usedBySubGraphs        :: Attribute -> Bool
763usedBySubGraphs Rank{} = True
764usedBySubGraphs _      = False
765
766-- | Determine if this Attribute is valid for use with Nodes.
767usedByNodes                :: Attribute -> Bool
768usedByNodes URL{}          = True
769usedByNodes ColorScheme{}  = True
770usedByNodes Color{}        = True
771usedByNodes Comment{}      = True
772usedByNodes Distortion{}   = True
773usedByNodes FillColor{}    = True
774usedByNodes FixedSize{}    = True
775usedByNodes FontColor{}    = True
776usedByNodes FontName{}     = True
777usedByNodes FontSize{}     = True
778usedByNodes Group{}        = True
779usedByNodes Height{}       = True
780usedByNodes ID{}           = True
781usedByNodes Image{}        = True
782usedByNodes ImageScale{}   = True
783usedByNodes LabelLoc{}     = True
784usedByNodes Label{}        = True
785usedByNodes Layer{}        = True
786usedByNodes Margin{}       = True
787usedByNodes NoJustify{}    = True
788usedByNodes Orientation{}  = True
789usedByNodes PenWidth{}     = True
790usedByNodes Peripheries{}  = True
791usedByNodes Pin{}          = True
792usedByNodes Pos{}          = True
793usedByNodes Rects{}        = True
794usedByNodes Regular{}      = True
795usedByNodes Root{}         = True
796usedByNodes SamplePoints{} = True
797usedByNodes ShapeFile{}    = True
798usedByNodes Shape{}        = True
799usedByNodes ShowBoxes{}    = True
800usedByNodes Sides{}        = True
801usedByNodes Skew{}         = True
802usedByNodes SortV{}        = True
803usedByNodes Style{}        = True
804usedByNodes Target{}       = True
805usedByNodes Tooltip{}      = True
806usedByNodes Vertices{}     = True
807usedByNodes Width{}        = True
808usedByNodes Z{}            = True
809usedByNodes _              = False
810
811-- | Determine if this Attribute is valid for use with Edges.
812usedByEdges                  :: Attribute -> Bool
813usedByEdges URL{}            = True
814usedByEdges ArrowHead{}      = True
815usedByEdges ArrowSize{}      = True
816usedByEdges ArrowTail{}      = True
817usedByEdges ColorScheme{}    = True
818usedByEdges Color{}          = True
819usedByEdges Comment{}        = True
820usedByEdges Constraint{}     = True
821usedByEdges Decorate{}       = True
822usedByEdges Dir{}            = True
823usedByEdges EdgeURL{}        = True
824usedByEdges EdgeTarget{}     = True
825usedByEdges EdgeTooltip{}    = True
826usedByEdges FontColor{}      = True
827usedByEdges FontName{}       = True
828usedByEdges FontSize{}       = True
829usedByEdges HeadURL{}        = True
830usedByEdges HeadClip{}       = True
831usedByEdges HeadLabel{}      = True
832usedByEdges HeadPort{}       = True
833usedByEdges HeadTarget{}     = True
834usedByEdges HeadTooltip{}    = True
835usedByEdges ID{}             = True
836usedByEdges LabelURL{}       = True
837usedByEdges LabelAngle{}     = True
838usedByEdges LabelDistance{}  = True
839usedByEdges LabelFloat{}     = True
840usedByEdges LabelFontColor{} = True
841usedByEdges LabelFontName{}  = True
842usedByEdges LabelFontSize{}  = True
843usedByEdges LabelTarget{}    = True
844usedByEdges LabelTooltip{}   = True
845usedByEdges Label{}          = True
846usedByEdges Layer{}          = True
847usedByEdges Len{}            = True
848usedByEdges LHead{}          = True
849usedByEdges LPos{}           = True
850usedByEdges LTail{}          = True
851usedByEdges MinLen{}         = True
852usedByEdges NoJustify{}      = True
853usedByEdges PenWidth{}       = True
854usedByEdges Pos{}            = True
855usedByEdges SameHead{}       = True
856usedByEdges SameTail{}       = True
857usedByEdges ShowBoxes{}      = True
858usedByEdges Style{}          = True
859usedByEdges TailURL{}        = True
860usedByEdges TailClip{}       = True
861usedByEdges TailLabel{}      = True
862usedByEdges TailPort{}       = True
863usedByEdges TailTarget{}     = True
864usedByEdges TailTooltip{}    = True
865usedByEdges Target{}         = True
866usedByEdges Tooltip{}        = True
867usedByEdges Weight{}         = True
868usedByEdges _                = False
869
870{- Delete to here -}
871-- -----------------------------------------------------------------------------
872
873{- |
874
875   Some 'Attribute's (mainly label-like ones) take a 'String' argument
876   that allows for extra escape codes.  This library doesn't do any
877   extra checks or special parsing for these escape codes, but usage
878   of 'EscString' rather than 'String' indicates that the Graphviz
879   tools will recognise these extra escape codes for these
880   'Attribute's.
881
882   The extra escape codes include (note that these are all 'String's):
883
884     [@\\N@] Replace with the name of the node (for Node 'Attribute's).
885
886     [@\\G@] Replace with the name of the graph (for Node 'Attribute's)
887             or the name of the graph or cluster, whichever is
888             applicable (for Graph, Cluster and Edge 'Attribute's).
889
890     [@\\E@] Replace with the name of the edge, formed by the two
891             adjoining nodes and the edge type (for Edge 'Attribute's).
892
893     [@\\T@] Replace with the name of the tail node (for Edge
894             'Attribute's).
895
896     [@\\H@] Replace with the name of the head node (for Edge
897             'Attribute's).
898
899     [@\\L@] Replace with the object's label (for all 'Attribute's).
900
901   Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or
902   'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines
903   centered, left-justified and right-justified respectively.
904
905 -}
906type EscString = String
907
908-- -----------------------------------------------------------------------------
909
910-- | No checks are placed on the content of a 'URL' value; however,
911--   you should ensure that it does not contain any \'@>@\' or \'@<@\'
912--   characters; Graphviz might care about escaping other characters
913--   properly, but for the purposes of this library the presence of
914--   these characters will make it harder to parse URLs.
915newtype URL = UStr { urlString :: EscString }
916    deriving (Eq, Ord, Show, Read)
917
918instance PrintDot URL where
919    unqtDot = wrap (char '<') (char '>')
920              -- Explicitly use text here... no quotes!
921              . text . urlString
922
923instance ParseDot URL where
924    parseUnqt = liftM UStr
925                $ bracket (character open)
926                          (character close)
927                          (many1 $ satisfy ((/=) close))
928        where
929          open = '<'
930          close = '>'
931
932    -- No quotes
933    parse = parseUnqt
934
935-- -----------------------------------------------------------------------------
936
937-- | /Dot/ has a basic grammar of arrow shapes which allows usage of
938--   up to 1,544,761 different shapes from 9 different basic
939--   'ArrowShape's.  Note that whilst an explicit list is used in the
940--   definition of 'ArrowType', there must be at least one tuple and a
941--   maximum of 4 (since that is what is required by Dot).  For more
942--   information, see: <http://graphviz.org/doc/info/arrows.html>
943--
944--   The 19 basic arrows shown on the overall attributes page have
945--   been defined below as a convenience.  Parsing of the 5
946--   backward-compatible special cases is also supported.
947newtype ArrowType = AType [(ArrowModifier, ArrowShape)]
948    deriving (Eq, Ord, Show, Read)
949
950box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: ArrowType
951oDot, invDot, invODot, oBox, oDiamond :: ArrowType
952eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType
953
954normal = AType [(noMods, Normal)]
955inv = AType [(noMods, Inv)]
956dotArrow = AType [(noMods, DotArrow)]
957invDot = AType [ (noMods, Inv)
958               , (noMods, DotArrow)]
959oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)]
960invODot = AType [ (noMods, Inv)
961                , (openMod, DotArrow)]
962noArrow = AType [(noMods, NoArrow)]
963tee = AType [(noMods, Tee)]
964emptyArr = AType [(openMod, Normal)]
965invEmpty = AType [ (noMods, Inv)
966                 , (openMod, Normal)]
967diamond = AType [(noMods, Diamond)]
968oDiamond = AType [(openMod, Diamond)]
969eDiamond = oDiamond
970crow = AType [(noMods, Crow)]
971box = AType [(noMods, Box)]
972oBox = AType [(openMod, Box)]
973openArr = vee
974halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]
975vee = AType [(noMods, Vee)]
976
977instance PrintDot ArrowType where
978    unqtDot (AType mas) = hcat $ map appMod mas
979        where
980          appMod (m, a) = unqtDot m <> unqtDot a
981
982instance ParseDot ArrowType where
983    parseUnqt = do mas <- many1 $ do m <- parseUnqt
984                                     a <- parseUnqt
985                                     return (m,a)
986                   return $ AType mas
987                `onFail`
988                specialArrowParse
989
990specialArrowParse :: Parse ArrowType
991specialArrowParse = oneOf [ stringRep eDiamond "ediamond"
992                          , stringRep openArr "open"
993                          , stringRep halfOpen "halfopen"
994                          , stringRep emptyArr "empty"
995                          , stringRep invEmpty "invempty"
996                          ]
997
998data ArrowShape = Box
999                | Crow
1000                | Diamond
1001                | DotArrow
1002                | Inv
1003                | NoArrow
1004                | Normal
1005                | Tee
1006                | Vee
1007                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
1008
1009instance PrintDot ArrowShape where
1010    unqtDot Box      = unqtDot "box"
1011    unqtDot Crow     = unqtDot "crow"
1012    unqtDot Diamond  = unqtDot "diamond"
1013    unqtDot DotArrow = unqtDot "dot"
1014    unqtDot Inv      = unqtDot "inv"
1015    unqtDot NoArrow  = unqtDot "none"
1016    unqtDot Normal   = unqtDot "normal"
1017    unqtDot Tee      = unqtDot "tee"
1018    unqtDot Vee      = unqtDot "vee"
1019
1020instance ParseDot ArrowShape where
1021    parseUnqt = oneOf [ stringRep Box "box"
1022                      , stringRep Crow "crow"
1023                      , stringRep Diamond "diamond"
1024                      , stringRep DotArrow "dot"
1025                      , stringRep Inv "inv"
1026                      , stringRep NoArrow "none"
1027                      , stringRep Normal "normal"
1028                      , stringRep Tee "tee"
1029                      , stringRep Vee "vee"
1030                      ]
1031
1032-- | What modifications to apply to an 'ArrowShape'.
1033data ArrowModifier = ArrMod { arrowFill :: ArrowFill
1034                            , arrowSide :: ArrowSide
1035                            }
1036                     deriving (Eq, Ord, Show, Read)
1037
1038-- | Apply no modifications to an 'ArrowShape'.
1039noMods :: ArrowModifier
1040noMods = ArrMod FilledArrow BothSides
1041
1042-- | 'OpenArrow' and 'BothSides'
1043openMod :: ArrowModifier
1044openMod = ArrMod OpenArrow BothSides
1045
1046instance PrintDot ArrowModifier where
1047    unqtDot (ArrMod f s) = unqtDot f <> unqtDot s
1048
1049instance ParseDot ArrowModifier where
1050    parseUnqt = do f <- parseUnqt
1051                   s <- parseUnqt
1052                   return $ ArrMod f s
1053
1054data ArrowFill = OpenArrow
1055               | FilledArrow
1056                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
1057
1058instance PrintDot ArrowFill where
1059    unqtDot OpenArrow   = char 'o'
1060    unqtDot FilledArrow = empty
1061
1062instance ParseDot ArrowFill where
1063    parseUnqt = liftM (bool FilledArrow OpenArrow . isJust)
1064                $ optional (character 'o')
1065
1066    -- Not used individually
1067    parse = parseUnqt
1068
1069-- | Represents which side (when looking towards the node the arrow is
1070--   pointing to) is drawn.
1071data ArrowSide = LeftSide
1072               | RightSide
1073               | BothSides
1074                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
1075
1076instance PrintDot ArrowSide where
1077    unqtDot LeftSide  = char 'l'
1078    unqtDot RightSide = char 'r'
1079    unqtDot BothSides = empty
1080
1081instance ParseDot ArrowSide where
1082    parseUnqt = liftM getSideType
1083                $ optional (oneOf $ map character ['l', 'r'])
1084        where
1085          getSideType = maybe BothSides
1086                              (bool RightSide LeftSide . (==) 'l')
1087
1088    -- Not used individually
1089    parse = parseUnqt
1090
1091-- -----------------------------------------------------------------------------
1092
1093data AspectType = RatioOnly Double
1094                | RatioPassCount Double Int
1095                  deriving (Eq, Ord, Show, Read)
1096
1097instance PrintDot AspectType where
1098    unqtDot (RatioOnly r)        = unqtDot r
1099    unqtDot (RatioPassCount r p) = commaDel r p
1100
1101    toDot at@RatioOnly{}      = unqtDot at
1102    toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at
1103
1104instance ParseDot AspectType where
1105    parseUnqt = liftM (uncurry RatioPassCount) commaSepUnqt
1106                `onFail`
1107                liftM RatioOnly parseUnqt
1108
1109
1110    parse = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)
1111            `onFail`
1112            liftM RatioOnly parse
1113
1114-- -----------------------------------------------------------------------------
1115
1116data Rect = Rect Point Point
1117            deriving (Eq, Ord, Show, Read)
1118
1119instance PrintDot Rect where
1120    unqtDot (Rect p1 p2) = commaDel p1 p2
1121
1122    toDot = doubleQuotes . unqtDot
1123
1124instance ParseDot Rect where
1125    parseUnqt = liftM (uncurry Rect) commaSepUnqt
1126
1127    parse = quotedParse parseUnqt
1128
1129-- -----------------------------------------------------------------------------
1130
1131data ClusterMode = Local
1132                 | Global
1133                 | NoCluster
1134                   deriving (Eq, Ord, Bounded, Enum, Show, Read)
1135
1136instance PrintDot ClusterMode where
1137    unqtDot Local     = unqtDot "local"
1138    unqtDot Global    = unqtDot "global"
1139    unqtDot NoCluster = unqtDot "none"
1140
1141
1142
1143instance ParseDot ClusterMode where
1144    parseUnqt = oneOf [ stringRep Local "local"
1145                      , stringRep Global "global"
1146                      , stringRep NoCluster "none"
1147                      ]
1148
1149-- -----------------------------------------------------------------------------
1150
1151data DirType = Forward | Back | Both | NoDir
1152               deriving (Eq, Ord, Bounded, Enum, Show, Read)
1153
1154instance PrintDot DirType where
1155    unqtDot Forward = unqtDot "forward"
1156    unqtDot Back    = unqtDot "back"
1157    unqtDot Both    = unqtDot "both"
1158    unqtDot NoDir   = unqtDot "none"
1159
1160instance ParseDot DirType where
1161    parseUnqt = oneOf [ stringRep Forward "forward"
1162                      , stringRep Back "back"
1163                      , stringRep Both "both"
1164                      , stringRep NoDir "none"
1165                      ]
1166
1167-- -----------------------------------------------------------------------------
1168
1169-- | Only when @mode == 'IpSep'@.
1170data DEConstraints = EdgeConstraints
1171                   | NoConstraints
1172                   | HierConstraints
1173                     deriving (Eq, Ord, Bounded, Enum, Show, Read)
1174
1175instance PrintDot DEConstraints where
1176    unqtDot EdgeConstraints = unqtDot True
1177    unqtDot NoConstraints   = unqtDot False
1178    unqtDot HierConstraints = text "hier"
1179
1180instance ParseDot DEConstraints where
1181    parseUnqt = liftM (bool NoConstraints EdgeConstraints) parse
1182                `onFail`
1183                stringRep HierConstraints "hier"
1184
1185-- -----------------------------------------------------------------------------
1186
1187-- | Either a 'Double' or a 'Point'.
1188data DPoint = DVal Double
1189            | PVal Point
1190             deriving (Eq, Ord, Show, Read)
1191
1192instance PrintDot DPoint where
1193    unqtDot (DVal d) = unqtDot d
1194    unqtDot (PVal p) = unqtDot p
1195
1196    toDot (DVal d) = toDot d
1197    toDot (PVal p) = toDot p
1198
1199instance ParseDot DPoint where
1200    parseUnqt = liftM PVal parseUnqt
1201                `onFail`
1202                liftM DVal parseUnqt
1203
1204    parse = liftM PVal parse
1205            `onFail`
1206            liftM DVal parse
1207
1208-- -----------------------------------------------------------------------------
1209
1210data ModeType = Major
1211              | KK
1212              | Hier
1213              | IpSep
1214                deriving (Eq, Ord, Bounded, Enum, Show, Read)
1215
1216instance PrintDot ModeType where
1217    unqtDot Major = text "major"
1218    unqtDot KK    = text "KK"
1219    unqtDot Hier  = text "hier"
1220    unqtDot IpSep = text "ipsep"
1221
1222instance ParseDot ModeType where
1223    parseUnqt = oneOf [ stringRep Major "major"
1224                      , stringRep KK "KK"
1225                      , stringRep Hier "hier"
1226                      , stringRep IpSep "ipsep"
1227                      ]
1228
1229-- -----------------------------------------------------------------------------
1230
1231data Model = ShortPath
1232           | SubSet
1233           | Circuit
1234             deriving (Eq, Ord, Bounded, Enum, Show, Read)
1235
1236instance PrintDot Model where
1237    unqtDot ShortPath = text "shortpath"
1238    unqtDot SubSet    = text "subset"
1239    unqtDot Circuit   = text "circuit"
1240
1241instance ParseDot Model where
1242    parseUnqt = oneOf [ stringRep ShortPath "shortpath"
1243                      , stringRep SubSet "subset"
1244                      , stringRep Circuit "circuit"
1245                      ]
1246
1247-- -----------------------------------------------------------------------------
1248
1249data Label = StrLabel EscString
1250           | URLLabel URL
1251             deriving (Eq, Ord, Show, Read)
1252
1253instance PrintDot Label where
1254    unqtDot (StrLabel s) = unqtDot s
1255    unqtDot (URLLabel u) = unqtDot u
1256
1257    toDot (StrLabel s) = toDot s
1258    toDot (URLLabel u) = toDot u
1259
1260instance ParseDot Label where
1261    parseUnqt = liftM StrLabel parseUnqt
1262                `onFail`
1263                liftM URLLabel parseUnqt
1264
1265    parse = liftM StrLabel parse
1266            `onFail`
1267            liftM URLLabel parse
1268
1269-- -----------------------------------------------------------------------------
1270
1271data Point = Point Int Int
1272           | PointD Double Double
1273             deriving (Eq, Ord, Show, Read)
1274
1275instance PrintDot Point where
1276    unqtDot (Point  x y) = commaDel x y
1277    unqtDot (PointD x y) = commaDel x y
1278
1279    toDot = doubleQuotes . unqtDot
1280
1281    unqtListToDot = hsep . map unqtDot
1282
1283    listToDot = doubleQuotes . unqtListToDot
1284
1285instance ParseDot Point where
1286    -- Need to take into account the situation where first value is an
1287    -- integer, second a double: if Point parsing first, then it won't
1288    -- parse the second number properly; but if PointD first then it
1289    -- will treat Int/Int as Double/Double.
1290    parseUnqt = intDblPoint
1291                `onFail`
1292                liftM (uncurry Point)  commaSepUnqt
1293                `onFail`
1294                liftM (uncurry PointD) commaSepUnqt
1295        where
1296          intDblPoint = liftM (uncurry PointD . first fI)
1297                        $ commaSep' parseUnqt parseStrictFloat
1298          fI :: Int -> Double
1299          fI = fromIntegral
1300
1301    parse = quotedParse parseUnqt
1302
1303    parseUnqtList = sepBy1 parseUnqt whitespace
1304
1305-- -----------------------------------------------------------------------------
1306
1307data Overlap = KeepOverlaps
1308             | RemoveOverlaps
1309             | ScaleOverlaps
1310             | ScaleXYOverlaps
1311             | PrismOverlap (Maybe Int) -- ^ Only when sfdp is available, 'Int' is non-negative
1312             | CompressOverlap
1313             | VpscOverlap
1314             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@
1315               deriving (Eq, Ord, Show, Read)
1316
1317instance PrintDot Overlap where
1318    unqtDot KeepOverlaps     = unqtDot True
1319    unqtDot RemoveOverlaps   = unqtDot False
1320    unqtDot ScaleOverlaps    = text "scale"
1321    unqtDot ScaleXYOverlaps  = text "scalexy"
1322    unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism"
1323    unqtDot CompressOverlap  = text "compress"
1324    unqtDot VpscOverlap      = text "vpsc"
1325    unqtDot IpsepOverlap     = text "ipsep"
1326
1327instance ParseDot Overlap where
1328    parseUnqt = oneOf [ stringRep KeepOverlaps "true"
1329                      , stringRep RemoveOverlaps "false"
1330                      , stringRep ScaleXYOverlaps "scalexy"
1331                      , stringRep ScaleOverlaps "scale"
1332                      , string "prism" >> liftM PrismOverlap (optional parse)
1333                      , stringRep CompressOverlap "compress"
1334                      , stringRep VpscOverlap "vpsc"
1335                      , stringRep IpsepOverlap "ipsep"
1336                      ]
1337
1338-- -----------------------------------------------------------------------------
1339
1340data LayerRange = LRID LayerID
1341                | LRS LayerID String LayerID
1342                  deriving (Eq, Ord, Show, Read)
1343
1344instance PrintDot LayerRange where
1345    unqtDot (LRID lid)      = unqtDot lid
1346    unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2
1347
1348    toDot (LRID lid) = toDot lid
1349    toDot lrs        = doubleQuotes $ unqtDot lrs
1350
1351instance ParseDot LayerRange where
1352    parseUnqt = do id1 <- parseUnqt
1353                   s   <- parseLayerSep
1354                   id2 <- parseUnqt
1355                   return $ LRS id1 s id2
1356                `onFail`
1357                liftM LRID parseUnqt
1358
1359
1360    parse = quotedParse ( do id1 <- parseUnqt
1361                             s   <- parseLayerSep
1362                             id2 <- parseUnqt
1363                             return $ LRS id1 s id2
1364                        )
1365            `onFail`
1366            liftM LRID parse
1367
1368parseLayerSep :: Parse String
1369parseLayerSep = many1 . oneOf
1370                $ map character defLayerSep
1371
1372defLayerSep :: [Char]
1373defLayerSep = [' ', ':', '\t']
1374
1375parseLayerName :: Parse String
1376parseLayerName = many1 . orQuote
1377                 $ satisfy (liftM2 (&&) notLayerSep ((/=) quoteChar))
1378
1379parseLayerName' :: Parse String
1380parseLayerName' = stringBlock
1381                  `onFail`
1382                  quotedParse parseLayerName
1383
1384notLayerSep :: Char -> Bool
1385notLayerSep = flip notElem defLayerSep
1386
1387-- | You should not have any quote characters for the 'LRName' option,
1388--   as it won't be parseable.
1389data LayerID = AllLayers
1390             | LRInt Int
1391             | LRName String
1392               deriving (Eq, Ord, Show, Read)
1393
1394instance PrintDot LayerID where
1395    unqtDot AllLayers   = text "all"
1396    unqtDot (LRInt n)   = unqtDot n
1397    unqtDot (LRName nm) = unqtDot nm
1398
1399    toDot (LRName nm) = toDot nm
1400    -- Other two don't need quotes
1401    toDot li          = unqtDot li
1402
1403instance ParseDot LayerID where
1404    parseUnqt = liftM checkLayerName parseLayerName -- tests for Int and All
1405
1406    parse = oneOf [ liftM checkLayerName parseLayerName'
1407                  , liftM LRInt parse -- Mainly for unquoted case.
1408                  ]
1409
1410checkLayerName     :: String -> LayerID
1411checkLayerName str = maybe checkAll LRInt $ stringToInt str
1412  where
1413    checkAll = if map toLower str == "all"
1414               then AllLayers
1415               else LRName str
1416
1417-- | The list represent (Separator, Name).  You should not have any
1418--   quote characters for any of the 'String's, since there are
1419--   parsing problems with them.
1420data LayerList = LL String [(String, String)]
1421                 deriving (Eq, Ord, Show, Read)
1422
1423instance PrintDot LayerList where
1424    unqtDot (LL l1 ols) = unqtDot l1 <> hcat (map subLL ols)
1425        where
1426          subLL (s, l) = unqtDot s <> unqtDot l
1427
1428    toDot (LL l1 []) = toDot l1
1429    -- Might not need quotes, but probably will.
1430    toDot ll         = doubleQuotes $ unqtDot ll
1431
1432instance ParseDot LayerList where
1433    parseUnqt = do l1 <- parseLayerName
1434                   ols <- many $ do s   <- parseLayerSep
1435                                    lnm <- parseLayerName
1436                                    return (s, lnm)
1437                   return $ LL l1 ols
1438
1439    parse = quotedParse parseUnqt
1440            `onFail`
1441            liftM (flip LL []) (parseLayerName' `onFail` numString)
1442
1443-- -----------------------------------------------------------------------------
1444
1445data OutputMode = BreadthFirst | NodesFirst | EdgesFirst
1446                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
1447
1448instance PrintDot OutputMode where
1449    unqtDot BreadthFirst = text "breadthfirst"
1450    unqtDot NodesFirst   = text "nodesfirst"
1451    unqtDot EdgesFirst   = text "edgesfirst"
1452
1453instance ParseDot OutputMode where
1454    parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"
1455                      , stringRep NodesFirst "nodesfirst"
1456                      , stringRep EdgesFirst "edgesfirst"
1457                      ]
1458
1459-- -----------------------------------------------------------------------------
1460
1461data Pack = DoPack
1462          | DontPack
1463          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.
1464            deriving (Eq, Ord, Show, Read)
1465
1466instance PrintDot Pack where
1467    unqtDot DoPack         = unqtDot True
1468    unqtDot DontPack       = unqtDot False
1469    unqtDot (PackMargin m) = unqtDot m
1470
1471instance ParseDot Pack where
1472    -- What happens if it parses 0?  It's non-negative, but parses as False
1473    parseUnqt = oneOf [ liftM PackMargin parseUnqt
1474                      , liftM (bool DontPack DoPack) onlyBool
1475                      ]
1476
1477-- -----------------------------------------------------------------------------
1478
1479data PackMode = PackNode
1480              | PackClust
1481              | PackGraph
1482              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort
1483                                                -- by user, number of
1484                                                -- rows/cols
1485                deriving (Eq, Ord, Show, Read)
1486
1487instance PrintDot PackMode where
1488    unqtDot PackNode           = text "node"
1489    unqtDot PackClust          = text "clust"
1490    unqtDot PackGraph          = text "graph"
1491    unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder
1492                                 $ text "array"
1493        where
1494          addNum = maybe id (flip (<>) . unqtDot) mi
1495          isUnder = if c || u
1496                    then flip (<>) $ char '_'
1497                    else id
1498          isC = if c
1499                then flip (<>) $ char 'c'
1500                else id
1501          isU = if u
1502                then flip (<>) $ char 'u'
1503                else id
1504
1505instance ParseDot PackMode where
1506    parseUnqt = oneOf [ stringRep PackNode "node"
1507                      , stringRep PackClust "clust"
1508                      , stringRep PackGraph "graph"
1509                      , do string "array"
1510                           mcu <- optional $ do character '_'
1511                                                many1 $ satisfy isCU
1512                           let c = hasCharacter mcu 'c'
1513                               u = hasCharacter mcu 'u'
1514                           mi <- optional parseUnqt
1515                           return $ PackArray c u mi
1516                      ]
1517        where
1518          hasCharacter ms c = maybe False (elem c) ms
1519          -- Also checks and removes quote characters
1520          isCU = flip elem ['c', 'u']
1521
1522-- -----------------------------------------------------------------------------
1523
1524data Pos = PointPos Point
1525         | SplinePos [Spline]
1526           deriving (Eq, Ord, Show, Read)
1527
1528instance PrintDot Pos where
1529    unqtDot (PointPos p)   = unqtDot p
1530    unqtDot (SplinePos ss) = unqtDot ss
1531
1532    toDot (PointPos p)   = toDot p
1533    toDot (SplinePos ss) = toDot ss
1534
1535instance ParseDot Pos where
1536    -- Have to be careful with this: if we try to parse points first,
1537    -- then a spline with no start and end points will erroneously get
1538    -- parsed as a point and then the parser will crash as it expects
1539    -- a closing quote character...
1540    parseUnqt = do splns <- parseUnqt
1541                   case splns of
1542                     [Spline Nothing Nothing [p]] -> return $ PointPos p
1543                     _                            -> return $ SplinePos splns
1544
1545    parse = quotedParse parseUnqt
1546
1547-- -----------------------------------------------------------------------------
1548
1549-- | Controls how (and if) edges are represented.
1550data EdgeType = SplineEdges
1551              | LineEdges
1552              | NoEdges
1553              | PolyLine
1554              | CompoundEdge -- ^ fdp only
1555                deriving (Eq, Ord, Bounded, Enum, Show, Read)
1556
1557instance PrintDot EdgeType where
1558    unqtDot SplineEdges  = toDot True
1559    unqtDot LineEdges    = toDot False
1560    unqtDot NoEdges      = empty
1561    unqtDot PolyLine     = text "polyline"
1562    unqtDot CompoundEdge = text "compound"
1563
1564    toDot NoEdges = doubleQuotes empty
1565    toDot et      = unqtDot et
1566
1567instance ParseDot EdgeType where
1568    -- Can't parse NoEdges without quotes.
1569    parseUnqt = oneOf [ liftM (bool LineEdges SplineEdges) parse
1570                      , stringRep SplineEdges "spline"
1571                      , stringRep LineEdges "line"
1572                      , stringRep PolyLine "polyline"
1573                      , stringRep CompoundEdge "compound"
1574                      ]
1575
1576    parse = stringRep NoEdges "\"\""
1577            `onFail`
1578            optionalQuoted parseUnqt
1579
1580-- -----------------------------------------------------------------------------
1581
1582-- | Upper-case first character is major order;
1583--   lower-case second character is minor order.
1584data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt
1585               deriving (Eq, Ord, Bounded, Enum, Show, Read)
1586
1587instance PrintDot PageDir where
1588    unqtDot Bl = text "BL"
1589    unqtDot Br = text "BR"
1590    unqtDot Tl = text "TL"
1591    unqtDot Tr = text "TR"
1592    unqtDot Rb = text "RB"
1593    unqtDot Rt = text "RT"
1594    unqtDot Lb = text "LB"
1595    unqtDot Lt = text "LT"
1596
1597instance ParseDot PageDir where
1598    parseUnqt = oneOf [ stringRep Bl "BL"
1599                      , stringRep Br "BR"
1600                      , stringRep Tl "TL"
1601                      , stringRep Tr "TR"
1602                      , stringRep Rb "RB"
1603                      , stringRep Rt "RT"
1604                      , stringRep Lb "LB"
1605                      , stringRep Lt "LT"
1606                      ]
1607
1608-- -----------------------------------------------------------------------------
1609
1610-- | The number of points in the list must be equivalent to 1 mod 3;
1611--   note that this is not checked.
1612data Spline = Spline (Maybe Point) (Maybe Point) [Point]
1613              deriving (Eq, Ord, Show, Read)
1614
1615instance PrintDot Spline where
1616    unqtDot (Spline ms me ps) = addS . addE
1617                               . hsep
1618                               $ map unqtDot ps
1619        where
1620          addP t = maybe id ((<+>) . commaDel t)
1621          addS = addP 's' ms
1622          addE = addP 'e' me
1623
1624    toDot = doubleQuotes . unqtDot
1625
1626    unqtListToDot = hcat . punctuate semi . map unqtDot
1627
1628    listToDot = doubleQuotes . unqtListToDot
1629
1630instance ParseDot Spline where
1631    parseUnqt = do ms <- parseP 's'
1632                   me <- parseP 'e'
1633                   ps <- sepBy1 parseUnqt whitespace
1634                   return $ Spline ms me ps
1635        where
1636          parseP t = optional $ do character t
1637                                   parseComma
1638                                   parseUnqt `discard` whitespace
1639
1640    parse = quotedParse parseUnqt
1641
1642    parseUnqtList = sepBy1 parseUnqt (character ';')
1643
1644-- -----------------------------------------------------------------------------
1645
1646data QuadType = NormalQT
1647              | FastQT
1648              | NoQT
1649                deriving (Eq, Ord, Bounded, Enum, Show, Read)
1650
1651instance PrintDot QuadType where
1652    unqtDot NormalQT = text "normal"
1653    unqtDot FastQT   = text "fast"
1654    unqtDot NoQT     = text "none"
1655
1656instance ParseDot QuadType where
1657    -- Have to take into account the slightly different interpretation
1658    -- of Bool used as an option for parsing QuadType
1659    parseUnqt = oneOf [ stringRep NormalQT "normal"
1660                      , stringRep FastQT "fast"
1661                      , stringRep NoQT "none"
1662                      , character '2'   >> return FastQT -- weird bool
1663                      , liftM (bool NoQT NormalQT) parse
1664                      ]
1665
1666-- -----------------------------------------------------------------------------
1667
1668-- | Specify the root node either as a Node attribute or a Graph attribute.
1669data Root = IsCentral       -- ^ For Nodes only
1670          | NotCentral      -- ^ For Nodes only
1671          | NodeName String -- ^ For Graphs only
1672            deriving (Eq, Ord, Show, Read)
1673
1674instance PrintDot Root where
1675    unqtDot IsCentral    = unqtDot True
1676    unqtDot NotCentral   = unqtDot False
1677    unqtDot (NodeName n) = unqtDot n
1678
1679    toDot (NodeName n) = toDot n
1680    toDot r            = unqtDot r
1681
1682instance ParseDot Root where
1683    parseUnqt = liftM (bool NotCentral IsCentral) onlyBool
1684                `onFail`
1685                liftM NodeName parseUnqt
1686
1687    parse = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool)
1688            `onFail`
1689            liftM NodeName parse
1690
1691-- -----------------------------------------------------------------------------
1692
1693data RankType = SameRank
1694              | MinRank
1695              | SourceRank
1696              | MaxRank
1697              | SinkRank
1698                deriving (Eq, Ord, Bounded, Enum, Show, Read)
1699
1700instance PrintDot RankType where
1701    unqtDot SameRank   = text "same"
1702    unqtDot MinRank    = text "min"
1703    unqtDot SourceRank = text "source"
1704    unqtDot MaxRank    = text "max"
1705    unqtDot SinkRank   = text "sink"
1706
1707instance ParseDot RankType where
1708    parseUnqt = oneOf [ stringRep SameRank "same"
1709                      , stringRep MinRank "min"
1710                      , stringRep SourceRank "source"
1711                      , stringRep MaxRank "max"
1712                      , stringRep SinkRank "sink"
1713                      ]
1714
1715-- -----------------------------------------------------------------------------
1716
1717data RankDir = FromTop
1718             | FromLeft
1719             | FromBottom
1720             | FromRight
1721               deriving (Eq, Ord, Bounded, Enum, Show, Read)
1722
1723instance PrintDot RankDir where
1724    unqtDot FromTop    = text "TB"
1725    unqtDot FromLeft   = text "LR"
1726    unqtDot FromBottom = text "BT"
1727    unqtDot FromRight  = text "RL"
1728
1729instance ParseDot RankDir where
1730    parseUnqt = oneOf [ stringRep FromTop "TB"
1731                      , stringRep FromLeft "LR"
1732                      , stringRep FromBottom "BT"
1733                      , stringRep FromRight "RL"
1734                      ]
1735
1736-- -----------------------------------------------------------------------------
1737
1738data Shape
1739    = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.
1740    | Polygon
1741    | Ellipse
1742    | Circle
1743    | PointShape
1744    | Egg
1745    | Triangle
1746    | PlainText -- ^ Has synonym of /none/.
1747    | DiamondShape
1748    | Trapezium
1749    | Parallelogram
1750    | House
1751    | Pentagon
1752    | Hexagon
1753    | Septagon
1754    | Octagon
1755    | DoubleCircle
1756    | DoubleOctagon
1757    | TripleOctagon
1758    | InvTriangle
1759    | InvTrapezium
1760    | InvHouse
1761    | MDiamond
1762    | MSquare
1763    | MCircle
1764    | Note
1765    | Tab
1766    | Folder
1767    | Box3D
1768    | Component
1769      deriving (Eq, Ord, Bounded, Enum, Show, Read)
1770
1771instance PrintDot Shape where
1772    unqtDot BoxShape      = text "box"
1773    unqtDot Polygon       = text "polygon"
1774    unqtDot Ellipse       = text "ellipse"
1775    unqtDot Circle        = text "circle"
1776    unqtDot PointShape    = text "point"
1777    unqtDot Egg           = text "egg"
1778    unqtDot Triangle      = text "triangle"
1779    unqtDot PlainText     = text "plaintext"
1780    unqtDot DiamondShape  = text "diamond"
1781    unqtDot Trapezium     = text "trapezium"
1782    unqtDot Parallelogram = text "parallelogram"
1783    unqtDot House         = text "house"
1784    unqtDot Pentagon      = text "pentagon"
1785    unqtDot Hexagon       = text "hexagon"
1786    unqtDot Septagon      = text "septagon"
1787    unqtDot Octagon       = text "octagon"
1788    unqtDot DoubleCircle  = text "doublecircle"
1789    unqtDot DoubleOctagon = text "doubleoctagon"
1790    unqtDot TripleOctagon = text "tripleoctagon"
1791    unqtDot InvTriangle   = text "invtriangle"
1792    unqtDot InvTrapezium  = text "invtrapezium"
1793    unqtDot InvHouse      = text "invhouse"
1794    unqtDot MDiamond      = text "Mdiamond"
1795    unqtDot MSquare       = text "Msquare"
1796    unqtDot MCircle       = text "Mcircle"
1797    unqtDot Note          = text "note"
1798    unqtDot Tab           = text "tab"
1799    unqtDot Folder        = text "folder"
1800    unqtDot Box3D         = text "box3d"
1801    unqtDot Component     = text "component"
1802
1803instance ParseDot Shape where
1804    parseUnqt = oneOf [ stringRep Box3D "box3d" -- Parse this before "box"
1805                      , stringReps BoxShape ["box","rectangle","rect"]
1806                      , stringRep Polygon "polygon"
1807                      , stringRep Ellipse "ellipse"
1808                      , stringRep Circle "circle"
1809                      , stringRep PointShape "point"
1810                      , stringRep Egg "egg"
1811                      , stringRep Triangle "triangle"
1812                      , stringReps PlainText ["plaintext","none"]
1813                      , stringRep DiamondShape "diamond"
1814                      , stringRep Trapezium "trapezium"
1815                      , stringRep Parallelogram "parallelogram"
1816                      , stringRep House "house"
1817                      , stringRep Pentagon "pentagon"
1818                      , stringRep Hexagon "hexagon"
1819                      , stringRep Septagon "septagon"
1820                      , stringRep Octagon "octagon"
1821                      , stringRep DoubleCircle "doublecircle"
1822                      , stringRep DoubleOctagon "doubleoctagon"
1823                      , stringRep TripleOctagon "tripleoctagon"
1824                      , stringRep InvTriangle "invtriangle"
1825                      , stringRep InvTrapezium "invtrapezium"
1826                      , stringRep InvHouse "invhouse"
1827                      , stringRep MDiamond "Mdiamond"
1828                      , stringRep MSquare "Msquare"
1829                      , stringRep MCircle "Mcircle"
1830                      , stringRep Note "note"
1831                      , stringRep Tab "tab"
1832                      , stringRep Folder "folder"
1833                      , stringRep Component "component"
1834                      ]
1835
1836-- -----------------------------------------------------------------------------
1837
1838data SmoothType = NoSmooth
1839                | AvgDist
1840                | GraphDist
1841                | PowerDist
1842                | RNG
1843                | Spring
1844                | TriangleSmooth
1845                  deriving (Eq, Ord, Bounded, Enum, Show, Read)
1846
1847instance PrintDot SmoothType where
1848    unqtDot NoSmooth       = text "none"
1849    unqtDot AvgDist        = text "avg_dist"
1850    unqtDot GraphDist      = text "graph_dist"
1851    unqtDot PowerDist      = text "power_dist"
1852    unqtDot RNG            = text "rng"
1853    unqtDot Spring         = text "spring"
1854    unqtDot TriangleSmooth = text "triangle"
1855
1856instance ParseDot SmoothType where
1857    parseUnqt = oneOf [ stringRep NoSmooth "none"
1858                      , stringRep AvgDist "avg_dist"
1859                      , stringRep GraphDist "graph_dist"
1860                      , stringRep PowerDist "power_dist"
1861                      , stringRep RNG "rng"
1862                      , stringRep Spring "spring"
1863                      , stringRep TriangleSmooth "triangle"
1864                      ]
1865
1866-- -----------------------------------------------------------------------------
1867
1868data StartType = StartStyle STStyle
1869               | StartSeed Int
1870               | StartStyleSeed STStyle Int
1871                 deriving (Eq, Ord, Show, Read)
1872
1873instance PrintDot StartType where
1874    unqtDot (StartStyle ss)       = unqtDot ss
1875    unqtDot (StartSeed s)         = unqtDot s
1876    unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s
1877
1878instance ParseDot StartType where
1879    parseUnqt = oneOf [ do ss <- parseUnqt
1880                           s  <- parseUnqt
1881                           return $ StartStyleSeed ss s
1882                      , liftM StartStyle parseUnqt
1883                      , liftM StartSeed parseUnqt
1884                      ]
1885
1886data STStyle = RegularStyle
1887             | SelfStyle
1888             | RandomStyle
1889               deriving (Eq, Ord, Bounded, Enum, Show, Read)
1890
1891instance PrintDot STStyle where
1892    unqtDot RegularStyle = text "regular"
1893    unqtDot SelfStyle    = text "self"
1894    unqtDot RandomStyle  = text "random"
1895
1896instance ParseDot STStyle where
1897    parseUnqt = oneOf [ stringRep RegularStyle "regular"
1898                      , stringRep SelfStyle "self"
1899                      , stringRep RandomStyle "random"
1900                      ]
1901
1902-- -----------------------------------------------------------------------------
1903
1904data StyleItem = SItem StyleName [String]
1905             deriving (Eq, Ord, Show, Read)
1906
1907instance PrintDot StyleItem where
1908    unqtDot (SItem nm args)
1909        | null args = dnm
1910        | otherwise = dnm <> parens args'
1911        where
1912          dnm = unqtDot nm
1913          args' = hcat . punctuate comma $ map unqtDot args
1914
1915    toDot si@(SItem nm args)
1916        | null args = toDot nm
1917        | otherwise = doubleQuotes $ unqtDot si
1918
1919    unqtListToDot = hcat . punctuate comma . map unqtDot
1920
1921    listToDot [SItem nm []] = toDot nm
1922    listToDot sis           = doubleQuotes $ unqtListToDot sis
1923
1924instance ParseDot StyleItem where
1925    parseUnqt = do nm <- parseUnqt
1926                   args <- tryParseList' parseArgs
1927                   return $ SItem nm args
1928
1929    parse = quotedParse (liftM2 SItem parseUnqt parseArgs)
1930            `onFail`
1931            liftM (flip SItem []) parse
1932
1933    parseUnqtList = sepBy1 parseUnqt parseComma
1934
1935    parseList = quotedParse parseUnqtList
1936                `onFail`
1937                -- Might not necessarily need to be quoted if a singleton...
1938                liftM return parse
1939
1940parseArgs :: Parse [String]
1941parseArgs = bracketSep (character '(')
1942                       parseComma
1943                       (character ')')
1944                       parseStyleName
1945
1946data StyleName = Dashed    -- ^ Nodes and Edges
1947               | Dotted    -- ^ Nodes and Edges
1948               | Solid     -- ^ Nodes and Edges
1949               | Bold      -- ^ Nodes and Edges
1950               | Invisible -- ^ Nodes and Edges
1951               | Filled    -- ^ Nodes and Clusters
1952               | Diagonals -- ^ Nodes only
1953               | Rounded   -- ^ Nodes and Clusters
1954               | DD String -- ^ Device Dependent
1955                 deriving (Eq, Ord, Show, Read)
1956
1957instance PrintDot StyleName where
1958    unqtDot Dashed    = text "dashed"
1959    unqtDot Dotted    = text "dotted"
1960    unqtDot Solid     = text "solid"
1961    unqtDot Bold      = text "bold"
1962    unqtDot Invisible = text "invis"
1963    unqtDot Filled    = text "filled"
1964    unqtDot Diagonals = text "diagonals"
1965    unqtDot Rounded   = text "rounded"
1966    unqtDot (DD nm)   = unqtDot nm
1967
1968    toDot (DD nm) = toDot nm
1969    toDot sn      = unqtDot sn
1970
1971instance ParseDot StyleName where
1972    parseUnqt = liftM checkDD parseStyleName
1973
1974    parse = liftM checkDD
1975            $ quotedParse parseStyleName
1976              `onFail`
1977              -- In case a singleton DD is at the end of an attribute list.
1978              do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ', ']']
1979                 r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',', ']'])
1980                 return $ f:r
1981
1982checkDD     :: String -> StyleName
1983checkDD str = case map toLower str of
1984                "dashed"    -> Dashed
1985                "dotted"    -> Dotted
1986                "solid"     -> Solid
1987                "bold"      -> Bold
1988                "invis"     -> Invisible
1989                "filled"    -> Filled
1990                "diagonals" -> Diagonals
1991                "rounded"   -> Rounded
1992                _           -> DD str
1993
1994parseStyleName :: Parse String
1995parseStyleName = do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ']
1996                    r <- many (orQuote $ noneOf [quoteChar, '(', ')', ','])
1997                    return $ f:r
1998
1999-- -----------------------------------------------------------------------------
2000
2001newtype PortPos = PP CompassPoint
2002    deriving (Eq, Ord, Show, Read)
2003
2004instance PrintDot PortPos where
2005    unqtDot (PP cp) = unqtDot cp
2006
2007    toDot (PP cp) = toDot cp
2008
2009instance ParseDot PortPos where
2010    parseUnqt = liftM PP parseUnqt
2011
2012data CompassPoint = North
2013                  | NorthEast
2014                  | East
2015                  | SouthEast
2016                  | South
2017                  | SouthWest
2018                  | West
2019                  | NorthWest
2020                  | CenterPoint
2021                  | NoCP
2022                    deriving (Eq, Ord, Bounded, Enum, Show, Read)
2023
2024instance PrintDot CompassPoint where
2025    unqtDot NorthEast   = text "ne"
2026    unqtDot NorthWest   = text "nw"
2027    unqtDot North       = text "n"
2028    unqtDot East        = text "e"
2029    unqtDot SouthEast   = text "se"
2030    unqtDot SouthWest   = text "sw"
2031    unqtDot South       = text "s"
2032    unqtDot West        = text "w"
2033    unqtDot CenterPoint = text "c"
2034    unqtDot NoCP        = text "_"
2035
2036instance ParseDot CompassPoint where
2037    -- Have to take care of longer parsing values first.
2038    parseUnqt = oneOf [ stringRep NorthEast "ne"
2039                      , stringRep NorthWest "nw"
2040                      , stringRep North "n"
2041                      , stringRep SouthEast "se"
2042                      , stringRep SouthWest "sw"
2043                      , stringRep South "s"
2044                      , stringRep East "e"
2045                      , stringRep West "w"
2046                      , stringRep CenterPoint "c"
2047                      , stringRep NoCP "_"
2048                      ]
2049
2050-- -----------------------------------------------------------------------------
2051
2052data ViewPort = VP { wVal  :: Double
2053                   , hVal  :: Double
2054                   , zVal  :: Double
2055                   , focus :: Maybe FocusType
2056                   }
2057                deriving (Eq, Ord, Show, Read)
2058
2059instance PrintDot ViewPort where
2060    unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)
2061                 $ focus vp
2062        where
2063          vs = hcat . punctuate comma
2064               $ map (unqtDot . flip ($) vp) [wVal, hVal, zVal]
2065
2066    toDot = doubleQuotes . unqtDot
2067
2068instance ParseDot ViewPort where
2069    parseUnqt = do wv <- parseUnqt
2070                   parseComma
2071                   hv <- parseUnqt
2072                   parseComma
2073                   zv <- parseUnqt
2074                   mf <- optional $ parseComma >> parseUnqt
2075                   return $ VP wv hv zv mf
2076
2077    parse = quotedParse parseUnqt
2078
2079data FocusType = XY Point
2080               | NodeFocus String
2081                 deriving (Eq, Ord, Show, Read)
2082
2083instance PrintDot FocusType where
2084    unqtDot (XY p)         = unqtDot p
2085    unqtDot (NodeFocus nm) = unqtDot nm
2086
2087    toDot (XY p)         = toDot p
2088    toDot (NodeFocus nm) = toDot nm
2089
2090instance ParseDot FocusType where
2091    parseUnqt = liftM XY parseUnqt
2092                `onFail`
2093                liftM NodeFocus parseUnqt
2094
2095    parse = liftM XY parse
2096            `onFail`
2097            liftM NodeFocus parse
2098
2099-- -----------------------------------------------------------------------------
2100
2101data VerticalPlacement = VTop
2102                       | VCenter -- ^ Only valid for Nodes.
2103                       | VBottom
2104                         deriving (Eq, Ord, Bounded, Enum, Show, Read)
2105
2106instance PrintDot VerticalPlacement where
2107    unqtDot VTop    = char 't'
2108    unqtDot VCenter = char 'c'
2109    unqtDot VBottom = char 'b'
2110
2111instance ParseDot VerticalPlacement where
2112    parseUnqt = oneOf [ stringRep VTop "t"
2113                      , stringRep VCenter "c"
2114                      , stringRep VBottom "b"
2115                      ]
2116
2117-- -----------------------------------------------------------------------------
2118
2119data ScaleType = UniformScale
2120               | NoScale
2121               | FillWidth
2122               | FillHeight
2123               | FillBoth
2124                 deriving (Eq, Ord, Bounded, Enum, Show, Read)
2125
2126instance PrintDot ScaleType where
2127    unqtDot UniformScale = unqtDot True
2128    unqtDot NoScale      = unqtDot False
2129    unqtDot FillWidth    = text "width"
2130    unqtDot FillHeight   = text "height"
2131    unqtDot FillBoth     = text "both"
2132
2133instance ParseDot ScaleType where
2134    parseUnqt = oneOf [ stringRep UniformScale "true"
2135                      , stringRep NoScale "false"
2136                      , stringRep FillWidth "width"
2137                      , stringRep FillHeight "height"
2138                      , stringRep FillBoth "both"
2139                      ]
2140
2141-- -----------------------------------------------------------------------------
2142
2143data Justification = JLeft
2144                   | JRight
2145                   | JCenter
2146                     deriving (Eq, Ord, Bounded, Enum, Show, Read)
2147
2148instance PrintDot Justification where
2149    unqtDot JLeft   = char 'l'
2150    unqtDot JRight  = char 'r'
2151    unqtDot JCenter = char 'c'
2152
2153instance ParseDot Justification where
2154    parseUnqt = oneOf [ stringRep JLeft "l"
2155                      , stringRep JRight "r"
2156                      , stringRep JCenter "c"
2157                      ]
2158
2159-- -----------------------------------------------------------------------------
2160
2161data Ratios = AspectRatio Double
2162            | FillRatio
2163            | CompressRatio
2164            | ExpandRatio
2165            | AutoRatio
2166              deriving (Eq, Ord, Show, Read)
2167
2168instance PrintDot Ratios where
2169    unqtDot (AspectRatio r) = unqtDot r
2170    unqtDot FillRatio       = text "fill"
2171    unqtDot CompressRatio   = text "compress"
2172    unqtDot ExpandRatio     = text "expand"
2173    unqtDot AutoRatio       = text "auto"
2174
2175instance ParseDot Ratios where
2176    parseUnqt = oneOf [ liftM AspectRatio parseUnqt
2177                      , stringRep FillRatio "fill"
2178                      , stringRep CompressRatio "compress"
2179                      , stringRep ExpandRatio "expand"
2180                      , stringRep AutoRatio "auto"
2181                      ]
2182