packages feed

graphviz 2999.13.0.3 → 2999.20.2.1

raw patch · 66 files changed

Files

− Changelog 
@@ -1,623 +0,0 @@-% Changelog-% Ivan Lazar Miljenovic--Release History and Changelog-=============================--The following is information about what major changes have gone into-each release.--Changes in 2999.13.0.3-------------------------* Allow usage of transformers-0.3.*.  Spotted by **Peter Simons**.--Changes in 2999.13.0.2-------------------------* The `String` instance for `ToGraphID` requires the-  `TypeSynonymInstances` pragma (at least on GHC < 7.4).  Spotted by-  **Gregory Guthrie**.--Changes in 2999.13.0.1-------------------------* Fixed Haddock typos.--Changes in 2999.13.0.0-------------------------* Added support for the `osage` and `patchwork` visualisation tools,-  available as of Graphviz-2.28.0.--* Updated attributes as of Graphviz-2.28.0:--    - `SVG` colors are now supported, and the support for different-      colors has been revamped.--    - `overlap=false` is now equivalent to `overlap=prism` and the-      `RemoveOverlaps` option has been removed.--    - `LabelScheme` and `Rotation` are new attributes for use with-      `sfdp`.--    - `Scale` is a new attribute for use with `twopi`.--    - Add new italics, bold, underline, superscript and subscript-      options for HTML-like labels.--    - `LHeight` and `LWidth` for getting the height and width of the-      root graph and clusters.--* Updated attributes from the current development branch of Graphviz-  (i.e. 2.29.*).  Please note that these will probably not work yet,-  but are implemented now for future-proofing.--    - A new style for edges: `Tapered`.--    - `XLabel` allows you to specify labels external to a node or-      edge.  `ForceLabels` allow you to specify that these should be-      drawn even when they will cause overlaps.--    - `ImagePath` allows you to specify where to search for images.--    - HTML-like labels now support `ID` values as well as horizontal-      and vertical rules.--    - `BgColor` and `FillColor` now take a list of colors: this allows-      gradient fills for graphs, clusters and nodes.  The `Radial`-      style and `GradientAngle` are also used for this purpose.--    - `FillColor` is now used by edges to set the color of any arrows.--    - [WebP](http://en.wikipedia.org/wiki/WebP) output support added.--* Other attribute changes:--    - Use a specified data type for the `Ordering` attribute rather-      than an arbitrary `Text` value, and provide a documented wrapper-      in `Data.GraphViz.Attributes`.--    - `Bb` has been renamed `BoundingBox`.--    - `ID` now only takes `EscString` (a type alias for `Text`) values-      rather than arbitrary `Label`s.--    - The `Data.GraphViz.Attributes.HTML` module has had all values-      re-named and is now meant to be imported qualified.  It is also-      no longer re-exported from `Data.GraphViz.Attributes.Complete`.--* The `ToGraphID` class provides a common wrapper to help create-  cluster identifiers, etc.--* Cabal's `Test-Suite` functionality is now used.  As part of this,-  the `Data.GraphViz.Testing` module and sub-modules are no longer-  exported by the library.--* The new `Benchmark` support in Cabal-1.14 is now used for the-  benchmark script.--* Dropped support for base-3.--* The `Data.GraphViz.State` module is no longer exposed, as there's no-  need for users to use it.--* Bugfixes:--    - Some corner cases in canonicalisation prevented it from being-      idempotent.--    - The `TestParsing` script will no longer crash and refuse to-      continue if an IO-based error (e.g. unable to successfully call-      `dot`) occurs.--    - A typo was spotted by **Gabor Greif**.--Changes in 2999.12.0.4-------------------------* Parsing error messages have been cleared up, especially when parsing-  Dot graphs.  This came about from trying to help **Uri J. Braun**-  with an error in his code (which took a while to diagnose as a-  problem with the node type).--* Made more clear to people looking in `Data.GraphViz` who want to-  create Dot graphs by hand to look in `Data.GraphViz.Types` (came-  about when **Rustom Mody** stated he got confused trying to work out-  how to do this).--* Fixed up augmentation; bug and fix spotted by **Max Rabkin**.--* Fix up the TestParsing script to actually use the new type setup.-  It can also now take a single directory as an argument, and will try-  to parse all (non-recursive) files in that directory.--Changes in 2999.12.0.3-------------------------* Fixes various mistakes in the Haddock documentation that slipped-  through (either in the `String -> Text` conversion or adding new-  modules and not checking their documentation thoroughly enough).--Changes in 2999.12.0.2-------------------------* Forgot to explicitly list the module for Arbitrary instance for the-  graph representation.--Changes in 2999.12.0.1-------------------------* Fix a bug that prevented graphviz from being built with GHC 7.2.--Changes in 2999.12.0.0-------------------------Many large-level changes were done in this release; in rough-categories these are:--### Conversions from other types--* Can now more easily create Dot graphs from other graph-like data-  structures with the new `graphElemsToDot` function, which takes a-  list of nodes and edges.--* It is now no longer possible to use `graphToDot`, etc. to create Dot-  graphs with anonymous clusters; all clusters must now have explicit-  names (note that uniqueness is not enforced, and it is still-  possible to directly create Dot graphs with anonymous clusters).--### Dot graph representations--* The canonical graph representation has been moved to its own module:-  `Data.GraphViz.Types.Canonical`.--* The generalised representation has had all its "G" and "g" prefixes-  removed.--* Two new representations:--    - `Data.GraphViz.Types.Graph` allows graph-like manipulation of-      Dot code.--    - `Data.GraphViz.Types.Monadic` provides a monadic interface into-      building relatively static graphs, based upon the-      [_dotgen_](http://hackage.haskell.org/package/dotgen) library by-      Andy Gill.--* The `DotRepr` class has been expanded, and three pseudo-classes have-  been provided to reduce type-class contexts in type signatures.--### Using and manipulation Dot graphs--* Pure Haskell implementations of `dot -Tcanon` and `tred` are-  available in `Data.GraphViz.Algorithms`.--* A new module is available for more direct low-level I/O with Dot-  graphs, including the ability to run custom commands as opposed to-  being limited to the standard dot, neato, etc.--### Attributes--* `Data.GraphViz.Attributes` now contains a slimmed-down recommended-  list of attributes; the complete list can still be found in-  `Data.GraphViz.Attributes.Complete`.--* The `charset` attribute is no longer available.--* Functions for specifying custom attributes (for pre-processors,-  etc.) are available.--### Implementation--* Now uses [`Text`](http://hackage.haskell.org/package/text) values-  rather than `String`s.  Whilst performing this migration, the-  improvements in speed for both printing and parsing improved-  dramatically.--    - As part of this, human-readable Dot code is now produced by-      default.  As such, the `prettyPrint` and `prettyPrint'`-      functions have been removed.--* Now uses state-based printing and parsing, so that things like graph-  directedness, layer separators and color schemes can be taken into-  account.--* Parsing large data-types (e.g. `Attributes`) now uses less-  back-tracking.--* Now has a benchmarking script for testing printing and parsing-  speed.--* Uses a custom exception type rather than a mish-mash of error,-  `Maybe`, `Either`, exception types from used libraries, etc.--* Usage of UTF-8 is now enforced when doing I/O.  If another encoding-  is required, the `Text` value that's printed/parsed has to be-  written/read from disk/network/etc. manually.--### Bug-Fixes--* The `Rects` `Attribute` should be able to take a list of `Rect`-  values; error spotted by **Henning Gunther**.--* In some cases, global attribute names were being printed without-  even an empty list (which doesn't match what dot, etc. expect).--Changes in 2999.11.0.0-------------------------* Addition of the `Labellable` class (and its method `toLabel`) to-  make it easier to construct labels.--* Backslashes (i.e. the `\` character) are now escaped/unescaped-  properly (bug spotted by **Han Joosten**).  As part of this:--    - Dot-specific escapes such as `\N` are now also handled-      correctly, so the slash does not need to be escaped.--    - Newline (`'\n'`) characters in labels, etc. are escaped to-      centred-newlines in Dot code, but not unescaped.--* `Point` values can now have the optional third dimension and end in-  a `!` to indicate that that position should be used (as input to-  Graphviz).--* `LayerList` uses `LayerID` values, and now has a proper `shrink`-  implementation in the test suite.--Changes in 2999.10.0.1-------------------------* Fixed a mistake in one of the source files that was made just to-  make-  [haskell-src-exts](http://hackage.haskell.org/package/haskell-src-exts)-  happier.--* Fix the `Arbitrary` instance for `Point` in the testsuite (since-  there's only one constructor now).--Changes in 2999.10.0.0-------------------------* Conversion of `FGL`-style graphs to `DotRepr` values is now achieved-  using the new `GraphvizParams` configuration type.  This allows us-  to define a single parameter that stores all the conversion-  functions to pass around rather than having to pass around several-  functions.  This also allows all the non-clustered and clustered-  functions to be collapsed together, whereas what used to be handled-  by the primed functions is now achieved by using the-  `setDirectedness` function.--    There are three default `GraphvizParams` available:--    - `defaultParams` provides some sensible defaults (no attributes-      or clustering).--    - `nonClusteredParams` is an alias of `defaultParams` where the-      clustering type is explicitly set to be `()` for cases where you-      don't want any clustering at all (whereas `defaultParams` allows-      you to set your own clustering functions).--    - `blankParams` sets all fields to be `undefined`; this is useful-      for situations where you have functions that will set some-      values for you and there is no sensible default you can use-      (mainly for the clustering function).--* Expansion of the `DotRepr` class:--    - More common functions are now defined as methods (`getID`,-      etc.).--    - The ability to get more information about the structure of the-      `DotRepr` graph, as well as where all the `DotNode`s are, etc.--    - `graphNodes` now returns `DotNode`s defined only as part of-      `DotEdge`s, and will also merge duplicate `DotNode`s together.--    - `graphNodes` and `graphEdges` also return `GlobalAttributes`-      that apply to them.--* The `Point` type now only has one constructor: `Point Double-  Double`.  The `Int`-only constructor was present due to historical-  purposes and I thought that the `Pos` value for a `DotNode` would-  always be a pair of `Int`s; this turns out not to be the case.--* `SortV` and `PrismOverlap` now only take `Word16` values rather than-  `Int`s, as they're not meant to allow negative values (the choice of-  using `Word16` rather than `Word` was arbitrary, and because it's-  unlikely those values will be large enough to require the larger-  values available in `Word`).--* `NodeCluster` has been generalised to not have to take an `LNode`-  for the node type; the type alias `LNodeCluster` is available if you-  still want this.--* Several documentation typos fixed, including one spotted by **Kevin-  Quick**.--* The test-suite now allows running individual tests.--Changes in 2999.9.0.0------------------------* graphviz now has an FAQ and an improved README as well as its own-  [homepage](http://projects.haskell.org/graphviz/).--* Canonicalisation of `DotRepr` values is now available with the-  `canonicalise` function.--* Add support for record labels; values are automatically-  escaped/unescaped.  The `Record` and `MRecord` shapes have been-  added for use with these labels.  **Requested by Minh Thu and Eric-  Kow.**--* Add support for HTML-like values (this replaces the wrong and-  completely broken URL datatype).  Strings are automatically-  escaped/unescaped.--* Named `PortPos` values are now accepted (as required for record and-  HTML-like labels).--* `GraphID` no longer allows HTML-like values (since Graphviz doesn't-  seem to allow it).--* `RankSep` takes a list of `Double` values as required.--* `Attribute` has a new constructor `UnknownAttribute` for use when-  parsing deprecated Graphviz attributes in old Dot code.--* Various parsing fixes; of special note:--    - Statements no longer need to end in a semi-colon;--    - Anonymous sub-graphs are now supported.--    - Edge statements can now handle node groupings (e.g. ` a -> {b-      c}`) as well as `portPos` values (e.g. `a:from -> b:to`).--    - Unquoted `String`s containing non-ASCII characters are now-      parsed properly (though they are assumed to be encoded with-      UTF-8).  **Thanks to Jules Bean (aka quicksilver) for working-      out how to do this.**--    More specifically: almost all Dot files that ship with Graphviz, as-    documentation in the Linux kernel, etc. are now parseable.--* A new script to assist in testing whether "real-world" Dot graphs-  are parseable.--* Slight performance increase when parsing: whereas parsing is done-  case-insensitively, the "correct" case is now checked by default-  which has a moderate affect on parsing times.--* Split lines are now able to be handled when parsing.--Changes in 2999.8.0.0------------------------* Added support for generalised `DotGraph`s; this optional-  representation removes the restriction of ordering of Dot-  statements.  This allows for greater flexibility of how to specify-  Dot code.  As an offshoot from this, most relevant functions now-  utilise a new `DotRepr` class that work with both `DotGraph`s and-  the new `GDotGraph`s; this shouldn't affect any code already in use.--* With the **prompting of Noam Lewis**, the augmentation functions-  have been revamped in two ways:--  - Now contains support for multiple edges.--  - The ability to perform "manual" augmentation if greater control is-    desired.--* Add a preview function to quickly render and visualise an `FGL`-  graph using the `Xlib` canvas.--* Added a pseudo-inverse of the `FGL -> Dot` functions (a graph is-  created, but the original node and edge labels are unrecoverable).--* The `Printing` and `Parsing` modules have been moved (from-  `Data.GraphViz.Types` to `Data.GraphViz`).--* Reworked file-generating commands such that they return the filename-  of the created file if successful.--Changes in 2999.7.0.0------------------------* Updated and extended functions to interact with the Graphviz tools.-  This now includes:--  - a better listing of available output types;--  - distinguishing file outputs from canvas outputs;--  - ability to automatically add the correct file extension to file-    outputs--  - Return any errors if calling Graphviz failed rather than just-    printing them to stderr--* Improved `Color` support:--  - fixed `ColorScheme` values--  - explicitly named `X11` colors--  - conversion to/from values from the [colour] library--  [colour]: http://www.haskell.org/haskellwiki/Colour--* Removed `OrientationGraph`; problems with distinguishing it when-  parsing from node-based `Orientation` values; its functionality is-  duplicated by `Rotate`.--* By default, the generated Dot code is now no longer indented; you-  can now use the `prettyPrint` functions in `Data.GraphViz` to-  produce readable Dot code.--* Added a testsuite; this is buildable by building with-  `--flags-test`.  Numerous printing and parsing bugs were picked up-  with this.--Changes in 2999.6.0.0------------------------* Remove some `Shape` aliases and change capitalisation of others.--* Properly parse and print IDs of clusters.--* Allow `NodeCluster` values to have node types different from the-  `LNode` they come from.--Changes in 2999.5.1.1------------------------* When used as labels, etc., the Dot keywords `node`, `edge`, `graph`,-  `digraph`, `subgraph`, and `strict` need to be quoted.  **Spotted by-  Kathleen Fisher.**--Changes in 2999.5.1.0------------------------* Potentially fixed the `graphvizWithHandle` bug; correct approach-  **spotted by Nikolas Mayr**.--* Fixed up `Parsing` of various `Attribute` sub-values, especially-  `Point` and `Spline` (and hence `Pos`, which uses them).--* Pre-process out comments and join together multi-line strings before-  parsing.--* Properly parse `Doubles` like `".2"`.--Changes in 2999.5.0.0------------------------A major re-write occured; these are the highlights:--* Re-write parsing and printing of Dot code using the new `ParseDot`-  and `PrintDot` classes.  This should finally fix all quoting issues,-  as well as leaving `Show` as the code representation for hacking-  purposes.  As part of this, the `Data.GraphViz.ParserCombinators`-  module has been moved to `Data.GraphViz.Types.Parsing`.--* Re-write the various `Dot*` datatypes in `Data.GraphViz.Types`.-  Sub-graphs/clusters are now their own entity rather than being part-  of `DotNode` and the Node ID type is now a type parameter rather-  than being just `Int`.  Sub-graphs/clusters can now also be parsed.--* The various conversion functions in `Data.GraphViz` now come in two-  flavours: the unprimed versions take in a `Bool` indicating if the-  graph is directed or not; the primed versions attempt to-  automatically detect this.--* Add cluster support for the graph augmentation functions, **as-  requested by Nikolas Mayr**.--* Allow custom arrow types as supported by GraphViz; **as requested by-  Han Joosten**.--* Fixed a bug in HSV-style `Color` values where `Int` was used instead of-  `Double`; **spotted by Michael deLorimier**.--* Properly resolved the situation initially spotted by Neil Brown:-  Matthew Sackman was following Dot terminology for an edge `a -> b`-  when using _head_ for `b` and _tail_ for `a` (this is presumably-  because the head/tail of the arrow are at those nodes).  `DotEdge`-  now uses _from_ and _to_ avoid ambiguity; the various `Attribute`-  values still follow upstream usage.--Changes in 2999.1.0.2------------------------* Fix a bug **spotted by Srihari Ramanathan** where `Color` values-  were double-quoted.--Changes in 2999.1.0.1------------------------* The `Color` `Attribute` should take `[Color]`, not just a single-  `Color`.--Changes in 2999.1.0.0------------------------* Stop using `Either` for composite `Attributes` and use a custom-  type: this avoids problems with the `Show` instance.--Changes in 2999.0.0.0------------------------* Fixed a bug where the Show instance and read function for `DotEdge`-  had the from/to nodes the wrong way round.  This was not immediately-  noticed since the `Graph` to `DotGraph` functions created them the-  wrong way round, so for those users who only used these this was not-  apparent.  **Spotted by Neil Brown.**--* Greatly improved `Attribute` usage: almost all attributes are now-  covered with allowed values.--* Extend DotGraph to include whether a graph is strict or not and if-  it has an ID.  Also move the directedGraph field.--* Make `Dot` refer to the actual dot command and `DotArrow` refer to-  the `ArrowType` (rather than `DotCmd` and `Dot` as before).--* Make the `Data.GraphViz.ParserCombinators` module available to end-  users again, but not re-exported by `Data.GraphViz`; it has a-  warning message up the top not to be used.  It is there purely for-  documentative purposes.--* Use [extensible-exceptions] so that `base-3.x` is once again-  supported.--  [extensible-exceptions]: http://hackage.haskell.org/package/extensible-exceptions--* Follow the [Package Versioning Policy] rather than using dates for-  versions.--  [Package Versioning Policy]: http://www.haskell.org/haskellwiki/Package_versioning_policy---Changes in 2009.5.1----------------------* New maintainer: Ivan Lazar Miljenovic.--* Support `polyparse >= 1.1` (as opposed to `< 1.3`)--* Require `base == 4.*` (i.e. `GHC 6.10.*`) due to new exception handling.--* Include functions from [Graphalyze-0.5] for running GraphViz-  commands, etc.--  [Graphalyze-0.5]: http://hackage.haskell.org/package/Graphalyze-0.5--* Module re-organisation.--* The `Data.GraphViz.ParserCombinators` module is no longer available-  to end users.--* Improved Haddock documentation.--Changes in 2008.9.20-----------------------* Differentiate between undirected and directed graphs (previously-  only directed graphs were supported).--* Clustering support was added.--Older versions-----------------For versions of graphviz older than `2008.9.20`, the exact differences-between versions is unknown.--<!---     Local Variables:-     mode:markdown-     End:-  -->
+ Changelog.md view
@@ -0,0 +1,1019 @@++Release History and Changelog+=============================++The following is information about what major changes have gone into+each release.++Changes in 2999.20.2.0+----------------------++* Metadata update.+* Relax QuickCheck upper boundary.++Changes in 2999.20.2.0+----------------------++* Add `PrintDot` instances for `Word32` and `Word64`.+* Dependency bumps.++Changes in 2999.20.1.0+----------------------++* Add `MonadFix` instance for `DotM` (thanks to **George Wilson**)++* Fix exception catching for missing executables (thanks to **Kostas+  Dermentzis**)++* Dependency bumps.++Changes in 2999.20.0.4+----------------------++* Dependency bumps.++Changes in 2999.20.0.3+----------------------++* Dependency bumps.++Changes in 2999.20.0.2+----------------------++* Fix Haddock issue (thanks to **Moritz Kiefer**)++* Bump HSpec upper bound (thanks to **Moritz Kiefer**)++* Make Hackage happier with Cabal-Version field++Changes in 2999.20.0.1+----------------------++* Allow building with temporary-1.3.*.++Changes in 2999.20.0.0+----------------------++* Can now create subgraphs using the Monadic representation.++* Allow unescaped `-` and `'` in HTML labels (thanks to **Andrey+  Kartashov**)++* Support for strict `Text` instances for printing/parsing.++* Creating a Graph representation with `mkGraph` was not adding edges+  correctly (reported by **Joshua Chia**).++* Test suite now uses HSpec, making it a lot easier to add tests for+  specific issues.++* Builds with GHC 8.4.* (thanks to **Tony Day**).++* Monoid and Semigroup instances for Monadic representation (thanks to+  **Chris Martin**).++* Be more lenient in parsing some attributes (e.g. allow `top` instead+  of just `t` for `VerticalPlacement`).++* Add new HTML attributes: `Columns`, `GradientAngle`, `Rows`, `Sides`+  and `Style`.++* Improve/update the TestParsing executable to work on being able to+  parse all the sample `Dot` graphs shipped with Graphviz.++* Bump dependencies.++Changes in 2999.19.0.0+----------------------++* Roll back change in 2999.18.1.0 for Monadic graphs, as they turn out+  to not actually work in practice (reported by **Lennart Spitzner**).++* Add a `quickParams` value to help with testing graphs in ghci+  (requested by **Ian Jeffries**).++* Fix parsing of edge chains (reported by **Jonas Collberg**).++* Fix how seemingly numeric text literals are quoted (reported by+  **Joey Hess**).++Changes in 2999.18.1.2+----------------------++* Allow dlist-0.8, thanks to **Sean Leather**.++* Properly allow QuickCheck-2.9.++Changes in 2999.18.1.1+----------------------++* Bump allowed version of QuickCheck for the test suite.++Changes in 2999.18.1.0+----------------------++* Monadic graphs can now have edges to and from lists of nodes, as+  requested by **Harold Carr**.++* Compatible with GHC-8.* pre-releases.++    - Please note that there is currently a warning emitted on+      compilation by GHC-8.*; this has been reported+      [here](https://ghc.haskell.org/trac/ghc/ticket/11822).++Changes in 2999.18.0.2+----------------------++* Match new behaviour of `dot`, etc. in supporting edge specifications+  like `a, b -> c, d` (spotted by **Dilawar Singh**).++Changes in 2999.18.0.1+----------------------++* Loosened bound on `fgl-arbitrary`.++Changes in 2999.18.0.0+----------------------++* Now builds on GHC 7.10.*.++* Attribute changes:++    - Added the `NoTranslate` attribute.++    - Add support for overlines in HTML labels.++    Both of these are available as of Graphviz 2.38.0, but were+    somehow overlooked in previous releases of this library.++* Uses new `fgl-arbitrary` library for testing rather than custom+  instances for FGL graphs.++* Migrated to git; central repository now on+  [GitHub](https://github.com/ivan-m/graphviz).++Changes in 2999.17.0.2+----------------------++* Augmentation tests are no longer run by default.  This avoids+  problems where Graphviz is not installed/configured properly.++* Use `.gv` for temporary files instead of `.dot`.++Changes in 2999.17.0.1+----------------------++* Allow usage of `transformers-0.4.*`, by **Sergei Trofimovich**.++Changes in 2999.17.0.0+----------------------++* Add support for Graphviz 2.32.0, 2.32.1, 2.34.0, 2.36.0 and 2.38.0:++    - **WARNING**: at least as of Graphviz-2.32.0, `dot -Tcanon` no+      longer produces Dot code that is in the format expected by the+      Canonical Dot representation in this library.  As such, unless+      you're very sure of your sources you should _always_ use the+      Generalised representation for parsing (see also the new+      `FromGeneralisedDot` class mentioned below).++    - New attributes:++        + `XDotVersion` (as of 2.34.0)++        + `InputScale` (as of 2.36.0)++        + `OverlapShrink` (as of 2.36.0)++    - Changed attributes:++        + `Aspect` no longer available (as of 2.36.0)++        + New `ModeType` values for use with `sfdp`: `SpringMode` and+          `MaxEnt`.++        + `Weight` now takes a value of type `Number`, that explicitly+          distinguishes between `Doubles` and `Ints`.++        + `FixedSize` and `Normalize` now have their own types.++        + New `Shape`s: `Star` and `Underline` (as well as `Square`+          which seems to have been omitted from previous versions).++    - Other relevant changes:++        + `XDot` now takes an optional version.  Note that this+          doesn't have any effect on how _graphviz_ works.++        + The default extension for Dot-graphs is now `.gv` rather+          than `.dot` to reflect Graphviz's changed conventions.++* Other changes to the API:++    - Add the `FromGeneralisedDot` class, which provides a+      semi-inverse to `fromCanonical` in `DotRepr`.++    - `GraphID` now uses `Number` rather than separate `Int` and+      `Double` constructors; this only matters if you manually+      constructed or de-constructed `GraphID` values (`ToGraphID`+      still works).++    - Add the ability to parse a Dot graph "liberally": that is, if an+      `Attribute` doesn't match the specification, then let it fall+      back to an `UnknownAttribute`.  This is still experimental, and+      requires more manual usage than the in-built commands (e.g. it+      isn't supported in the default round-tripping).++    - Now using the definition of `bracket` from `polyparse >= 1.9`.++    - Monadic representation now has `Functor` and `Applicative`+      instances to satisfy the up-coming changes in GHC 7.10.++* Compilation time has been reduced in two ways:++    - The `Data.GraphViz.Attributes.Complete` module has been split up+      (but still exports the same API, so no need to import more+      modules).  Whilst I haven't measured it, this should also reduce+      memory requirements for compilation.++    - The testsuite now uses the library explicitly, and thus no+      longer needs to re-compile half the library.++* Bug-fixes:++    - Double values are now longer parseable without double quotes if+      they have an exponential term (to better match the definition).++    - It is no longer assumed when round-tripping that `dot -Tdot`+      generates canonicalised Dot graphs.++* The `TestParsing` script is now directly buildable by Cabal using+  the `test-parsing` flag (the resulting executable is called+  `graphviz-testparsing`).  This is not made an actual test-suite as+  not all files found will be actual Dot graphs, and it's known that+  it fails on some.  Instead it's meant to be used as an indication of+  how well this library parses "real-world" Dot code.++Changes in 2999.16.0.0+----------------------++* Add support for Graphviz-2.30.0:++    - New attributes:++        + `Area`+        + `Head_LP`+        + `LayerListSep`+        + `LayerSelect`+        + `Tail_LP`+        + `XLP`++    - `BgColor`, `Color` and `FillColor` now take a list of colors+      with optional weightings.++    - Layer handling now supports layer sub-ranges.++    - Added the voronoi-based option to `Overlap`.++    - Added the `Striped` and `Wedged` styles.++* Updates to attributes and their values:++    - The following attributes have had their values changed to better+      reflect what they represent:++        + `FontPath` takes a `Path` value.++        + `Layout` takes a `GraphvizCommand` (and thus+          `GraphvizCommand` has been moved to+          `Data.GraphViz.Attributes.Complete`).++    - Added `MDS` to `Model` (which had somehow been overlooked).++    - Various attributes now have defaults added/updated/removed if+      wrong.++    - Removed the following deprecated attributes:++        + `ShapeFile`++        + `Z`++* Now any value that has a defined default can be parsed when the Dot+  code just has `attribute=""` (which `dot -Tcanon` is fond of doing+  to "reset" attributes).++* `GraphvizCommand` now defines `Sfdp` (which had somehow been+  overlooked up till now).++* The `canonicalise` and related functions have been re-written;+  whilst there might be some cases where their behaviour does not+  fully match how `dot -Tcanon` and `tred` behave (due to the+  interaction of various attributes), the new implementation is much+  more sane.++* Use temporary files rather than pipes when running dot, etc.++    Makes it more portable, and also avoids issues where dot, etc. use+    100% CPU when a graph is passed in via stdin.++    Original patch by **Henning Thielemann**.++* `renderCompactDot` now outputs to just one line (which means it's+  shorter, but more difficult to read for a human).++* The QuickCheck instances are a bit smarter now to avoid having such+  ugly huge outputs when a test fails.++* More documentation to help you understand what certain data types+  are for, etc.++Changes in 2999.15.0.1+----------------------++* Fixed bug where `canonicalise` and related functions did not+  properly deal with attributes of a single node or edge within a+  sub-graph.++Changes in 2999.15.0.0+----------------------++* The repository is now hosted on+  [hub.darcs.net](http://hub.darcs.net/ivanm/graphviz), and using the+  bug-tracker there.++* Updates to various `Attribute` definitions:++    - The list of available shapes has been expanded to take into+      account the new synthetic biology shapes.++    - The `Size` and `FontNames` attributes now have specified data types.++    - The optional start and end points for `Spline`s were previously+      the wrong way round; this has now been fixed.++    - Explicitly only print 2-dimensional `Point` values for `Rect`+      and `DPoint` (previously only 2-dimensional values where parsed,+      but it was possible to print a 3-dimensional value).++    - HTML-like labels previously disallowed empty textual label+      components when parsing; spotted by **Daniel Hummel**.++* `GraphvizParams` now lets you specify whether a "cluster" is+  actually a cluster or a sub-graph.  Requested by **Gabor Greif**.++* Fixed an error where printing edges whose attributes contained a+  `ColorScheme` attribute, that attribute would stay in the state and+  the old color scheme would override the _parent's_ state.++* Previously, some malformed attributes were accepted when being+  parsed as they silently became parsed as an `UnknownAttribute`.+  Now, attributes where the attribute name and the equal sign are+  successfully parsed **but** the value of the attribute is _not_+  successfully parse will throw an unrecoverable error.++    **Note**: this does mean that some Dot graphs that are accepted by+    Graphviz (as they separate tokenizing from parsing; as such+    something like `"0.1"` is successfully accepted as an integer,+    specifically `0`) are no longer accepted when parsing them in.++* Miscellaneous parsing improvements:++    - Whilst not specified anywhere, Graphviz seems to treat empty+      quotes as values for attributes expecting a number as their+      default; as such, this is now taken into account when parsing.++    - `DPoint` values can now parse an optional `+` prefix.++    - Whitespaces after commas in HSV colors are now accepted.++* Error messages from parsing are improved to help you track down+  where the parsing error occurred (in that it's easier to find which+  attribute failed to parse, etc.).++* Some parsing combinators are no longer publicly accessible, but+  shouldn't be needed by end users anyway (as they were there for+  parsing the Attribute data type).++Changes in 2999.14.1.0+----------------------++* Add `isGraphvizInstalled` and `quitWithoutGraphviz` for programs to+  test whether Graphviz has been installed (as previous attempts at+  doing so via actual calls to dot, neato, etc. weren't working and+  would be too verbose anyway).++Changes in 2999.14.0.0+----------------------++* Added an instance of `Labellable` for strict `Text` values, as+  requested by **Erik Rantapaa**.++Changes in 2999.13.0.3+----------------------++* Allow usage of transformers-0.3.*.  Spotted by **Peter Simons**.++Changes in 2999.13.0.2+----------------------++* The `String` instance for `ToGraphID` requires the+  `TypeSynonymInstances` pragma (at least on GHC < 7.4).  Spotted by+  **Gregory Guthrie**.++Changes in 2999.13.0.1+----------------------++* Fixed Haddock typos.++Changes in 2999.13.0.0+----------------------++* Added support for the `osage` and `patchwork` visualisation tools,+  available as of Graphviz-2.28.0.++* Updated attributes as of Graphviz-2.28.0:++    - `SVG` colors are now supported, and the support for different+      colors has been revamped.++    - `overlap=false` is now equivalent to `overlap=prism` and the+      `RemoveOverlaps` option has been removed.++    - `LabelScheme` and `Rotation` are new attributes for use with+      `sfdp`.++    - `Scale` is a new attribute for use with `twopi`.++    - Add new italics, bold, underline, superscript and subscript+      options for HTML-like labels.++    - `LHeight` and `LWidth` for getting the height and width of the+      root graph and clusters.++* Updated attributes from the current development branch of Graphviz+  (i.e. 2.29.*).  Please note that these will probably not work yet,+  but are implemented now for future-proofing.++    - A new style for edges: `Tapered`.++    - `XLabel` allows you to specify labels external to a node or+      edge.  `ForceLabels` allow you to specify that these should be+      drawn even when they will cause overlaps.++    - `ImagePath` allows you to specify where to search for images.++    - HTML-like labels now support `ID` values as well as horizontal+      and vertical rules.++    - `BgColor` and `FillColor` now take a list of colors: this allows+      gradient fills for graphs, clusters and nodes.  The `Radial`+      style and `GradientAngle` are also used for this purpose.++    - `FillColor` is now used by edges to set the color of any arrows.++    - [WebP](http://en.wikipedia.org/wiki/WebP) output support added.++* Other attribute changes:++    - Use a specified data type for the `Ordering` attribute rather+      than an arbitrary `Text` value, and provide a documented wrapper+      in `Data.GraphViz.Attributes`.++    - `Bb` has been renamed `BoundingBox`.++    - `ID` now only takes `EscString` (a type alias for `Text`) values+      rather than arbitrary `Label`s.++    - The `Data.GraphViz.Attributes.HTML` module has had all values+      re-named and is now meant to be imported qualified.  It is also+      no longer re-exported from `Data.GraphViz.Attributes.Complete`.++* The `ToGraphID` class provides a common wrapper to help create+  cluster identifiers, etc.++* Cabal's `Test-Suite` functionality is now used.  As part of this,+  the `Data.GraphViz.Testing` module and sub-modules are no longer+  exported by the library.++* The new `Benchmark` support in Cabal-1.14 is now used for the+  benchmark script.++* Dropped support for base-3.++* The `Data.GraphViz.State` module is no longer exposed, as there's no+  need for users to use it.++* Bugfixes:++    - Some corner cases in canonicalisation prevented it from being+      idempotent.++    - The `TestParsing` script will no longer crash and refuse to+      continue if an IO-based error (e.g. unable to successfully call+      `dot`) occurs.++    - A typo was spotted by **Gabor Greif**.++Changes in 2999.12.0.4+----------------------++* Parsing error messages have been cleared up, especially when parsing+  Dot graphs.  This came about from trying to help **Uri J. Braun**+  with an error in his code (which took a while to diagnose as a+  problem with the node type).++* Made more clear to people looking in `Data.GraphViz` who want to+  create Dot graphs by hand to look in `Data.GraphViz.Types` (came+  about when **Rustom Mody** stated he got confused trying to work out+  how to do this).++* Fixed up augmentation; bug and fix spotted by **Max Rabkin**.++* Fix up the TestParsing script to actually use the new type setup.+  It can also now take a single directory as an argument, and will try+  to parse all (non-recursive) files in that directory.++Changes in 2999.12.0.3+----------------------++* Fixes various mistakes in the Haddock documentation that slipped+  through (either in the `String -> Text` conversion or adding new+  modules and not checking their documentation thoroughly enough).++Changes in 2999.12.0.2+----------------------++* Forgot to explicitly list the module for Arbitrary instance for the+  graph representation.++Changes in 2999.12.0.1+----------------------++* Fix a bug that prevented graphviz from being built with GHC 7.2.++Changes in 2999.12.0.0+----------------------++Many large-level changes were done in this release; in rough+categories these are:++### Conversions from other types++* Can now more easily create Dot graphs from other graph-like data+  structures with the new `graphElemsToDot` function, which takes a+  list of nodes and edges.++* It is now no longer possible to use `graphToDot`, etc. to create Dot+  graphs with anonymous clusters; all clusters must now have explicit+  names (note that uniqueness is not enforced, and it is still+  possible to directly create Dot graphs with anonymous clusters).++### Dot graph representations++* The canonical graph representation has been moved to its own module:+  `Data.GraphViz.Types.Canonical`.++* The generalised representation has had all its "G" and "g" prefixes+  removed.++* Two new representations:++    - `Data.GraphViz.Types.Graph` allows graph-like manipulation of+      Dot code.++    - `Data.GraphViz.Types.Monadic` provides a monadic interface into+      building relatively static graphs, based upon the+      [_dotgen_](http://hackage.haskell.org/package/dotgen) library by+      Andy Gill.++* The `DotRepr` class has been expanded, and three pseudo-classes have+  been provided to reduce type-class contexts in type signatures.++### Using and manipulation Dot graphs++* Pure Haskell implementations of `dot -Tcanon` and `tred` are+  available in `Data.GraphViz.Algorithms`.++* A new module is available for more direct low-level I/O with Dot+  graphs, including the ability to run custom commands as opposed to+  being limited to the standard dot, neato, etc.++### Attributes++* `Data.GraphViz.Attributes` now contains a slimmed-down recommended+  list of attributes; the complete list can still be found in+  `Data.GraphViz.Attributes.Complete`.++* The `charset` attribute is no longer available.++* Functions for specifying custom attributes (for pre-processors,+  etc.) are available.++### Implementation++* Now uses [`Text`](http://hackage.haskell.org/package/text) values+  rather than `String`s.  Whilst performing this migration, the+  improvements in speed for both printing and parsing improved+  dramatically.++    - As part of this, human-readable Dot code is now produced by+      default.  As such, the `prettyPrint` and `prettyPrint'`+      functions have been removed.++* Now uses state-based printing and parsing, so that things like graph+  directedness, layer separators and color schemes can be taken into+  account.++* Parsing large data-types (e.g. `Attributes`) now uses less+  back-tracking.++* Now has a benchmarking script for testing printing and parsing+  speed.++* Uses a custom exception type rather than a mish-mash of error,+  `Maybe`, `Either`, exception types from used libraries, etc.++* Usage of UTF-8 is now enforced when doing I/O.  If another encoding+  is required, the `Text` value that's printed/parsed has to be+  written/read from disk/network/etc. manually.++### Bug-Fixes++* The `Rects` `Attribute` should be able to take a list of `Rect`+  values; error spotted by **Henning Gunther**.++* In some cases, global attribute names were being printed without+  even an empty list (which doesn't match what dot, etc. expect).++Changes in 2999.11.0.0+----------------------++* Addition of the `Labellable` class (and its method `toLabel`) to+  make it easier to construct labels.++* Backslashes (i.e. the `\` character) are now escaped/unescaped+  properly (bug spotted by **Han Joosten**).  As part of this:++    - Dot-specific escapes such as `\N` are now also handled+      correctly, so the slash does not need to be escaped.++    - Newline (`'\n'`) characters in labels, etc. are escaped to+      centred-newlines in Dot code, but not unescaped.++* `Point` values can now have the optional third dimension and end in+  a `!` to indicate that that position should be used (as input to+  Graphviz).++* `LayerList` uses `LayerID` values, and now has a proper `shrink`+  implementation in the test suite.++Changes in 2999.10.0.1+----------------------++* Fixed a mistake in one of the source files that was made just to+  make+  [haskell-src-exts](http://hackage.haskell.org/package/haskell-src-exts)+  happier.++* Fix the `Arbitrary` instance for `Point` in the testsuite (since+  there's only one constructor now).++Changes in 2999.10.0.0+----------------------++* Conversion of `FGL`-style graphs to `DotRepr` values is now achieved+  using the new `GraphvizParams` configuration type.  This allows us+  to define a single parameter that stores all the conversion+  functions to pass around rather than having to pass around several+  functions.  This also allows all the non-clustered and clustered+  functions to be collapsed together, whereas what used to be handled+  by the primed functions is now achieved by using the+  `setDirectedness` function.++    There are three default `GraphvizParams` available:++    - `defaultParams` provides some sensible defaults (no attributes+      or clustering).++    - `nonClusteredParams` is an alias of `defaultParams` where the+      clustering type is explicitly set to be `()` for cases where you+      don't want any clustering at all (whereas `defaultParams` allows+      you to set your own clustering functions).++    - `blankParams` sets all fields to be `undefined`; this is useful+      for situations where you have functions that will set some+      values for you and there is no sensible default you can use+      (mainly for the clustering function).++* Expansion of the `DotRepr` class:++    - More common functions are now defined as methods (`getID`,+      etc.).++    - The ability to get more information about the structure of the+      `DotRepr` graph, as well as where all the `DotNode`s are, etc.++    - `graphNodes` now returns `DotNode`s defined only as part of+      `DotEdge`s, and will also merge duplicate `DotNode`s together.++    - `graphNodes` and `graphEdges` also return `GlobalAttributes`+      that apply to them.++* The `Point` type now only has one constructor: `Point Double+  Double`.  The `Int`-only constructor was present due to historical+  purposes and I thought that the `Pos` value for a `DotNode` would+  always be a pair of `Int`s; this turns out not to be the case.++* `SortV` and `PrismOverlap` now only take `Word16` values rather than+  `Int`s, as they're not meant to allow negative values (the choice of+  using `Word16` rather than `Word` was arbitrary, and because it's+  unlikely those values will be large enough to require the larger+  values available in `Word`).++* `NodeCluster` has been generalised to not have to take an `LNode`+  for the node type; the type alias `LNodeCluster` is available if you+  still want this.++* Several documentation typos fixed, including one spotted by **Kevin+  Quick**.++* The test-suite now allows running individual tests.++Changes in 2999.9.0.0+---------------------++* graphviz now has an FAQ and an improved README as well as its own+  [homepage](http://projects.haskell.org/graphviz/).++* Canonicalisation of `DotRepr` values is now available with the+  `canonicalise` function.++* Add support for record labels; values are automatically+  escaped/unescaped.  The `Record` and `MRecord` shapes have been+  added for use with these labels.  **Requested by Minh Thu and Eric+  Kow.**++* Add support for HTML-like values (this replaces the wrong and+  completely broken URL datatype).  Strings are automatically+  escaped/unescaped.++* Named `PortPos` values are now accepted (as required for record and+  HTML-like labels).++* `GraphID` no longer allows HTML-like values (since Graphviz doesn't+  seem to allow it).++* `RankSep` takes a list of `Double` values as required.++* `Attribute` has a new constructor `UnknownAttribute` for use when+  parsing deprecated Graphviz attributes in old Dot code.++* Various parsing fixes; of special note:++    - Statements no longer need to end in a semi-colon;++    - Anonymous sub-graphs are now supported.++    - Edge statements can now handle node groupings (e.g. ` a -> {b+      c}`) as well as `portPos` values (e.g. `a:from -> b:to`).++    - Unquoted `String`s containing non-ASCII characters are now+      parsed properly (though they are assumed to be encoded with+      UTF-8).  **Thanks to Jules Bean (aka quicksilver) for working+      out how to do this.**++    More specifically: almost all Dot files that ship with Graphviz, as+    documentation in the Linux kernel, etc. are now parseable.++* A new script to assist in testing whether "real-world" Dot graphs+  are parseable.++* Slight performance increase when parsing: whereas parsing is done+  case-insensitively, the "correct" case is now checked by default+  which has a moderate affect on parsing times.++* Split lines are now able to be handled when parsing.++Changes in 2999.8.0.0+---------------------++* Added support for generalised `DotGraph`s; this optional+  representation removes the restriction of ordering of Dot+  statements.  This allows for greater flexibility of how to specify+  Dot code.  As an offshoot from this, most relevant functions now+  utilise a new `DotRepr` class that work with both `DotGraph`s and+  the new `GDotGraph`s; this shouldn't affect any code already in use.++* With the **prompting of Noam Lewis**, the augmentation functions+  have been revamped in two ways:++  - Now contains support for multiple edges.++  - The ability to perform "manual" augmentation if greater control is+    desired.++* Add a preview function to quickly render and visualise an `FGL`+  graph using the `Xlib` canvas.++* Added a pseudo-inverse of the `FGL -> Dot` functions (a graph is+  created, but the original node and edge labels are unrecoverable).++* The `Printing` and `Parsing` modules have been moved (from+  `Data.GraphViz.Types` to `Data.GraphViz`).++* Reworked file-generating commands such that they return the filename+  of the created file if successful.++Changes in 2999.7.0.0+---------------------++* Updated and extended functions to interact with the Graphviz tools.+  This now includes:++  - a better listing of available output types;++  - distinguishing file outputs from canvas outputs;++  - ability to automatically add the correct file extension to file+    outputs++  - Return any errors if calling Graphviz failed rather than just+    printing them to stderr++* Improved `Color` support:++  - fixed `ColorScheme` values++  - explicitly named `X11` colors++  - conversion to/from values from the [colour] library++  [colour]: http://www.haskell.org/haskellwiki/Colour++* Removed `OrientationGraph`; problems with distinguishing it when+  parsing from node-based `Orientation` values; its functionality is+  duplicated by `Rotate`.++* By default, the generated Dot code is now no longer indented; you+  can now use the `prettyPrint` functions in `Data.GraphViz` to+  produce readable Dot code.++* Added a testsuite; this is buildable by building with+  `--flags-test`.  Numerous printing and parsing bugs were picked up+  with this.++Changes in 2999.6.0.0+---------------------++* Remove some `Shape` aliases and change capitalisation of others.++* Properly parse and print IDs of clusters.++* Allow `NodeCluster` values to have node types different from the+  `LNode` they come from.++Changes in 2999.5.1.1+---------------------++* When used as labels, etc., the Dot keywords `node`, `edge`, `graph`,+  `digraph`, `subgraph`, and `strict` need to be quoted.  **Spotted by+  Kathleen Fisher.**++Changes in 2999.5.1.0+---------------------++* Potentially fixed the `graphvizWithHandle` bug; correct approach+  **spotted by Nikolas Mayr**.++* Fixed up `Parsing` of various `Attribute` sub-values, especially+  `Point` and `Spline` (and hence `Pos`, which uses them).++* Pre-process out comments and join together multi-line strings before+  parsing.++* Properly parse `Doubles` like `".2"`.++Changes in 2999.5.0.0+---------------------++A major re-write occured; these are the highlights:++* Re-write parsing and printing of Dot code using the new `ParseDot`+  and `PrintDot` classes.  This should finally fix all quoting issues,+  as well as leaving `Show` as the code representation for hacking+  purposes.  As part of this, the `Data.GraphViz.ParserCombinators`+  module has been moved to `Data.GraphViz.Types.Parsing`.++* Re-write the various `Dot*` datatypes in `Data.GraphViz.Types`.+  Sub-graphs/clusters are now their own entity rather than being part+  of `DotNode` and the Node ID type is now a type parameter rather+  than being just `Int`.  Sub-graphs/clusters can now also be parsed.++* The various conversion functions in `Data.GraphViz` now come in two+  flavours: the unprimed versions take in a `Bool` indicating if the+  graph is directed or not; the primed versions attempt to+  automatically detect this.++* Add cluster support for the graph augmentation functions, **as+  requested by Nikolas Mayr**.++* Allow custom arrow types as supported by GraphViz; **as requested by+  Han Joosten**.++* Fixed a bug in HSV-style `Color` values where `Int` was used instead of+  `Double`; **spotted by Michael deLorimier**.++* Properly resolved the situation initially spotted by Neil Brown:+  Matthew Sackman was following Dot terminology for an edge `a -> b`+  when using _head_ for `b` and _tail_ for `a` (this is presumably+  because the head/tail of the arrow are at those nodes).  `DotEdge`+  now uses _from_ and _to_ avoid ambiguity; the various `Attribute`+  values still follow upstream usage.++Changes in 2999.1.0.2+---------------------++* Fix a bug **spotted by Srihari Ramanathan** where `Color` values+  were double-quoted.++Changes in 2999.1.0.1+---------------------++* The `Color` `Attribute` should take `[Color]`, not just a single+  `Color`.++Changes in 2999.1.0.0+---------------------++* Stop using `Either` for composite `Attributes` and use a custom+  type: this avoids problems with the `Show` instance.++Changes in 2999.0.0.0+---------------------++* Fixed a bug where the Show instance and read function for `DotEdge`+  had the from/to nodes the wrong way round.  This was not immediately+  noticed since the `Graph` to `DotGraph` functions created them the+  wrong way round, so for those users who only used these this was not+  apparent.  **Spotted by Neil Brown.**++* Greatly improved `Attribute` usage: almost all attributes are now+  covered with allowed values.++* Extend DotGraph to include whether a graph is strict or not and if+  it has an ID.  Also move the directedGraph field.++* Make `Dot` refer to the actual dot command and `DotArrow` refer to+  the `ArrowType` (rather than `DotCmd` and `Dot` as before).++* Make the `Data.GraphViz.ParserCombinators` module available to end+  users again, but not re-exported by `Data.GraphViz`; it has a+  warning message up the top not to be used.  It is there purely for+  documentative purposes.++* Use [extensible-exceptions] so that `base-3.x` is once again+  supported.++  [extensible-exceptions]: http://hackage.haskell.org/package/extensible-exceptions++* Follow the [Package Versioning Policy] rather than using dates for+  versions.++  [Package Versioning Policy]: http://www.haskell.org/haskellwiki/Package_versioning_policy+++Changes in 2009.5.1+-------------------++* New maintainer: Ivan Lazar Miljenovic.++* Support `polyparse >= 1.1` (as opposed to `< 1.3`)++* Require `base == 4.*` (i.e. `GHC 6.10.*`) due to new exception handling.++* Include functions from [Graphalyze-0.5] for running GraphViz+  commands, etc.++  [Graphalyze-0.5]: http://hackage.haskell.org/package/Graphalyze-0.5++* Module re-organisation.++* The `Data.GraphViz.ParserCombinators` module is no longer available+  to end users.++* Improved Haddock documentation.++Changes in 2008.9.20+--------------------++* Differentiate between undirected and directed graphs (previously+  only directed graphs were supported).++* Clustering support was added.++Older versions+--------------++For versions of graphviz older than `2008.9.20`, the exact differences+between versions is unknown.
Data/GraphViz.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE   MultiParamTypeClasses, FlexibleContexts, OverloadedStrings #-}+{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, OverloadedStrings #-}  {- |    Module      : Data.GraphViz@@ -9,8 +9,8 @@     This is the top-level module for the graphviz library.  It provides    functions to convert 'Data.Graph.Inductive.Graph.Graph's into the-   /Dot/ language used by the /Graphviz/ suite of programs (as well as-   a limited ability to perform the reverse operation).+   /Dot/ language used by the /Graphviz/ suite of programs (as well as a+   limited ability to perform the reverse operation).     If you wish to construct a Haskell representation of a Dot graph    yourself rather than using the conversion functions here, please@@ -19,13 +19,14 @@     Information about Graphviz and the Dot language can be found at:    <http://graphviz.org/>-  -}+ module Data.GraphViz     ( -- * Conversion from graphs to /Dot/ format.       -- ** Specifying parameters.       -- $params       GraphvizParams(..)+    , quickParams     , defaultParams     , nonClusteredParams     , blankParams@@ -63,29 +64,33 @@     , module Data.GraphViz.Commands     ) where -import Data.GraphViz.Types-import Data.GraphViz.Types.Canonical( DotGraph(..), DotStatements(..)-                                    , DotSubGraph(..)) import Data.GraphViz.Algorithms.Clustering-import Data.GraphViz.Util(uniq, uniqBy) import Data.GraphViz.Attributes-import Data.GraphViz.Attributes.Complete(CustomAttribute, AttributeName-                                        , customAttribute, findSpecifiedCustom-                                        , customValue)+import Data.GraphViz.Attributes.Complete   (AttributeName, CustomAttribute,+                                            customAttribute, customValue,+                                            findSpecifiedCustom) import Data.GraphViz.Commands-import Data.GraphViz.Commands.IO(hGetDot)+import Data.GraphViz.Commands.IO           (hGetDot)+import Data.GraphViz.Internal.Util         (uniq, uniqBy)+import Data.GraphViz.Types+import Data.GraphViz.Types.Canonical       (DotGraph (..), DotStatements (..),+                                            DotSubGraph (..))+import Data.GraphViz.Types.Generalised     (FromGeneralisedDot (..)) -import Data.Graph.Inductive.Graph-import qualified Data.Set as Set-import Control.Arrow((&&&), first)-import Data.Maybe(mapMaybe, fromJust)-import qualified Data.Map as Map-import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)-import Control.Monad(liftM)-import System.IO.Unsafe(unsafePerformIO)-import Control.Concurrent(forkIO)+import           Control.Arrow              (first, (&&&))+import           Control.Concurrent         (forkIO)+import           Data.Graph.Inductive.Graph+import qualified Data.Map                   as Map+import           Data.Maybe                 (fromJust, mapMaybe)+import qualified Data.Set                   as Set+import           Data.Text.Lazy             (Text)+import qualified Data.Text.Lazy             as T+import           System.IO.Unsafe           (unsafePerformIO) +#if !(MIN_VERSION_base (4,8,0))+import Data.Functor ((<$>))+#endif+ -- -----------------------------------------------------------------------------  -- | Determine if the given graph is undirected.@@ -143,7 +148,7 @@      >   where      >     params = blankParams { globalAttributes = []      >                          , clusterBy        = clustBy-     >                          , clusterID        = Int+     >                          , clusterID        = Num . Int      >                          , fmtCluster       = clFmt      >                          , fmtNode          = const []      >                          , fmtEdge          = const []@@ -169,6 +174,11 @@ --   These correspond to 'LNode' and 'LEdge' in FGL graphs. -- --   The clustering in 'clusterBy' can be to arbitrary depth.+--+--   Note that the term \"cluster\" is slightly conflated here: in+--   terms of @GraphvizParams@ values, a cluster is a grouping of+--   nodes; the 'isDotCluster' function lets you specify whether it is+--   a cluster in the Dot sense or just a sub-graph. data GraphvizParams n nl el cl l      = Params { -- | @True@ if the graph is directed; @False@                 --   otherwise.@@ -179,6 +189,9 @@                 -- | A function to specify which cluster a particular                 --   node is in.               , clusterBy        :: ((n,nl) -> NodeCluster cl (n,l))+                -- | Is this \"cluster\" actually a cluster, or just a+                --   sub-graph?+              , isDotCluster     :: (cl -> Bool)                 -- | The name/identifier for a cluster.               , clusterID        :: (cl -> GraphID)                 -- | Specify which global attributes are applied in@@ -190,9 +203,19 @@               , fmtEdge          :: ((n,n,el) -> Attributes)               } + -- | An alias for 'NodeCluster' when dealing with FGL graphs. type LNodeCluster cl l = NodeCluster cl (Node,l) +-- | Especially useful for quick explorations in ghci, this is a "do+--   what I mean" set of parameters that prints the specified labels+--   of a non-clustered graph.+quickParams :: (Labellable nl, Labellable el) => GraphvizParams n nl el () nl+quickParams = nonClusteredParams { fmtNode = nodeFmt, fmtEdge = edgeFmt }+  where+    nodeFmt (_,l) = [toLabel l]+    edgeFmt (_,_,l) = [toLabel l]+ -- | A default 'GraphvizParams' value which assumes the graph is --   directed, contains no clusters and has no 'Attribute's set. --@@ -208,7 +231,8 @@ defaultParams = Params { isDirected       = True                        , globalAttributes = []                        , clusterBy        = N-                       , clusterID        = const (Int 0)+                       , isDotCluster     = const True+                       , clusterID        = const (Num $ Int 0)                        , fmtCluster       = const []                        , fmtNode          = const []                        , fmtEdge          = const []@@ -229,13 +253,14 @@ --   programmatically setting the clustering function (and as such do --   not know what the types might be). blankParams :: GraphvizParams n nl el cl l-blankParams = Params { isDirected       = undefined-                     , globalAttributes = undefined-                     , clusterBy        = undefined-                     , clusterID        = undefined-                     , fmtCluster       = undefined-                     , fmtNode          = undefined-                     , fmtEdge          = undefined+blankParams = Params { isDirected       = error "Unspecified definition of isDirected"+                     , globalAttributes = error "Unspecified definition of globalAttributes"+                     , clusterBy        = error "Unspecified definition of clusterBy"+                     , isDotCluster     = error "Unspecified definition of isDotCluster"+                     , clusterID        = error "Unspecified definition of clusterID"+                     , fmtCluster       = error "Unspecified definition of fmtCluster"+                     , fmtNode          = error "Unspecified definition of fmtNode"+                     , fmtEdge          = error "Unspecified definition of fmtEdge"                      }  -- | Determine if the provided 'Graph' is directed or not and set the@@ -271,8 +296,8 @@                      , nodeStmts = ns                      , edgeStmts = es                      }-    (cs, ns) = clustersToNodes (clusterBy params) (clusterID params)-                               (fmtCluster params) (fmtNode params)+    (cs, ns) = clustersToNodes (clusterBy params) (isDotCluster params)+                               (clusterID params) (fmtCluster params) (fmtNode params)                                lns     es = mapMaybe mkDotEdge les     mkDotEdge e@(f,t,_) = if dirGraph || f <= t@@ -294,7 +319,7 @@     -- Applying uniqBy just in case...     ns = uniqBy fst . map toLN $ graphNodes dg     es = concatMap toLE $ graphEdges dg-    -- Need to ensure that for some reason there are node IDs in an+    -- Need to check that for some reason there aren't node IDs in an     -- edge but not on their own.     nSet = Set.fromList $ map fst ns     nEs = map (flip (,) [])@@ -415,8 +440,8 @@     es' = zipWith addID es ([1..] :: [Int])     addID (f,t,l) i = (f,t,EID (T.pack $ show i) l) --- | Add the 'Comment' to the list of attributes containing the value---   of the unique edge identifier.+-- | Add a custom attribute to the list of attributes containing the+--   value of the unique edge identifier. setEdgeIDAttribute     :: (LEdge el -> Attributes)                           -> (LEdge (EdgeID el) -> Attributes) setEdgeIDAttribute f = \ e@(_,_,eid) -> identifierAttribute (eID eid)@@ -434,13 +459,13 @@  -- | Pass the 'DotRepr' through the relevant command and then augment --   the 'Graph' that it came from.-dotAttributes :: (Graph gr, PPDotRepr dg Node) => Bool -> gr nl (EdgeID el)+dotAttributes :: (Graph gr, PPDotRepr dg Node, FromGeneralisedDot dg Node)+                 => Bool -> gr nl (EdgeID el)                  -> dg Node -> IO (gr (AttributeNode nl) (AttributeEdge el)) dotAttributes isDir gr dot-  = liftM (augmentGraph gr . parseDG)-    $ graphvizWithHandle command dot DotOutput hGetDot+  = augmentGraph gr . parseDG <$> graphvizWithHandle command dot DotOutput hGetDot   where-    parseDG = (`asTypeOf` dot)+    parseDG = (`asTypeOf` dot) . fromGeneralised     command = if isDir then dirCommand else undirCommand  -- | Use the 'Attributes' in the provided 'DotGraph' to augment the
Data/GraphViz/Algorithms.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses #-}+ {- |    Module      : Data.GraphViz.Algorithms    Description : Various algorithms on Graphviz graphs.@@ -8,6 +10,10 @@    Defines various algorithms for use on 'DotRepr' graphs.  These are    typically re-implementations of behaviour found in existing Graphviz    tools but without the I/O requirement.++   Note that one way that these algorithms differ from those found in+   Graphviz is that the order of clusters is /not/ maintained, which may+   affect layout in some cases.  -} module Data.GraphViz.Algorithms        ( -- * Canonicalisation Options@@ -16,31 +22,35 @@        , defaultCanonOptions        , dotLikeOptions          -- * Canonicalisation+         -- $canonicalisation        , canonicalise        , canonicaliseOptions          -- * Dealing with transitive edges+         -- $transitive        , transitiveReduction        , transitiveReductionOptions        ) where -import Data.GraphViz.Attributes.Complete( Attributes, usedByClusters-                                        , defaultAttributeValue)+import Data.GraphViz.Attributes.Complete   (Attributes, defaultAttributeValue) import Data.GraphViz.Attributes.Same+import Data.GraphViz.Internal.Util         (bool) import Data.GraphViz.Types import Data.GraphViz.Types.Canonical+import Data.GraphViz.Types.Internal.Common -import Data.Function(on)-import Data.List(groupBy, sortBy, partition, (\\), sort, deleteBy)-import Data.Maybe(listToMaybe, mapMaybe, fromMaybe)-import qualified Data.DList as DList-import qualified Data.Map as Map-import Data.Map(Map)-import qualified Data.Set as Set-import Data.Set(Set)-import qualified Data.Foldable as F-import Control.Arrow(first, second, (***))-import Control.Monad(unless)-import Control.Monad.Trans.State+import           Control.Arrow       (first, second, (***))+import           Control.Monad       (unless)+import           Control.Monad.State (State, execState, gets, modify)+import qualified Data.DList          as DList+import qualified Data.Foldable       as F+import           Data.Function       (on)+import           Data.List           (deleteBy, groupBy, partition, sortBy,+                                      (\\))+import           Data.Map            (Map)+import qualified Data.Map            as Map+import           Data.Maybe          (fromMaybe, listToMaybe, mapMaybe)+import           Data.Set            (Set)+import qualified Data.Set            as Set  -- ----------------------------------------------------------------------------- @@ -73,14 +83,38 @@  -- ----------------------------------------------------------------------------- --- | Implements similar functionality to @dot -Tcanon@.  However, this---   method requires no IO and doesn't care about image locations, etc.------   This function will create a single explicit definition for every---   node in the original graph and place it in the appropriate---   position in the cluster hierarchy.  All edges are found in the---   deepest cluster that contains both nodes.  Currently node and---   edge attributes are not grouped into global ones.+{- $canonicalisation++These functions implement similar functionality to @dot -Tcanon@+(i.e. creates a canonical form of any 'DotRepr' graph).  without+requiring IO.++Note that due to implementation specifics the behaviour is not+identical; in particular:++* Any specified 'Attributes' that equal the defaults are stripped out+  (unless required to override a previous attribute that doesn't apply+  here).++* Grouping of attributes (when @'groupAttributes = True'@) is much+  more conservative; only those node/edge attributes that are common to+  /all/ nodes and edges within that cluster (and within sub-clusters)+  are made global.++* Sub-graphs aren't kept, only clusters.++* 'ColorScheme' Attributes are removed (as all @Color@ values embed+  any needed color scheme anyway) as the output order of attributes may+  change (and this matters for the Haskell side of things).++In particular, note that this function will create a single explicit+definition for every node in the original graph and place it in the+appropriate position in the cluster hierarchy.  All edges are found in+the deepest cluster that contains both nodes.++-}++-- | Canonicalise with some sensible defaults. canonicalise :: (DotRepr dg n) => dg n -> DotGraph n canonicalise = canonicaliseOptions defaultCanonOptions @@ -89,127 +123,172 @@                        -> dg n -> DotGraph n canonicaliseOptions opts dg = cdg { strictGraph   = graphIsStrict dg                                   , directedGraph = graphIsDirected dg-                                  , graphID       = getID dg                                   }   where-    cdg = createCanonical opts gas cl nl es+    cdg = createCanonical opts (getID dg) gas cl nl es -    (gas, cl) = graphStructureInformation dg-    nl = nodeInformation True dg-    es = edgeInformation True dg+    (gas, cl) = graphStructureInformationClean dg+    nl = nodeInformationClean True dg+    es = edgeInformationClean True dg -createCanonical :: (Ord n) => CanonicaliseOptions -> GlobalAttributes+type NodePath n = ([Maybe GraphID], DotNode n)+type NodePaths n = [NodePath n]+type EdgeClusters n = Map (Maybe GraphID) [DotEdge n]+type EdgeLocations n = (EdgeClusters n, [DotEdge n])++data CanonControl n = CC { cOpts    :: !CanonicaliseOptions+                         , isGraph  :: !Bool+                         , clusters :: !ClusterLookup+                         , clustEs  :: !(EdgeLocations n)+                         , topID    :: !(Maybe GraphID)+                         , topAttrs :: !Attributes+                         }++createCanonical :: (Ord n) => CanonicaliseOptions -> Maybe GraphID -> GlobalAttributes                    -> ClusterLookup -> NodeLookup n -> [DotEdge n] -> DotGraph n-createCanonical opts gas cl nl es-  = DotGraph { strictGraph     = undefined-             , directedGraph   = undefined-             , graphID         = undefined-             , graphStatements = gStmts-             }+createCanonical opts gid gas cl nl es = promoteDSG $ makeGrouping cc ns   where-    gStmts = DotStmts { attrStmts = gas'-                      , subGraphs = sgs-                      , nodeStmts = topNs'-                      , edgeStmts = topEs'-                      }--    gas' = nonEmptyGAs [ gas-                       , NodeAttrs topNAs-                       , EdgeAttrs topEAs-                       ]     nUnlook (n,(p,as)) = (F.toList p, DotNode n as)     -- DotNodes paired and sorted by their paths     ns = sortBy (compLists `on` fst) . map nUnlook $ Map.toList nl-    -- nodes in clusters vs top-level-    (clustNs, topNs) = thisLevel ns-    -- edges in clusters vs top-level-    (clustEL, topEs) = if edgesInClusters opts-                       then edgeClusters nl es-                       else (Map.empty, es) -    -- The global attributes that are also applicable to clusters.-    topClustAs = filter usedByClusters $ attrs gas-    topClustAs' = toSAttr topClustAs+    es' = if edgesInClusters opts+          then edgeClusters nl es+          else (Map.empty, es) -    topNAs = mCommon nodeAttributes topNs-    topNAs' = toSAttr topNAs-    topNs' = map (\dn -> dn {nodeAttributes = nodeAttributes dn \\ topNAs}) topNs+    cc = CC { cOpts    = opts+            , isGraph  = True+            , clusters = cl+            , clustEs  = es'+            , topID    = gid+            , topAttrs = attrs gas+            } -    topEAs = mCommon edgeAttributes topEs-    topEAs' = toSAttr topEAs-    topEs' = map (\de -> de {edgeAttributes = edgeAttributes de \\ topEAs}) topEs+thisLevel :: NodePaths n -> (NodePaths n, [DotNode n])+thisLevel = second (map snd) . span (not . null . fst) -    sgs = clusts topClustAs topClustAs' topNAs topNAs' topEAs topEAs' clustNs+makeGrouping :: CanonControl n -> NodePaths n -> DotSubGraph n+makeGrouping cc cns = DotSG { isCluster = True+                            , subGraphID = cID+                            , subGraphStmts = stmts+                            }+  where+    cID | isGraph cc = topID cc+        | otherwise  = head . fst . head $ cns -    clusts oAs oAsS nAs nAsS eAs eAsS = map (toClust oAs oAsS nAs nAsS eAs eAsS)-                                        . groupBy ((==) `on` (listToMaybe . fst))+    (nestedNs, ns) = thisLevel+                     . bool (map $ first tail) id (isGraph cc)+                     $ cns -    -- Create a new cluster.-    -- oAs - outer cluster attributes-    -- nAs - outer node attributes-    -- eAs - outer edge attributes-    -- (*S variants are same thing but as sets; premature optimisation?)-    -- cns - nodes in this cluster-    toClust oAs oAsS nAs nAsS eAs eAsS cns-      = DotSG { isCluster     = True-              , subGraphID    = cID-              , subGraphStmts = stmts-              }-      where-        -- Find the ID for this cluster.-        cID = head . fst $ head cns+    es = bool (fromMaybe [] . Map.lookup cID . fst) snd (isGraph cc)+         $ clustEs cc -        -- Get the nodes that are deeper and the ones that belong-        -- here.-        (nested, here) = thisLevel $ map (first tail) cns+    gas | isGraph cc = topAttrs cc+        | otherwise  = attrs . snd $ clusters cc Map.! cID +    subGs = map (makeGrouping $ cc { isGraph = False })+            . groupBy ((==) `on` (listToMaybe . fst))+            $ nestedNs -        stmts = DotStmts { attrStmts = sgAs-                         , subGraphs = subSGs-                         , nodeStmts = here'-                         , edgeStmts = edges'-                         }+    stmts = setGlobal (cOpts cc) gas+            $ DotStmts { attrStmts = []+                       , subGraphs = subGs+                       , nodeStmts = ns+                       , edgeStmts = es+                       } -        -- Starting global attributes-        sgAs = nonEmptyGAs [ GraphAttrs as'-                           , NodeAttrs nas'-                           , EdgeAttrs eas'-                           ]+setGlobal :: CanonicaliseOptions+             -> Attributes -- Specified cluster attributes+             -> DotStatements n+             -> DotStatements n+setGlobal opts as stmts = stmts { attrStmts = globs'+                                , subGraphs = sgs'+                                , nodeStmts = ns'+                                , edgeStmts = es'+                                }+  where+    sgs = subGraphs stmts+    sStmts = map subGraphStmts sgs+    ns = nodeStmts stmts+    es = edgeStmts stmts -        -- Sub-clusters-        subSGs = clusts as asS nas nasS eas easS nested+    sGlobs = map (partitionGlobal . attrStmts) sStmts -        -- The attributes attached to this cluster ID in the original.-        as = attrs . snd $ cl Map.! cID-        asS = toSAttr as+    (sgas,snas,seas) = unzip3 sGlobs -        -- Get the global attributes that apply to this cluster,-        -- ignoring ones set globally.-        as' = fst $ innerAttributes oAs oAsS as+    gas' = as -- Can't change graph attrs! Need these!+    nas' = getCommonGlobs opts nodeStmts snas sStmts $ map nodeAttributes ns+    eas' = getCommonGlobs opts edgeStmts seas sStmts $ map edgeAttributes es -        -- The node attributes that can be stated globally.-        nas = mCommon nodeAttributes here-        nasS = toSAttr nas-        (nas',nOv) = innerAttributes nAs nAsS nas+    globs' = nonEmptyGAs [ GraphAttrs gas'+                         , NodeAttrs  nas'+                         , EdgeAttrs  eas'+                         ]+    ns' = map (\dn -> dn { nodeAttributes = nodeAttributes dn \\ nas' }) ns+    es' = map (\de -> de { edgeAttributes = edgeAttributes de \\ eas' }) es -        -- The nodes that belong here, with updated attributes.-        here' = map (\dn -> dn {nodeAttributes = nodeAttributes dn \\ (nas ++ nOv)}) here+    sgas' = updateGraphGlobs gas' sgas+    snas' = map (\\ nas') snas+    seas' = map (\\ eas') seas -        eas = mCommon edgeAttributes edges-        easS = toSAttr eas-        (eas',eOv) = innerAttributes eAs eAsS eas-        edges' = map (\de -> de {edgeAttributes = edgeAttributes de \\ (eas ++ eOv)}) edges+    sGlobs' = zip3 sgas' snas' seas'+    sStmts' = zipWith (\ sSt sGl -> sSt { attrStmts = nonEmptyGAs $ unPartitionGlobal sGl })+                      sStmts+                      sGlobs' -        -- Find edges that belong here-        edges = fromMaybe [] $ cID `Map.lookup` clustEL+    sgs' = zipWith (\ sg sSt -> sg { subGraphStmts = sSt }) sgs sStmts' -    thisLevel = second (map snd) . span (not . null . fst)+updateGraphGlobs :: Attributes -> [Attributes] -> [Attributes]+updateGraphGlobs gas = map go+  where+    gasS = Set.fromList gas -    mCommon f = if groupAttributes opts-                then commonAttrs f-                else const []+    override = toSAttr $ nonSameDefaults gas +    -- * Remove any identical values+    -- * Override any different values+    go = Set.toList+         . (`Set.difference` gasS) -- Remove identical values+         . unSameSet+         . (`Set.union` override) -- Keeps existing values of constructors+         . toSAttr +nonSameDefaults :: Attributes -> Attributes+nonSameDefaults = mapMaybe (\ a -> [ a' | a' <- defaultAttributeValue a, a' /= a] )++getCommonGlobs :: CanonicaliseOptions+                  -> (DotStatements n -> [a])+                  -> [Attributes] -- ^ From sub-graphs+                  -> [DotStatements n] -- ^ Statements from the sub-graphs for testing.+                  -> [Attributes] -- ^ From nodes/edges+                  -> Attributes+getCommonGlobs opts f sas stmts as+  | not $ groupAttributes opts = []+  | otherwise = case sas' ++ as of+                  []  -> []+                  [_] -> []+                  as' -> Set.toList . foldr1 Set.intersection+                         $ map Set.fromList as'+  where+    sas' = keepIfAny f sas stmts++-- Used to distinguish between having empty list of global attributes+-- for nodes or edges because there aren't any nodes/edges, or because+-- there aren't any common attributes+keepIfAny :: (DotStatements n -> [a]) -> [Attributes] -> [DotStatements n]+             -> [Attributes]+keepIfAny f sas = map fst . filter snd . zip sas . map (hasAny f)++hasAny      :: (DotStatements n -> [a]) -> DotStatements n -> Bool+hasAny f ds = not (null $ f ds) || any (hasAny f . subGraphStmts) (subGraphs ds)++promoteDSG     :: DotSubGraph n -> DotGraph n+promoteDSG dsg = DotGraph { strictGraph     = undefined+                          , directedGraph   = undefined+                          , graphID         = subGraphID dsg+                          , graphStatements = subGraphStmts dsg+                          }+ -- Same as compare for lists, except shorter lists are GT compLists :: (Ord a) => [a] -> [a] -> Ordering compLists []     []     = EQ@@ -222,20 +301,14 @@ nonEmptyGAs :: [GlobalAttributes] -> [GlobalAttributes] nonEmptyGAs = filter (not . null . attrs) --- Return all attributes found in every value.-commonAttrs         :: (a -> Attributes) -> [a] -> Attributes-commonAttrs _ []  = []-commonAttrs _ [_] = []-commonAttrs f xs  = Set.toList . foldr1 Set.intersection-                    $ map (Set.fromList . f) xs- -- Assign each edge into the cluster it belongs in. edgeClusters    :: (Ord n) => NodeLookup n -> [DotEdge n]-                   -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n])+                   -> EdgeLocations n edgeClusters nl = (toM *** map snd) . partition (not . null . fst)                   . map inClust   where     nl' = Map.map (F.toList . fst) nl+    -- DotEdge n -> (Path, DotEdge n)     inClust de@(DotEdge n1 n2 _) = (flip (,) de)                                    . map fst . takeWhile (uncurry (==))                                    $ zip (nl' Map.! n1) (nl' Map.! n2)@@ -243,25 +316,6 @@           . Map.fromListWith (flip DList.append)           . map (last *** DList.singleton) --- Return only those attributes that are required within the inner--- sub-graph.  Also returns the overrides.-innerAttributes                    :: Attributes -> SAttrs-                                      -> Attributes -> (Attributes, Attributes)-innerAttributes outer outerS inner = (sort $ inner' ++ override, override)-  where-    -- Remove all Attributes that are also defined in the outer cluster-    inner' = inner \\ outer--    -- Need to consider those Attributes that were defined /after/ this value-    override = mapMaybe defAttr . unSame-               $ outerS `Set.difference` toSAttr inner--    -- A version of defaultAttributeValue that returns Nothing if the-    -- value it is replacing /is/ the default.-    defAttr a = case defaultAttributeValue a of-                  Just a' | a == a' -> Nothing-                  ma'               -> ma'- -- -----------------------------------------------------------------------------  {- $transitive@@ -300,6 +354,8 @@    Note that transitive reduction only makes sense for directed graphs;    for undirected graphs these functions are identical to the    canonicalisation functions above.++   The caveats for the canonicalisation functions also apply.  -}  transitiveReduction :: (DotRepr dg n) => dg n -> DotGraph n@@ -309,13 +365,12 @@                                       -> dg n -> DotGraph n transitiveReductionOptions opts dg = cdg { strictGraph = graphIsStrict dg                                          , directedGraph = graphIsDirected dg-                                         , graphID = getID dg                                          }   where-    cdg = createCanonical opts gas cl nl es'-    (gas, cl) = graphStructureInformation dg-    nl = nodeInformation True dg-    es = edgeInformation True dg+    cdg = createCanonical opts (getID dg) gas cl nl es'+    (gas, cl) = graphStructureInformationClean dg+    nl = nodeInformationClean True dg+    es = edgeInformationClean True dg     es' | graphIsDirected dg = rmTransEdges es         | otherwise          = es @@ -327,7 +382,7 @@      esMS = do edgeGraph tes               ns <- getsMap Map.keys-              mapM_ (traverse zeroTag) ns+              mapM_ (traverseTag zeroTag) ns      esM = fst $ execState esMS (Map.empty, Set.empty) @@ -387,13 +442,12 @@                                }  -- Perform a DFS to determine whether or not to keep each edge.-traverse     :: (Ord n) => Tag -> n -> TagState n ()-traverse t n = do setMark True-                  checkIncoming-                  outEs <- getsMap (maybe [] outgoing . Map.lookup n)-                  mapM_ maybeRecurse outEs-                  setMark False-+traverseTag     :: (Ord n) => Tag -> n -> TagState n ()+traverseTag t n = do setMark True+                     checkIncoming+                     outEs <- getsMap (maybe [] outgoing . Map.lookup n)+                     mapM_ maybeRecurse outEs+                     setMark False   where     setMark mrk = modifyMap (Map.adjust (\tv -> tv { marked = mrk }) n) @@ -416,4 +470,4 @@                              delSet <- getSet                              let n' = toNode e                              unless (isMarked m n' || t' `Set.member` delSet)-                               $ traverse t' n'+                               $ traverseTag t' n'
Data/GraphViz/Algorithms/Clustering.hs view
@@ -32,11 +32,11 @@  -- | Extract the clusters and nodes from the list of nodes. clustersToNodes :: (Ord c) => ((n,a) -> NodeCluster c (n,l))-                  -> (c -> GraphID) -> (c -> [GlobalAttributes])+                  -> (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])                   -> ((n,l) -> Attributes) -> [(n,a)]                   -> ([DotSubGraph n], [DotNode n])-clustersToNodes clusterBy cID fmtCluster fmtNode-    = treesToDot cID fmtCluster fmtNode+clustersToNodes clusterBy isC cID fmtCluster fmtNode+    = treesToDot isC cID fmtCluster fmtNode       . collapseNClusts       . map (clustToTree . clusterBy) @@ -84,23 +84,23 @@ -- | Convert the cluster representation of the trees into 'DotNode's --   and 'DotSubGraph's (with @'isCluster' = 'True'@, and --   @'subGraphID' = 'Nothing'@).-treesToDot :: (c -> GraphID) -> (c -> [GlobalAttributes])+treesToDot :: (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])               -> ((n,a) -> Attributes) -> [ClusterTree c (n,a)]               -> ([DotSubGraph n], [DotNode n])-treesToDot cID fmtCluster fmtNode+treesToDot isC cID fmtCluster fmtNode     = partitionEithers-      . map (treeToDot cID fmtCluster fmtNode)+      . map (treeToDot isC cID fmtCluster fmtNode)  -- | Convert this 'ClusterTree' into its /Dot/ representation.-treeToDot :: (c -> GraphID) -> (c -> [GlobalAttributes])+treeToDot :: (c -> Bool) -> (c -> GraphID) -> (c -> [GlobalAttributes])              -> ((n,a) -> Attributes) -> ClusterTree c (n,a)              -> Either (DotSubGraph n) (DotNode n)-treeToDot _ _ fmtNode (NT ln)+treeToDot _ _ _ fmtNode (NT ln)     = Right DotNode { nodeID         = fst ln                     , nodeAttributes = fmtNode ln                     }-treeToDot cID fmtCluster fmtNode (CT c nts)-    = Left DotSG { isCluster     = True+treeToDot isC cID fmtCluster fmtNode (CT c nts)+    = Left DotSG { isCluster     = isC c                  , subGraphID    = Just $ cID c                  , subGraphStmts = stmts                  }@@ -110,4 +110,4 @@                      , nodeStmts = ns                      , edgeStmts = []                      }-    (cs, ns) = treesToDot cID fmtCluster fmtNode nts+    (cs, ns) = treesToDot isC cID fmtCluster fmtNode nts
Data/GraphViz/Attributes.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}  {- |    Module      : Data.GraphViz.Attributes@@ -54,6 +54,8 @@        , invis        , filled        , diagonals+       , striped+       , wedged        , rounded        , tapered        , radial@@ -91,12 +93,18 @@        , RankType(..)        ) where -import Data.GraphViz.Attributes.Complete-import Data.GraphViz.Attributes.Colors.X11-import qualified Data.GraphViz.Attributes.HTML as Html+import           Data.GraphViz.Attributes.Arrows+import           Data.GraphViz.Attributes.Colors+import           Data.GraphViz.Attributes.Colors.X11+import           Data.GraphViz.Attributes.Complete   (Attribute (..),+                                                      Attributes)+import qualified Data.GraphViz.Attributes.HTML       as Html+import           Data.GraphViz.Attributes.Internal+import           Data.GraphViz.Attributes.Values +import qualified Data.Text      as ST+import           Data.Text.Lazy (Text) import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)  -- ----------------------------------------------------------------------------- @@ -145,7 +153,7 @@ textLabel = toLabel  -- | Create a label /outside/ of a node\/edge.  Currently only in the--- | Graphviz development branch (2.29.*).+--   Graphviz development branch (2.29.*). xLabel :: (Labellable a) => a -> Attribute xLabel = XLabel . toLabelValue @@ -165,6 +173,9 @@ instance Labellable Text where   toLabelValue = StrLabel +instance Labellable ST.Text where+  toLabelValue = toLabelValue . T.fromStrict+ instance Labellable Char where   toLabelValue = toLabelValue . T.singleton @@ -222,24 +233,24 @@ --   clusters, if @'style' 'filled'@ is used, then 'fillColor' will --   override it. bgColor :: (NamedColor nc) => nc -> Attribute-bgColor = BgColor . (:[]) . toColor+bgColor = BgColor . toColorList . (:[]) . toColor  -- | As with 'bgColor', but add a second color to create a gradient --   effect.  Requires Graphviz >= 2.29.0. bgColors       :: (NamedColor nc) => nc -> nc -> Attribute-bgColors c1 c2 = BgColor $ map toColor [c1,c2]+bgColors c1 c2 = BgColor . toColorList $ map toColor [c1,c2]  -- | Specify the fill color of a node, cluster or arrowhead.  Requires --   @'style' 'filled'@ for nodes and clusters.  For nodes and edges, --   if this isn't set then the 'color' value is used instead; for --   clusters, 'bgColor' is used. fillColor :: (NamedColor nc) => nc -> Attribute-fillColor = FillColor . (:[]) . toColor+fillColor = FillColor . toColorList . (:[]) . toColor  -- | As with 'fillColor', but add a second color to create a gradient --   effect.  Requires Graphviz >= 2.29.0. fillColors       :: (NamedColor nc) => nc -> nc -> Attribute-fillColors c1 c2 = FillColor $ map toColor [c1,c2]+fillColors c1 c2 = FillColor . toColorList $ map toColor [c1,c2]  -- | Specify the color of text. fontColor :: (NamedColor nc) => nc -> Attribute@@ -263,7 +274,7 @@ --     background color of nodes and clusters unless 'fillColor' or --     'bgColor' respectively is set. color :: (NamedColor nc) => nc -> Attribute-color = Color . (:[]) . toColor+color = Color . toColorList . (:[]) . toColor  -- ----------------------------------------------------------------------------- @@ -316,6 +327,16 @@ diagonals :: Style diagonals = SItem Diagonals [] +-- | Only available for rectangularly-shaped nodes and+--   clusters.  Requires Graphviz >= 2.30.0.+striped :: Style+striped = SItem Striped []++-- | Only available for elliptically-shaped nodes.  Requires Graphviz+--   >= 2.30.0.+wedged :: Style+wedged = SItem Wedged []+ -- | Only available for edges; creates a tapered edge between the two --   nodes.  Requires Graphviz >= 2.29.0. tapered :: Style@@ -362,10 +383,9 @@ edgeEnds :: DirType -> Attribute edgeEnds = Dir -box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: Arrow+box, crow, diamond, dotArrow, inv, noArrow, tee, vee :: Arrow oDot, invDot, invODot, oBox, oDiamond :: Arrow -normal = AType [(noMods, Normal)] inv = AType [(noMods, Inv)] dotArrow = AType [(noMods, DotArrow)] invDot = AType [ (noMods, Inv)
+ Data/GraphViz/Attributes/Arrows.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+{-# OPTIONS_HADDOCK hide #-}+{- |+   Module      : Data.GraphViz.Attributes.Arrows+   Description : Arrow types+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.Attributes.Arrows where++import Data.GraphViz.Internal.Util (bool)+import Data.GraphViz.Parsing+import Data.GraphViz.Printing++import Data.Maybe (isJust)++#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif++-- -----------------------------------------------------------------------------++-- | /Dot/ has a basic grammar of arrow shapes which allows usage of+--   up to 1,544,761 different shapes from 9 different basic+--   'ArrowShape's.  Note that whilst an explicit list is used in the+--   definition of 'ArrowType', there must be at least one tuple and a+--   maximum of 4 (since that is what is required by Dot).  For more+--   information, see: <http://graphviz.org/doc/info/arrows.html>+--+--   The 19 basic arrows shown on the overall attributes page have+--   been defined below as a convenience.  Parsing of the 5+--   backward-compatible special cases is also supported.+newtype ArrowType = AType [(ArrowModifier, ArrowShape)]+    deriving (Eq, Ord, Show, Read)++-- Used for default+normal :: ArrowType+normal = AType [(noMods, Normal)]++-- Used for backward-compatible parsing+eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType++eDiamond = AType [(openMod, Diamond)]+openArr = AType [(noMods, Vee)]+halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]+emptyArr = AType [(openMod, Normal)]+invEmpty = AType [ (noMods, Inv)+                 , (openMod, Normal)]++instance PrintDot ArrowType where+  unqtDot (AType mas) = hcat $ mapM appMod mas+    where+      appMod (m, a) = unqtDot m <> unqtDot a++instance ParseDot ArrowType where+  parseUnqt = specialArrowParse+              `onFail`+              (AType <$> many1 (liftA2 (,) parseUnqt parseUnqt))++specialArrowParse :: Parse ArrowType+specialArrowParse = stringValue [ ("ediamond", eDiamond)+                                , ("open", openArr)+                                , ("halfopen", halfOpen)+                                , ("empty", emptyArr)+                                , ("invempty", invEmpty)+                                ]++data ArrowShape = Box+                | Crow+                | Diamond+                | DotArrow+                | Inv+                | NoArrow+                | Normal+                | Tee+                | Vee+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ArrowShape where+  unqtDot Box      = text "box"+  unqtDot Crow     = text "crow"+  unqtDot Diamond  = text "diamond"+  unqtDot DotArrow = text "dot"+  unqtDot Inv      = text "inv"+  unqtDot NoArrow  = text "none"+  unqtDot Normal   = text "normal"+  unqtDot Tee      = text "tee"+  unqtDot Vee      = text "vee"++instance ParseDot ArrowShape where+  parseUnqt = stringValue [ ("box", Box)+                          , ("crow", Crow)+                          , ("diamond", Diamond)+                          , ("dot", DotArrow)+                          , ("inv", Inv)+                          , ("none", NoArrow)+                          , ("normal", Normal)+                          , ("tee", Tee)+                          , ("vee", Vee)+                          ]++-- | What modifications to apply to an 'ArrowShape'.+data ArrowModifier = ArrMod { arrowFill :: ArrowFill+                            , arrowSide :: ArrowSide+                            }+                   deriving (Eq, Ord, Show, Read)++-- | Apply no modifications to an 'ArrowShape'.+noMods :: ArrowModifier+noMods = ArrMod FilledArrow BothSides++-- | 'OpenArrow' and 'BothSides'+openMod :: ArrowModifier+openMod = ArrMod OpenArrow BothSides++instance PrintDot ArrowModifier where+  unqtDot (ArrMod f s) = unqtDot f <> unqtDot s++instance ParseDot ArrowModifier where+  parseUnqt = liftA2 ArrMod parseUnqt parseUnqt++data ArrowFill = OpenArrow+               | FilledArrow+               deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ArrowFill where+  unqtDot OpenArrow   = char 'o'+  unqtDot FilledArrow = empty++instance ParseDot ArrowFill where+  parseUnqt = bool FilledArrow OpenArrow . isJust <$> optional (character 'o')++  -- Not used individually+  parse = parseUnqt++-- | Represents which side (when looking towards the node the arrow is+--   pointing to) is drawn.+data ArrowSide = LeftSide+               | RightSide+               | BothSides+               deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ArrowSide where+  unqtDot LeftSide  = char 'l'+  unqtDot RightSide = char 'r'+  unqtDot BothSides = empty++instance ParseDot ArrowSide where+  parseUnqt = getSideType <$> optional (oneOf $ map character ['l', 'r'])+    where+      getSideType = maybe BothSides+                          (bool RightSide LeftSide . (==) 'l')++  -- Not used individually+  parse = parseUnqt
Data/GraphViz/Attributes/Colors.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-}  {- |    Module      : Data.GraphViz.Attributes.Colors@@ -24,36 +24,44 @@          ColorScheme(..)          -- * Colors        , Color(..)+       , ColorList+       , WeightedColor(..)+       , toWC+       , toColorList        , NamedColor(toColor)+       , toWColor          -- * Conversion to\/from @Colour@.        , toColour        , fromColour        , fromAColour        ) where +import Data.GraphViz.Attributes.Colors.Brewer (BrewerColor(..))+import Data.GraphViz.Attributes.Colors.SVG    (SVGColor, svgColour)+import Data.GraphViz.Attributes.Colors.X11    (X11Color(Transparent), x11Colour)+import Data.GraphViz.Attributes.ColorScheme   (ColorScheme(..))+import Data.GraphViz.Exception+import Data.GraphViz.Internal.State+import Data.GraphViz.Internal.Util            (bool) import Data.GraphViz.Parsing import Data.GraphViz.Printing-import Data.GraphViz.State-import Data.GraphViz.Attributes.ColorScheme(ColorScheme(..))-import Data.GraphViz.Attributes.Colors.X11(X11Color(Transparent), x11Colour)-import Data.GraphViz.Attributes.Colors.SVG(SVGColor, svgColour)-import Data.GraphViz.Attributes.Colors.Brewer(BrewerColor(..))-import Data.GraphViz.Util(bool)-import Data.GraphViz.Exception -import Data.Colour( AlphaColour, opaque, withOpacity-                  , over, black, alphaChannel, darken)-import Data.Colour.SRGB(Colour, sRGB, sRGB24, toSRGB24)-import Data.Colour.RGBSpace(uncurryRGB)-import Data.Colour.RGBSpace.HSV(hsv)+import Data.Colour              (AlphaColour, alphaChannel, black, darken,+                                 opaque, over, withOpacity)+import Data.Colour.RGBSpace     (uncurryRGB)+import Data.Colour.RGBSpace.HSV (hsv)+import Data.Colour.SRGB         (Colour, sRGB, sRGB24, toSRGB24) -import Data.Char(isHexDigit)-import Numeric(showHex, readHex)-import Data.Maybe(isJust)-import Data.Word(Word8)+import           Data.Char      (isHexDigit)+import           Data.Maybe     (isJust) import qualified Data.Text.Lazy as T-import Control.Monad(liftM)+import           Data.Word      (Word8)+import           Numeric        (readHex, showHex) +#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif+ -- -----------------------------------------------------------------------------  -- | Defining a color for use with Graphviz.  Note that named colors@@ -122,25 +130,25 @@                     , parseNC (undefined :: SVGColor) False                     , parseX11Color False                     ]+              `onFail`+              fail "Could not parse Color"     where       parseHexBased-          = do character '#'-               cs <- many1 parse2Hex+          = character '#' *>+            do cs <- many1 parse2Hex                return $ case cs of                           [r,g,b] -> RGB r g b                           [r,g,b,a] -> RGBA r g b a                           _ -> throw . NotDotCode                                $ "Not a valid hex Color specification: "                                   ++ show cs-      parseHSV = do h <- parse-                    parseSep-                    s <- parse-                    parseSep-                    v <- parse-                    return $ HSV h s v-      parseSep = oneOf [ string ","-                       , whitespace1-                       ]+      parseHSV = HSV <$> parseUnqt+                     <*  parseSep+                     <*> parseUnqt+                     <*  parseSep+                     <*> parseUnqt+      parseSep = character ',' *> whitespace <|> whitespace1+       parse2Hex = do c1 <- satisfy isHexDigit                      c2 <- satisfy isHexDigit                      let [(n, [])] = readHex [c1, c2]@@ -152,11 +160,17 @@                 , parseNC (undefined :: SVGColor) True                 , parseX11Color True                 ]+          `onFail`+          fail "Could not parse Color"    parseUnqtList = sepBy1 parseUnqt (character ':')+                  `onFail`+                  do cs <- getColorScheme+                     failBad $ "Error parsing list of Colors with color scheme of "+                               ++ show cs -  parseList = liftM (:[])-              -- Unquoted single color+  parseList = fmap (:[])+              -- Potentially unquoted single color               (oneOf [ parseNC (undefined :: BrewerColor) True                      , parseNC (undefined :: SVGColor) True                      , parseX11Color True@@ -164,7 +178,66 @@               )               `onFail`               quotedParse parseUnqtList+              `onFail`+              do cs <- getColorScheme+                 failBad $ "Error parsing list of Colors with color scheme of "+                           ++ show cs +-- | The sum of the optional weightings /must/ sum to at most @1@.+type ColorList = [WeightedColor]++-- | A 'Color' tagged with an optional weighting.+data WeightedColor = WC { wColor    :: Color+                          -- | Must be in range @0 <= W <= 1@.+                        , weighting :: Maybe Double+                        }+                   deriving (Eq, Ord, Show, Read)++-- | For colors without weightings.+toWC :: Color -> WeightedColor+toWC = (`WC` Nothing)++-- | For a list of colors without weightings.+toColorList :: [Color] -> ColorList+toColorList = map toWC++instance PrintDot WeightedColor where+  unqtDot (WC c mw) = unqtDot c+                      <> maybe empty ((semi<>) . unqtDot) mw++  toDot (WC c Nothing) = toDot c+  toDot wc             = dquotes $ unqtDot wc++  unqtListToDot = hcat . punctuate colon . mapM unqtDot++  -- Might not need quoting+  listToDot [wc] = toDot wc+  listToDot wcs  = dquotes $ unqtListToDot wcs++instance ParseDot WeightedColor where+  parseUnqt = WC <$> parseUnqt <*> optional (character ';' *> parseUnqt)++  parse = quotedParse parseUnqt+          `onFail`+          -- Using parse rather than parseUnqt as there shouldn't be+          -- any quotes, but to avoid copy-pasting the oneOf block.+          (toWC <$> parse)++  parseUnqtList = sepBy1 parseUnqt (character ':')+                  `onFail`+                  do cs <- getColorScheme+                     failBad $ "Error parsing a ColorList with color scheme of "+                               ++ show cs++  parseList = quotedParse parseUnqtList+              `onFail`+              ((:[]) . toWC <$> parse)+              -- Potentially unquoted un-weighted single color+              `onFail`+              do cs <- getColorScheme+                 failBad $ "Error parsing ColorList with color scheme of "+                           ++ show cs+ -- -----------------------------------------------------------------------------  -- | More easily convert named colors to an overall 'Color' value.@@ -175,11 +248,15 @@      printNC :: Bool -> nc -> DotCode +    -- | Bool is for whether quoting is needed.     parseNC' :: Bool -> Parse nc +toWColor :: (NamedColor nc) => nc -> WeightedColor+toWColor = toWC . toColor+ -- First value just used for type parseNC :: (NamedColor nc) => nc -> Bool -> Parse Color-parseNC nc q = fmap (toColor . flip asTypeOf nc)+parseNC nc q = fmap (toColor . (`asTypeOf` nc))                $ parseNC' q  instance NamedColor BrewerColor where@@ -230,11 +307,11 @@       cs = colorScheme c       lv = fl c -parseNamedColor :: (NamedColor nc, ParseDot lv)+parseNamedColor :: (ParseDot lv)                    => (ColorScheme -> Maybe cs) -> Parse cs -> (cs -> Bool)                    -> (cs -> lv -> nc) -> Bool -> Parse nc parseNamedColor gcs parseCS vcs mkC q-    = do Just cs <- gcs `fmap` getColorScheme+    = do Just cs <- gcs <$> getColorScheme          lv <- bool parseUnqt parse q                `onFail`                mQts (string "//" *> parseUnqt)@@ -244,8 +321,7 @@                 cs <- parseCS                 character '/'                 if vcs cs-                   then do lv <- parseUnqt-                           return $ mkC cs lv+                   then mkC cs <$>  parseUnqt                    else fail "Explicit colorscheme not as expected."            )     where@@ -256,16 +332,16 @@ -- X11 has a special case when parsing: '/yyyy'  parseX11Color   :: Bool -> Parse Color-parseX11Color q = fmap X11Color-                  $ parseNC' q-                    `onFail`-                    bool id quotedParse q (character '/' *> parseUnqt)-                    `onFail`-                    -- Can use X11 colors within brewer colorscheme.-                    do cs <- getColorScheme-                       case cs of-                         Brewer{} -> bool parseUnqt parse q-                         _        -> fail "Unable to parse an X11 color within Brewer"+parseX11Color q = X11Color+                  <$> parseNC' q+                      `onFail`+                      bool id quotedParse q (character '/' *> parseUnqt)+                      `onFail`+                      -- Can use X11 colors within brewer colorscheme.+                      do cs <- getColorScheme+                         case cs of+                           Brewer{} -> bool parseUnqt parse q+                           _        -> fail "Unable to parse an X11 color within Brewer"  -- -----------------------------------------------------------------------------
Data/GraphViz/Attributes/Complete.hs view
@@ -1,2892 +1,1606 @@-{-# LANGUAGE OverloadedStrings #-}--{- |-   Module      : Data.GraphViz.Attributes.Complete-   Description : Definition of the Graphviz attributes.-   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   If you are just using graphviz to create basic Dot graphs, then you-   probably want to use "Data.GraphViz.Attributes" rather than this-   module.--   This module defines the various attributes that different parts of-   a Graphviz graph can have.  These attributes are based on the-   documentation found at:-     <http://graphviz.org/doc/info/attrs.html>--   For more information on usage, etc. please see that document.--   A summary of known current constraints\/limitations\/differences:--   * Note that for an edge, in /Dot/ parlance if the edge goes from-     /A/ to /B/, then /A/ is the tail node and /B/ is the head node-     (since /A/ is at the tail end of the arrow).--   * @ColorList@, @DoubleList@ and @PointfList@ are defined as actual-     lists (@'LayerList'@ needs a newtype for other reasons).  All of these-     are assumed to be non-empty lists.--   * For the various @*Color@ attributes that take in a list of-     'Color' values, usually only one color is used.  The @Color@-     attribute for edges allows multiple values; for other attributes,-     two values are supported for gradient fills in Graphviz >=-     2.29.0.--   * Style is implemented as a list of 'StyleItem' values; note that-     empty lists are not allowed.--   * A lot of values have a possible value of @none@.  These now-     have custom constructors.  In fact, most constructors have been-     expanded upon to give an idea of what they represent rather than-     using generic terms.--   * @PointF@ and 'Point' have been combined.  The optional '!' and-     third value for Point are also available.--   * 'Rect' uses two 'Point' values to denote the lower-left and-     top-right corners.--   * The two 'LabelLoc' attributes have been combined.--   * @SplineType@ has been replaced with @['Spline']@.--   * Only polygon-based 'Shape's are available.--   * Not every 'Attribute' is fully documented/described.  However,-     all those which have specific allowed values should be covered.--   * Deprecated 'Overlap' algorithms are not defined.--   * The global @Orientation@ attribute is not defined, as it is-     difficult to distinguish from the node-based 'Orientation'-     'Attribute'; also, its behaviour is duplicated by 'Rotate'.--   * The @charset@ attribute is not available, as graphviz only-     supports UTF-8 encoding (as it is not currently feasible nor needed to-     also support Latin1 encoding).--   * In Graphviz, when a node or edge has a list of attributes, the-     colorscheme which is used to identify a color can be set /after/-     that color (e.g. @[colorscheme=x11,color=grey,colorscheme=svg]@-     uses the svg colorscheme's definition of grey, which is different-     from the x11 one.  Instead, graphviz parses them in order.-- -}-module Data.GraphViz.Attributes.Complete-       ( -- * The actual /Dot/ attributes.-         -- $attributes-         Attribute(..)-       , Attributes-       , sameAttribute-       , defaultAttributeValue-         -- ** Validity functions on @Attribute@ values.-       , usedByGraphs-       , usedBySubGraphs-       , usedByClusters-       , usedByNodes-       , usedByEdges-       , validUnknown--         -- ** Custom attributes.-       , AttributeName-       , CustomAttribute-       , customAttribute-       , isCustom-       , isSpecifiedCustom-       , customValue-       , customName-       , findCustoms-       , findSpecifiedCustom-       , deleteCustomAttributes-       , deleteSpecifiedCustom--         -- * Value types for @Attribute@s.-       , module Data.GraphViz.Attributes.Colors--         -- ** Labels-       , EscString-       , Label(..)-       , VerticalPlacement(..)-       , LabelScheme(..)-         -- *** Types representing the Dot grammar for records.-       , RecordFields-       , RecordField(..)-       , Rect(..)-       , Justification(..)--         -- ** Nodes-       , Shape(..)-       , Paths(..)-       , ScaleType(..)--         -- ** Edges-       , DirType(..)-       , EdgeType(..)-         -- *** Modifying where edges point-       , PortName(..)-       , PortPos(..)-       , CompassPoint(..)-         -- *** Arrows-       , ArrowType(..)-       , ArrowShape(..)-       , ArrowModifier(..)-       , ArrowFill(..)-       , ArrowSide(..)-         -- **** @ArrowModifier@ values-       , noMods-       , openMod--         -- ** Positioning-       , Point(..)-       , createPoint-       , Pos(..)-       , Spline(..)-       , DPoint(..)--         -- ** Layout-       , AspectType(..)-       , ClusterMode(..)-       , Model(..)-       , Overlap(..)-       , Root(..)-       , Order(..)-       , OutputMode(..)-       , Pack(..)-       , PackMode(..)-       , PageDir(..)-       , QuadType(..)-       , RankType(..)-       , RankDir(..)-       , StartType(..)-       , ViewPort(..)-       , FocusType(..)-       , Ratios(..)--         -- ** Modes-       , ModeType(..)-       , DEConstraints(..)--         -- ** Layers-       , LayerSep(..)-       , LayerRange(..)-       , LayerID(..)-       , LayerList(..)--         -- ** Stylistic-       , SmoothType(..)-       , STStyle(..)-       , StyleItem(..)-       , StyleName(..)-       ) where--import Data.GraphViz.Attributes.Colors-import Data.GraphViz.Attributes.Colors.X11(X11Color(Transparent, Black))-import qualified Data.GraphViz.Attributes.HTML as Html-import Data.GraphViz.Attributes.Internal-import Data.GraphViz.Util-import Data.GraphViz.Parsing-import Data.GraphViz.Printing-import Data.GraphViz.State(getLayerSep, setLayerSep)-import Data.GraphViz.Exception(GraphvizException(NotCustomAttr), throw)--import Data.List(partition, intercalate)-import Data.Maybe(isJust)-import Data.Word(Word16)-import qualified Data.Set as S-import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)-import Control.Monad(liftM, liftM2)-import System.FilePath(searchPathSeparator, splitSearchPath)---- -------------------------------------------------------------------------------{- $attributes--   These attributes have been implemented in a /permissive/ manner:-   that is, rather than split them up based on which type of value-   they are allowed, they have all been included in the one data type,-   with functions to determine if they are indeed valid for what-   they're being applied to.--   To interpret the /Valid for/ listings:--     [@G@] Valid for Graphs.--     [@C@] Valid for Clusters.--     [@S@] Valid for Sub-Graphs (and also Clusters).--     [@N@] Valid for Nodes.--     [@E@] Valid for Edges.--   The /Default/ listings are those that the various Graphviz commands-   use if that 'Attribute' isn't specified (in cases where this is-   /none/, this is equivalent to a 'Nothing' value; that is, no value-   is used).  The /Parsing Default/ listings represent what value is-   used (i.e. corresponds to 'True') when the 'Attribute' name is-   listed on its own in /Dot/ source code.--   Please note that the 'UnknownAttribute' 'Attribute' is defined-   primarily for backwards-compatibility purposes.  It is possible to use-   it directly for custom purposes; for more information, please see-   'CustomAttribute'.  The 'deleteCustomAttributes' can be used to delete-   these values.-- -}---- | Attributes are used to customise the layout and design of Dot---   graphs.  Care must be taken to ensure that the attribute you use---   is valid, as not all attributes can be used everywhere.-data Attribute-  = Damping Double                      -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only-  | K Double                            -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only-  | URL EscString                       -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only-  | ArrowHead ArrowType                 -- ^ /Valid for/: E; /Default/: @'AType' [('noMods', 'Normal')]@-  | ArrowSize Double                    -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@-  | ArrowTail ArrowType                 -- ^ /Valid for/: E; /Default/: @'AType' [('noMods', 'Normal')]@-  | Aspect AspectType                   -- ^ /Valid for/: G; /Notes/: dot only-  | BoundingBox Rect                    -- ^ /Valid for/: G; /Notes/: write only-  | ColorScheme ColorScheme             -- ^ /Valid for/: ENCG; /Default/: @'X11'@-  | BgColor [Color]                     -- ^ /Valid for/: GC; /Default/: @['X11Color' 'Transparent']@-  | Center Bool                         -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'-  | ClusterRank ClusterMode             -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only-  | Color [Color]                       -- ^ /Valid for/: ENC; /Default/: @['X11Color' 'Black']@-  | Comment Text                        -- ^ /Valid for/: ENG; /Default/: @\"\"@-  | Compound Bool                       -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only-  | Concentrate Bool                    -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'-  | Constraint Bool                     -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: dot only-  | Decorate Bool                       -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'-  | DefaultDist Double                  -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(|V|)@; /Minimum/: @epsilon@; /Notes/: neato only, only if @'Pack' 'DontPack'@-  | Dim Int                             -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only-  | Dimen Int                           -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only-  | Dir DirType                         -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)-  | DirEdgeConstraints DEConstraints    -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only-  | Distortion Double                   -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@-  | DPI Double                          -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym-  | EdgeURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-  | EdgeTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only-  | EdgeTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only-  | Epsilon Double                      -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only-  | ESep DPoint                         -- ^ /Valid for/: G; /Default/: @'DVal' 3@; /Notes/: not dot-  | FillColor [Color]                   -- ^ /Valid for/: NEC; /Default/: @['X11Color' 'LightGray']@ (nodes), @['X11Color' 'Black']@ (clusters)-  | FixedSize Bool                      -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'-  | FontColor Color                     -- ^ /Valid for/: ENGC; /Default/: @'X11Color' 'Black'@-  | FontName Text                       -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@-  | FontNames Text                      -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only-  | FontPath Text                       -- ^ /Valid for/: G; /Default/: system dependent-  | FontSize Double                     -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@-  | ForceLabels Bool                    -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: Only for 'XLabel' attributes, requires Graphviz >= 2.29.0-  | GradientAngle Int                   -- ^ /Valid for/: NCG; /Default/: 0; /Notes/: requires Graphviz >= 2.29.0-  | Group Text                          -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only-  | HeadURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-  | HeadClip Bool                       -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'-  | HeadLabel Label                     -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@-  | HeadPort PortPos                    -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@-  | HeadTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only-  | HeadTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only-  | Height Double                       -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@-  | ID EscString                        -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only-  | Image Text                          -- ^ /Valid for/: N; /Default/: @\"\"@-  | ImagePath Paths                     -- ^ /Valid for/: G; /Default/: @'Paths' []@; /Notes/: Printing and parsing is OS-specific, requires Graphviz >= 2.29.0-  | ImageScale ScaleType                -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'-  | Label Label                         -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)-  | LabelURL EscString                  -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-  | LabelScheme LabelScheme             -- ^ /Valid for/: G; /Default/: @'NotEdgeLabel'@; /Notes/: sfdp only, requires Graphviz >= 2.28.0-  | LabelAngle Double                   -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@-  | LabelDistance Double                -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@-  | LabelFloat Bool                     -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'-  | LabelFontColor Color                -- ^ /Valid for/: E; /Default/: @'X11Color' 'Black'@-  | LabelFontName Text                  -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@-  | LabelFontSize Double                -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@-  | LabelJust Justification             -- ^ /Valid for/: GC; /Default/: @'JCenter'@-  | LabelLoc VerticalPlacement          -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)-  | LabelTarget EscString               -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only-  | LabelTooltip EscString              -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only-  | Landscape Bool                      -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'-  | Layer LayerRange                    -- ^ /Valid for/: EN-  | Layers LayerList                    -- ^ /Valid for/: G; /Default/: @'LL' []@-  | LayerSep LayerSep                   -- ^ /Valid for/: G; /Default/: @'LSep' \" :\t\"@-  | Layout Text                         -- ^ /Valid for/: G; /Default/: @\"\"@-  | Len Double                          -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only-  | LevelsGap Double                    -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only-  | Levels Int                          -- ^ /Valid for/: G; /Default/: @'maxBound'@; /Minimum/: @0@; /Notes/: sfdp only-  | LHead Text                          -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only-  | LHeight Double                      -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0-  | LPos Point                          -- ^ /Valid for/: EGC; /Notes/: write only-  | LTail Text                          -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only-  | LWidth Double                       -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0-  | Margin DPoint                       -- ^ /Valid for/: NG; /Default/: device dependent-  | MaxIter Int                         -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp); /Notes/: fdp, neato only-  | MCLimit Double                      -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: dot only-  | MinDist Double                      -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: circo only-  | MinLen Int                          -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: dot only-  | Mode ModeType                       -- ^ /Valid for/: G; /Default/: @'Major'@; /Notes/: neato only-  | Model Model                         -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only-  | Mosek Bool                          -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: neato only; requires the Mosek software-  | NodeSep Double                      -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@; /Notes/: dot only-  | NoJustify Bool                      -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True'-  | Normalize Bool                      -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: not dot-  | Nslimit Double                      -- ^ /Valid for/: G; /Notes/: dot only-  | Nslimit1 Double                     -- ^ /Valid for/: G; /Notes/: dot only-  | Ordering Order                      -- ^ /Valid for/: GN; /Default/: none; /Notes/: dot only-  | Orientation Double                  -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@-  | OutputOrder OutputMode              -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@-  | Overlap Overlap                     -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot-  | OverlapScaling Double               -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only-  | Pack Pack                           -- ^ /Valid for/: G; /Default/: @'DontPack'@; /Parsing Default/: 'DoPack'; /Notes/: not dot-  | PackMode PackMode                   -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot-  | Pad DPoint                          -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)-  | Page Point                          -- ^ /Valid for/: G-  | PageDir PageDir                     -- ^ /Valid for/: G; /Default/: @'Bl'@-  | PenColor Color                      -- ^ /Valid for/: C; /Default/: @'X11Color' 'Black'@-  | PenWidth Double                     -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@-  | Peripheries Int                     -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0-  | Pin Bool                            -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only-  | Pos Pos                             -- ^ /Valid for/: EN-  | QuadTree QuadType                   -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only-  | Quantum Double                      -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@-  | Rank RankType                       -- ^ /Valid for/: S; /Notes/: dot only-  | RankDir RankDir                     -- ^ /Valid for/: G; /Default/: @'FromTop'@; /Notes/: dot only-  | RankSep [Double]                    -- ^ /Valid for/: G; /Default/: @[0.5]@ (dot), @[1.0]@ (twopi); /Minimum/: [0.02]; /Notes/: twopi, dot only-  | Ratio Ratios                        -- ^ /Valid for/: G-  | Rects [Rect]                        -- ^ /Valid for/: N; /Notes/: write only-  | Regular Bool                        -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'-  | ReMinCross Bool                     -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only-  | RepulsiveForce Double               -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: sfdp only-  | Root Root                           -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: circo, twopi only-  | Rotate Int                          -- ^ /Valid for/: G; /Default/: @0@-  | Rotation Double                     -- ^ /Valid for/: G; /Default/: @0@; /Notes/: sfdp only, requires Graphviz >= 2.28.0-  | SameHead Text                       -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only-  | SameTail Text                       -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only-  | SamplePoints Int                    -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)-  | Scale DPoint                        -- ^ /Valid for/: G; /Notes/: twopi only, requires Graphviz >= 2.28.0-  | SearchSize Int                      -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only-  | Sep DPoint                          -- ^ /Valid for/: G; /Default/: @'DVal' 4@; /Notes/: not dot-  | Shape Shape                         -- ^ /Valid for/: N; /Default/: @'Ellipse'@-  | ShapeFile Text                      -- ^ /Valid for/: N; /Default/: @\"\"@-  | ShowBoxes Int                       -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only-  | Sides Int                           -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@-  | Size Point                          -- ^ /Valid for/: G-  | Skew Double                         -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@-  | Smoothing SmoothType                -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only-  | SortV Word16                        -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@-  | Splines EdgeType                    -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges'-  | Start StartType                     -- ^ /Valid for/: G; /Notes/: fdp, neato only-  | Style [StyleItem]                   -- ^ /Valid for/: ENC-  | StyleSheet Text                     -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only-  | TailURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-  | TailClip Bool                       -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'-  | TailLabel Label                     -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@-  | TailPort PortPos                    -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@-  | TailTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only-  | TailTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only-  | Target EscString                    -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only-  | Tooltip EscString                   -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only-  | TrueColor Bool                      -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only-  | Vertices [Point]                    -- ^ /Valid for/: N; /Notes/: write only-  | ViewPort ViewPort                   -- ^ /Valid for/: G; /Default/: none-  | VoroMargin Double                   -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not dot-  | Weight Double                       -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0@ (dot), @1@ (neato,fdp,sfdp)-  | Width Double                        -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@-  | XLabel Label                        -- ^ /Valid for/: EN; /Default/: @'StrLabel' \"\"@; /Notes/: requires Graphviz >= 2.29.0-  | Z Double                            -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-MAXFLOAT@, @-1000@-  | UnknownAttribute AttributeName Text -- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively.-  deriving (Eq, Ord, Show, Read)--type Attributes = [Attribute]---- | The name for an UnknownAttribute; must satisfy  'validUnknown'.-type AttributeName = Text--instance PrintDot Attribute where-  unqtDot (Damping v)            = printField "Damping" v-  unqtDot (K v)                  = printField "K" v-  unqtDot (URL v)                = printField "URL" v-  unqtDot (ArrowHead v)          = printField "arrowhead" v-  unqtDot (ArrowSize v)          = printField "arrowsize" v-  unqtDot (ArrowTail v)          = printField "arrowtail" v-  unqtDot (Aspect v)             = printField "aspect" v-  unqtDot (BoundingBox v)        = printField "bb" v-  unqtDot (ColorScheme v)        = printField "colorscheme" v-  unqtDot (BgColor v)            = printField "bgcolor" v-  unqtDot (Center v)             = printField "center" v-  unqtDot (ClusterRank v)        = printField "clusterrank" v-  unqtDot (Color v)              = printField "color" v-  unqtDot (Comment v)            = printField "comment" v-  unqtDot (Compound v)           = printField "compound" v-  unqtDot (Concentrate v)        = printField "concentrate" v-  unqtDot (Constraint v)         = printField "constraint" v-  unqtDot (Decorate v)           = printField "decorate" v-  unqtDot (DefaultDist v)        = printField "defaultdist" v-  unqtDot (Dim v)                = printField "dim" v-  unqtDot (Dimen v)              = printField "dimen" v-  unqtDot (Dir v)                = printField "dir" v-  unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v-  unqtDot (Distortion v)         = printField "distortion" v-  unqtDot (DPI v)                = printField "dpi" v-  unqtDot (EdgeURL v)            = printField "edgeURL" v-  unqtDot (EdgeTarget v)         = printField "edgetarget" v-  unqtDot (EdgeTooltip v)        = printField "edgetooltip" v-  unqtDot (Epsilon v)            = printField "epsilon" v-  unqtDot (ESep v)               = printField "esep" v-  unqtDot (FillColor v)          = printField "fillcolor" v-  unqtDot (FixedSize v)          = printField "fixedsize" v-  unqtDot (FontColor v)          = printField "fontcolor" v-  unqtDot (FontName v)           = printField "fontname" v-  unqtDot (FontNames v)          = printField "fontnames" v-  unqtDot (FontPath v)           = printField "fontpath" v-  unqtDot (FontSize v)           = printField "fontsize" v-  unqtDot (ForceLabels v)        = printField "forcelabels" v-  unqtDot (GradientAngle v)      = printField "gradientangle" v-  unqtDot (Group v)              = printField "group" v-  unqtDot (HeadURL v)            = printField "headURL" v-  unqtDot (HeadClip v)           = printField "headclip" v-  unqtDot (HeadLabel v)          = printField "headlabel" v-  unqtDot (HeadPort v)           = printField "headport" v-  unqtDot (HeadTarget v)         = printField "headtarget" v-  unqtDot (HeadTooltip v)        = printField "headtooltip" v-  unqtDot (Height v)             = printField "height" v-  unqtDot (ID v)                 = printField "id" v-  unqtDot (Image v)              = printField "image" v-  unqtDot (ImagePath v)          = printField "imagepath" v-  unqtDot (ImageScale v)         = printField "imagescale" v-  unqtDot (Label v)              = printField "label" v-  unqtDot (LabelURL v)           = printField "labelURL" v-  unqtDot (LabelScheme v)        = printField "label_scheme" v-  unqtDot (LabelAngle v)         = printField "labelangle" v-  unqtDot (LabelDistance v)      = printField "labeldistance" v-  unqtDot (LabelFloat v)         = printField "labelfloat" v-  unqtDot (LabelFontColor v)     = printField "labelfontcolor" v-  unqtDot (LabelFontName v)      = printField "labelfontname" v-  unqtDot (LabelFontSize v)      = printField "labelfontsize" v-  unqtDot (LabelJust v)          = printField "labeljust" v-  unqtDot (LabelLoc v)           = printField "labelloc" v-  unqtDot (LabelTarget v)        = printField "labeltarget" v-  unqtDot (LabelTooltip v)       = printField "labeltooltip" v-  unqtDot (Landscape v)          = printField "landscape" v-  unqtDot (Layer v)              = printField "layer" v-  unqtDot (Layers v)             = printField "layers" v-  unqtDot (LayerSep v)           = printField "layersep" v-  unqtDot (Layout v)             = printField "layout" v-  unqtDot (Len v)                = printField "len" v-  unqtDot (LevelsGap v)          = printField "levelsgap" v-  unqtDot (Levels v)             = printField "levels" v-  unqtDot (LHead v)              = printField "lhead" v-  unqtDot (LHeight v)            = printField "LHeight" v-  unqtDot (LPos v)               = printField "lp" v-  unqtDot (LTail v)              = printField "ltail" v-  unqtDot (LWidth v)             = printField "lwidth" v-  unqtDot (Margin v)             = printField "margin" v-  unqtDot (MaxIter v)            = printField "maxiter" v-  unqtDot (MCLimit v)            = printField "mclimit" v-  unqtDot (MinDist v)            = printField "mindist" v-  unqtDot (MinLen v)             = printField "minlen" v-  unqtDot (Mode v)               = printField "mode" v-  unqtDot (Model v)              = printField "model" v-  unqtDot (Mosek v)              = printField "mosek" v-  unqtDot (NodeSep v)            = printField "nodesep" v-  unqtDot (NoJustify v)          = printField "nojustify" v-  unqtDot (Normalize v)          = printField "normalize" v-  unqtDot (Nslimit v)            = printField "nslimit" v-  unqtDot (Nslimit1 v)           = printField "nslimit1" v-  unqtDot (Ordering v)           = printField "ordering" v-  unqtDot (Orientation v)        = printField "orientation" v-  unqtDot (OutputOrder v)        = printField "outputorder" v-  unqtDot (Overlap v)            = printField "overlap" v-  unqtDot (OverlapScaling v)     = printField "overlap_scaling" v-  unqtDot (Pack v)               = printField "pack" v-  unqtDot (PackMode v)           = printField "packmode" v-  unqtDot (Pad v)                = printField "pad" v-  unqtDot (Page v)               = printField "page" v-  unqtDot (PageDir v)            = printField "pagedir" v-  unqtDot (PenColor v)           = printField "pencolor" v-  unqtDot (PenWidth v)           = printField "penwidth" v-  unqtDot (Peripheries v)        = printField "peripheries" v-  unqtDot (Pin v)                = printField "pin" v-  unqtDot (Pos v)                = printField "pos" v-  unqtDot (QuadTree v)           = printField "quadtree" v-  unqtDot (Quantum v)            = printField "quantum" v-  unqtDot (Rank v)               = printField "rank" v-  unqtDot (RankDir v)            = printField "rankdir" v-  unqtDot (RankSep v)            = printField "ranksep" v-  unqtDot (Ratio v)              = printField "ratio" v-  unqtDot (Rects v)              = printField "rects" v-  unqtDot (Regular v)            = printField "regular" v-  unqtDot (ReMinCross v)         = printField "remincross" v-  unqtDot (RepulsiveForce v)     = printField "repulsiveforce" v-  unqtDot (Root v)               = printField "root" v-  unqtDot (Rotate v)             = printField "rotate" v-  unqtDot (Rotation v)           = printField "rotation" v-  unqtDot (SameHead v)           = printField "samehead" v-  unqtDot (SameTail v)           = printField "sametail" v-  unqtDot (SamplePoints v)       = printField "samplepoints" v-  unqtDot (Scale v)              = printField "scale" v-  unqtDot (SearchSize v)         = printField "searchsize" v-  unqtDot (Sep v)                = printField "sep" v-  unqtDot (Shape v)              = printField "shape" v-  unqtDot (ShapeFile v)          = printField "shapefile" v-  unqtDot (ShowBoxes v)          = printField "showboxes" v-  unqtDot (Sides v)              = printField "sides" v-  unqtDot (Size v)               = printField "size" v-  unqtDot (Skew v)               = printField "skew" v-  unqtDot (Smoothing v)          = printField "smoothing" v-  unqtDot (SortV v)              = printField "sortv" v-  unqtDot (Splines v)            = printField "splines" v-  unqtDot (Start v)              = printField "start" v-  unqtDot (Style v)              = printField "style" v-  unqtDot (StyleSheet v)         = printField "stylesheet" v-  unqtDot (TailURL v)            = printField "tailURL" v-  unqtDot (TailClip v)           = printField "tailclip" v-  unqtDot (TailLabel v)          = printField "taillabel" v-  unqtDot (TailPort v)           = printField "tailport" v-  unqtDot (TailTarget v)         = printField "tailtarget" v-  unqtDot (TailTooltip v)        = printField "tailtooltip" v-  unqtDot (Target v)             = printField "target" v-  unqtDot (Tooltip v)            = printField "tooltip" v-  unqtDot (TrueColor v)          = printField "truecolor" v-  unqtDot (Vertices v)           = printField "vertices" v-  unqtDot (ViewPort v)           = printField "viewport" v-  unqtDot (VoroMargin v)         = printField "voro_margin" v-  unqtDot (Weight v)             = printField "weight" v-  unqtDot (Width v)              = printField "width" v-  unqtDot (XLabel v)             = printField "xlabel" v-  unqtDot (Z v)                  = printField "z" v-  unqtDot (UnknownAttribute a v) = toDot a <> equals <> toDot v--  listToDot = unqtListToDot--instance ParseDot Attribute where-  parseUnqt = stringParse (concat [ parseField Damping "Damping"-                                  , parseField K "K"-                                  , parseFields URL ["URL", "href"]-                                  , parseField ArrowHead "arrowhead"-                                  , parseField ArrowSize "arrowsize"-                                  , parseField ArrowTail "arrowtail"-                                  , parseField Aspect "aspect"-                                  , parseField BoundingBox "bb"-                                  , parseField ColorScheme "colorscheme"-                                  , parseField BgColor "bgcolor"-                                  , parseFieldBool Center "center"-                                  , parseField ClusterRank "clusterrank"-                                  , parseField Color "color"-                                  , parseField Comment "comment"-                                  , parseFieldBool Compound "compound"-                                  , parseFieldBool Concentrate "concentrate"-                                  , parseFieldBool Constraint "constraint"-                                  , parseFieldBool Decorate "decorate"-                                  , parseField DefaultDist "defaultdist"-                                  , parseField Dim "dim"-                                  , parseField Dimen "dimen"-                                  , parseField Dir "dir"-                                  , parseFieldDef DirEdgeConstraints EdgeConstraints "diredgeconstraints"-                                  , parseField Distortion "distortion"-                                  , parseFields DPI ["dpi", "resolution"]-                                  , parseFields EdgeURL ["edgeURL", "edgehref"]-                                  , parseField EdgeTarget "edgetarget"-                                  , parseField EdgeTooltip "edgetooltip"-                                  , parseField Epsilon "epsilon"-                                  , parseField ESep "esep"-                                  , parseField FillColor "fillcolor"-                                  , parseFieldBool FixedSize "fixedsize"-                                  , parseField FontColor "fontcolor"-                                  , parseField FontName "fontname"-                                  , parseField FontNames "fontnames"-                                  , parseField FontPath "fontpath"-                                  , parseField FontSize "fontsize"-                                  , parseFieldBool ForceLabels "forcelabels"-                                  , parseField GradientAngle "gradientangle"-                                  , parseField Group "group"-                                  , parseFields HeadURL ["headURL", "headhref"]-                                  , parseFieldBool HeadClip "headclip"-                                  , parseField HeadLabel "headlabel"-                                  , parseField HeadPort "headport"-                                  , parseField HeadTarget "headtarget"-                                  , parseField HeadTooltip "headtooltip"-                                  , parseField Height "height"-                                  , parseField ID "id"-                                  , parseField Image "image"-                                  , parseField ImagePath "imagepath"-                                  , parseFieldDef ImageScale UniformScale "imagescale"-                                  , parseField Label "label"-                                  , parseFields LabelURL ["labelURL", "labelhref"]-                                  , parseField LabelScheme "label_scheme"-                                  , parseField LabelAngle "labelangle"-                                  , parseField LabelDistance "labeldistance"-                                  , parseFieldBool LabelFloat "labelfloat"-                                  , parseField LabelFontColor "labelfontcolor"-                                  , parseField LabelFontName "labelfontname"-                                  , parseField LabelFontSize "labelfontsize"-                                  , parseField LabelJust "labeljust"-                                  , parseField LabelLoc "labelloc"-                                  , parseField LabelTarget "labeltarget"-                                  , parseField LabelTooltip "labeltooltip"-                                  , parseFieldBool Landscape "landscape"-                                  , parseField Layer "layer"-                                  , parseField Layers "layers"-                                  , parseField LayerSep "layersep"-                                  , parseField Layout "layout"-                                  , parseField Len "len"-                                  , parseField LevelsGap "levelsgap"-                                  , parseField Levels "levels"-                                  , parseField LHead "lhead"-                                  , parseField LHeight "LHeight"-                                  , parseField LPos "lp"-                                  , parseField LTail "ltail"-                                  , parseField LWidth "lwidth"-                                  , parseField Margin "margin"-                                  , parseField MaxIter "maxiter"-                                  , parseField MCLimit "mclimit"-                                  , parseField MinDist "mindist"-                                  , parseField MinLen "minlen"-                                  , parseField Mode "mode"-                                  , parseField Model "model"-                                  , parseFieldBool Mosek "mosek"-                                  , parseField NodeSep "nodesep"-                                  , parseFieldBool NoJustify "nojustify"-                                  , parseFieldBool Normalize "normalize"-                                  , parseField Nslimit "nslimit"-                                  , parseField Nslimit1 "nslimit1"-                                  , parseField Ordering "ordering"-                                  , parseField Orientation "orientation"-                                  , parseField OutputOrder "outputorder"-                                  , parseFieldDef Overlap KeepOverlaps "overlap"-                                  , parseField OverlapScaling "overlap_scaling"-                                  , parseFieldDef Pack DoPack "pack"-                                  , parseField PackMode "packmode"-                                  , parseField Pad "pad"-                                  , parseField Page "page"-                                  , parseField PageDir "pagedir"-                                  , parseField PenColor "pencolor"-                                  , parseField PenWidth "penwidth"-                                  , parseField Peripheries "peripheries"-                                  , parseFieldBool Pin "pin"-                                  , parseField Pos "pos"-                                  , parseFieldDef QuadTree NormalQT "quadtree"-                                  , parseField Quantum "quantum"-                                  , parseField Rank "rank"-                                  , parseField RankDir "rankdir"-                                  , parseField RankSep "ranksep"-                                  , parseField Ratio "ratio"-                                  , parseField Rects "rects"-                                  , parseFieldBool Regular "regular"-                                  , parseFieldBool ReMinCross "remincross"-                                  , parseField RepulsiveForce "repulsiveforce"-                                  , parseFieldDef Root IsCentral "root"-                                  , parseField Rotate "rotate"-                                  , parseField Rotation "rotation"-                                  , parseField SameHead "samehead"-                                  , parseField SameTail "sametail"-                                  , parseField SamplePoints "samplepoints"-                                  , parseField Scale "scale"-                                  , parseField SearchSize "searchsize"-                                  , parseField Sep "sep"-                                  , parseField Shape "shape"-                                  , parseField ShapeFile "shapefile"-                                  , parseField ShowBoxes "showboxes"-                                  , parseField Sides "sides"-                                  , parseField Size "size"-                                  , parseField Skew "skew"-                                  , parseField Smoothing "smoothing"-                                  , parseField SortV "sortv"-                                  , parseFieldDef Splines SplineEdges "splines"-                                  , parseField Start "start"-                                  , parseField Style "style"-                                  , parseField StyleSheet "stylesheet"-                                  , parseFields TailURL ["tailURL", "tailhref"]-                                  , parseFieldBool TailClip "tailclip"-                                  , parseField TailLabel "taillabel"-                                  , parseField TailPort "tailport"-                                  , parseField TailTarget "tailtarget"-                                  , parseField TailTooltip "tailtooltip"-                                  , parseField Target "target"-                                  , parseField Tooltip "tooltip"-                                  , parseFieldBool TrueColor "truecolor"-                                  , parseField Vertices "vertices"-                                  , parseField ViewPort "viewport"-                                  , parseField VoroMargin "voro_margin"-                                  , parseField Weight "weight"-                                  , parseField Width "width"-                                  , parseField XLabel "xlabel"-                                  , parseField Z "z"-                                  ])-              `onFail`-              liftM2 UnknownAttribute stringBlock (parseEq >> parse)--  parse = parseUnqt--  parseList = parseUnqtList---- | Determine if this 'Attribute' is valid for use with Graphs.-usedByGraphs                      :: Attribute -> Bool-usedByGraphs Damping{}            = True-usedByGraphs K{}                  = True-usedByGraphs URL{}                = True-usedByGraphs Aspect{}             = True-usedByGraphs BoundingBox{}        = True-usedByGraphs ColorScheme{}        = True-usedByGraphs BgColor{}            = True-usedByGraphs Center{}             = True-usedByGraphs ClusterRank{}        = True-usedByGraphs Comment{}            = True-usedByGraphs Compound{}           = True-usedByGraphs Concentrate{}        = True-usedByGraphs DefaultDist{}        = True-usedByGraphs Dim{}                = True-usedByGraphs Dimen{}              = True-usedByGraphs DirEdgeConstraints{} = True-usedByGraphs DPI{}                = True-usedByGraphs Epsilon{}            = True-usedByGraphs ESep{}               = True-usedByGraphs FontColor{}          = True-usedByGraphs FontName{}           = True-usedByGraphs FontNames{}          = True-usedByGraphs FontPath{}           = True-usedByGraphs FontSize{}           = True-usedByGraphs ForceLabels{}        = True-usedByGraphs GradientAngle{}      = True-usedByGraphs ID{}                 = True-usedByGraphs ImagePath{}          = True-usedByGraphs Label{}              = True-usedByGraphs LabelScheme{}        = True-usedByGraphs LabelJust{}          = True-usedByGraphs LabelLoc{}           = True-usedByGraphs Landscape{}          = True-usedByGraphs Layers{}             = True-usedByGraphs LayerSep{}           = True-usedByGraphs Layout{}             = True-usedByGraphs LevelsGap{}          = True-usedByGraphs Levels{}             = True-usedByGraphs LHeight{}            = True-usedByGraphs LPos{}               = True-usedByGraphs LWidth{}             = True-usedByGraphs Margin{}             = True-usedByGraphs MaxIter{}            = True-usedByGraphs MCLimit{}            = True-usedByGraphs MinDist{}            = True-usedByGraphs Mode{}               = True-usedByGraphs Model{}              = True-usedByGraphs Mosek{}              = True-usedByGraphs NodeSep{}            = True-usedByGraphs NoJustify{}          = True-usedByGraphs Normalize{}          = True-usedByGraphs Nslimit{}            = True-usedByGraphs Nslimit1{}           = True-usedByGraphs Ordering{}           = True-usedByGraphs OutputOrder{}        = True-usedByGraphs Overlap{}            = True-usedByGraphs OverlapScaling{}     = True-usedByGraphs Pack{}               = True-usedByGraphs PackMode{}           = True-usedByGraphs Pad{}                = True-usedByGraphs Page{}               = True-usedByGraphs PageDir{}            = True-usedByGraphs QuadTree{}           = True-usedByGraphs Quantum{}            = True-usedByGraphs RankDir{}            = True-usedByGraphs RankSep{}            = True-usedByGraphs Ratio{}              = True-usedByGraphs ReMinCross{}         = True-usedByGraphs RepulsiveForce{}     = True-usedByGraphs Root{}               = True-usedByGraphs Rotate{}             = True-usedByGraphs Rotation{}           = True-usedByGraphs Scale{}              = True-usedByGraphs SearchSize{}         = True-usedByGraphs Sep{}                = True-usedByGraphs ShowBoxes{}          = True-usedByGraphs Size{}               = True-usedByGraphs Smoothing{}          = True-usedByGraphs SortV{}              = True-usedByGraphs Splines{}            = True-usedByGraphs Start{}              = True-usedByGraphs StyleSheet{}         = True-usedByGraphs Target{}             = True-usedByGraphs TrueColor{}          = True-usedByGraphs ViewPort{}           = True-usedByGraphs VoroMargin{}         = True-usedByGraphs UnknownAttribute{}   = True-usedByGraphs _                    = False---- | Determine if this 'Attribute' is valid for use with Clusters.-usedByClusters                    :: Attribute -> Bool-usedByClusters K{}                = True-usedByClusters URL{}              = True-usedByClusters ColorScheme{}      = True-usedByClusters BgColor{}          = True-usedByClusters Color{}            = True-usedByClusters FillColor{}        = True-usedByClusters FontColor{}        = True-usedByClusters FontName{}         = True-usedByClusters FontSize{}         = True-usedByClusters GradientAngle{}    = True-usedByClusters Label{}            = True-usedByClusters LabelJust{}        = True-usedByClusters LabelLoc{}         = True-usedByClusters LHeight{}          = True-usedByClusters LPos{}             = True-usedByClusters LWidth{}           = True-usedByClusters NoJustify{}        = True-usedByClusters PenColor{}         = True-usedByClusters PenWidth{}         = True-usedByClusters Peripheries{}      = True-usedByClusters Rank{}             = True-usedByClusters SortV{}            = True-usedByClusters Style{}            = True-usedByClusters Target{}           = True-usedByClusters Tooltip{}          = True-usedByClusters UnknownAttribute{} = True-usedByClusters _                  = False---- | Determine if this 'Attribute' is valid for use with SubGraphs.-usedBySubGraphs                    :: Attribute -> Bool-usedBySubGraphs Rank{}             = True-usedBySubGraphs UnknownAttribute{} = True-usedBySubGraphs _                  = False---- | Determine if this 'Attribute' is valid for use with Nodes.-usedByNodes                    :: Attribute -> Bool-usedByNodes URL{}              = True-usedByNodes ColorScheme{}      = True-usedByNodes Color{}            = True-usedByNodes Comment{}          = True-usedByNodes Distortion{}       = True-usedByNodes FillColor{}        = True-usedByNodes FixedSize{}        = True-usedByNodes FontColor{}        = True-usedByNodes FontName{}         = True-usedByNodes FontSize{}         = True-usedByNodes GradientAngle{}    = True-usedByNodes Group{}            = True-usedByNodes Height{}           = True-usedByNodes ID{}               = True-usedByNodes Image{}            = True-usedByNodes ImageScale{}       = True-usedByNodes Label{}            = True-usedByNodes LabelLoc{}         = True-usedByNodes Layer{}            = True-usedByNodes Margin{}           = True-usedByNodes NoJustify{}        = True-usedByNodes Ordering{}         = True-usedByNodes Orientation{}      = True-usedByNodes PenWidth{}         = True-usedByNodes Peripheries{}      = True-usedByNodes Pin{}              = True-usedByNodes Pos{}              = True-usedByNodes Rects{}            = True-usedByNodes Regular{}          = True-usedByNodes Root{}             = True-usedByNodes SamplePoints{}     = True-usedByNodes Shape{}            = True-usedByNodes ShapeFile{}        = True-usedByNodes ShowBoxes{}        = True-usedByNodes Sides{}            = True-usedByNodes Skew{}             = True-usedByNodes SortV{}            = True-usedByNodes Style{}            = True-usedByNodes Target{}           = True-usedByNodes Tooltip{}          = True-usedByNodes Vertices{}         = True-usedByNodes Width{}            = True-usedByNodes XLabel{}           = True-usedByNodes Z{}                = True-usedByNodes UnknownAttribute{} = True-usedByNodes _                  = False---- | Determine if this 'Attribute' is valid for use with Edges.-usedByEdges                    :: Attribute -> Bool-usedByEdges URL{}              = True-usedByEdges ArrowHead{}        = True-usedByEdges ArrowSize{}        = True-usedByEdges ArrowTail{}        = True-usedByEdges ColorScheme{}      = True-usedByEdges Color{}            = True-usedByEdges Comment{}          = True-usedByEdges Constraint{}       = True-usedByEdges Decorate{}         = True-usedByEdges Dir{}              = True-usedByEdges EdgeURL{}          = True-usedByEdges EdgeTarget{}       = True-usedByEdges EdgeTooltip{}      = True-usedByEdges FillColor{}        = True-usedByEdges FontColor{}        = True-usedByEdges FontName{}         = True-usedByEdges FontSize{}         = True-usedByEdges HeadURL{}          = True-usedByEdges HeadClip{}         = True-usedByEdges HeadLabel{}        = True-usedByEdges HeadPort{}         = True-usedByEdges HeadTarget{}       = True-usedByEdges HeadTooltip{}      = True-usedByEdges ID{}               = True-usedByEdges Label{}            = True-usedByEdges LabelURL{}         = True-usedByEdges LabelAngle{}       = True-usedByEdges LabelDistance{}    = True-usedByEdges LabelFloat{}       = True-usedByEdges LabelFontColor{}   = True-usedByEdges LabelFontName{}    = True-usedByEdges LabelFontSize{}    = True-usedByEdges LabelTarget{}      = True-usedByEdges LabelTooltip{}     = True-usedByEdges Layer{}            = True-usedByEdges Len{}              = True-usedByEdges LHead{}            = True-usedByEdges LPos{}             = True-usedByEdges LTail{}            = True-usedByEdges MinLen{}           = True-usedByEdges NoJustify{}        = True-usedByEdges PenWidth{}         = True-usedByEdges Pos{}              = True-usedByEdges SameHead{}         = True-usedByEdges SameTail{}         = True-usedByEdges ShowBoxes{}        = True-usedByEdges Style{}            = True-usedByEdges TailURL{}          = True-usedByEdges TailClip{}         = True-usedByEdges TailLabel{}        = True-usedByEdges TailPort{}         = True-usedByEdges TailTarget{}       = True-usedByEdges TailTooltip{}      = True-usedByEdges Target{}           = True-usedByEdges Tooltip{}          = True-usedByEdges Weight{}           = True-usedByEdges XLabel{}           = True-usedByEdges UnknownAttribute{} = True-usedByEdges _                  = False---- | Determine if two 'Attributes' are the same type of 'Attribute'.-sameAttribute                                                 :: Attribute -> Attribute -> Bool-sameAttribute Damping{}               Damping{}               = True-sameAttribute K{}                     K{}                     = True-sameAttribute URL{}                   URL{}                   = True-sameAttribute ArrowHead{}             ArrowHead{}             = True-sameAttribute ArrowSize{}             ArrowSize{}             = True-sameAttribute ArrowTail{}             ArrowTail{}             = True-sameAttribute Aspect{}                Aspect{}                = True-sameAttribute BoundingBox{}           BoundingBox{}           = True-sameAttribute ColorScheme{}           ColorScheme{}           = True-sameAttribute BgColor{}               BgColor{}               = True-sameAttribute Center{}                Center{}                = True-sameAttribute ClusterRank{}           ClusterRank{}           = True-sameAttribute Color{}                 Color{}                 = True-sameAttribute Comment{}               Comment{}               = True-sameAttribute Compound{}              Compound{}              = True-sameAttribute Concentrate{}           Concentrate{}           = True-sameAttribute Constraint{}            Constraint{}            = True-sameAttribute Decorate{}              Decorate{}              = True-sameAttribute DefaultDist{}           DefaultDist{}           = True-sameAttribute Dim{}                   Dim{}                   = True-sameAttribute Dimen{}                 Dimen{}                 = True-sameAttribute Dir{}                   Dir{}                   = True-sameAttribute DirEdgeConstraints{}    DirEdgeConstraints{}    = True-sameAttribute Distortion{}            Distortion{}            = True-sameAttribute DPI{}                   DPI{}                   = True-sameAttribute EdgeURL{}               EdgeURL{}               = True-sameAttribute EdgeTarget{}            EdgeTarget{}            = True-sameAttribute EdgeTooltip{}           EdgeTooltip{}           = True-sameAttribute Epsilon{}               Epsilon{}               = True-sameAttribute ESep{}                  ESep{}                  = True-sameAttribute FillColor{}             FillColor{}             = True-sameAttribute FixedSize{}             FixedSize{}             = True-sameAttribute FontColor{}             FontColor{}             = True-sameAttribute FontName{}              FontName{}              = True-sameAttribute FontNames{}             FontNames{}             = True-sameAttribute FontPath{}              FontPath{}              = True-sameAttribute FontSize{}              FontSize{}              = True-sameAttribute ForceLabels{}           ForceLabels{}           = True-sameAttribute GradientAngle{}         GradientAngle{}         = True-sameAttribute Group{}                 Group{}                 = True-sameAttribute HeadURL{}               HeadURL{}               = True-sameAttribute HeadClip{}              HeadClip{}              = True-sameAttribute HeadLabel{}             HeadLabel{}             = True-sameAttribute HeadPort{}              HeadPort{}              = True-sameAttribute HeadTarget{}            HeadTarget{}            = True-sameAttribute HeadTooltip{}           HeadTooltip{}           = True-sameAttribute Height{}                Height{}                = True-sameAttribute ID{}                    ID{}                    = True-sameAttribute Image{}                 Image{}                 = True-sameAttribute ImagePath{}             ImagePath{}             = True-sameAttribute ImageScale{}            ImageScale{}            = True-sameAttribute Label{}                 Label{}                 = True-sameAttribute LabelURL{}              LabelURL{}              = True-sameAttribute LabelScheme{}           LabelScheme{}           = True-sameAttribute LabelAngle{}            LabelAngle{}            = True-sameAttribute LabelDistance{}         LabelDistance{}         = True-sameAttribute LabelFloat{}            LabelFloat{}            = True-sameAttribute LabelFontColor{}        LabelFontColor{}        = True-sameAttribute LabelFontName{}         LabelFontName{}         = True-sameAttribute LabelFontSize{}         LabelFontSize{}         = True-sameAttribute LabelJust{}             LabelJust{}             = True-sameAttribute LabelLoc{}              LabelLoc{}              = True-sameAttribute LabelTarget{}           LabelTarget{}           = True-sameAttribute LabelTooltip{}          LabelTooltip{}          = True-sameAttribute Landscape{}             Landscape{}             = True-sameAttribute Layer{}                 Layer{}                 = True-sameAttribute Layers{}                Layers{}                = True-sameAttribute LayerSep{}              LayerSep{}              = True-sameAttribute Layout{}                Layout{}                = True-sameAttribute Len{}                   Len{}                   = True-sameAttribute LevelsGap{}             LevelsGap{}             = True-sameAttribute Levels{}                Levels{}                = True-sameAttribute LHead{}                 LHead{}                 = True-sameAttribute LHeight{}               LHeight{}               = True-sameAttribute LPos{}                  LPos{}                  = True-sameAttribute LTail{}                 LTail{}                 = True-sameAttribute LWidth{}                LWidth{}                = True-sameAttribute Margin{}                Margin{}                = True-sameAttribute MaxIter{}               MaxIter{}               = True-sameAttribute MCLimit{}               MCLimit{}               = True-sameAttribute MinDist{}               MinDist{}               = True-sameAttribute MinLen{}                MinLen{}                = True-sameAttribute Mode{}                  Mode{}                  = True-sameAttribute Model{}                 Model{}                 = True-sameAttribute Mosek{}                 Mosek{}                 = True-sameAttribute NodeSep{}               NodeSep{}               = True-sameAttribute NoJustify{}             NoJustify{}             = True-sameAttribute Normalize{}             Normalize{}             = True-sameAttribute Nslimit{}               Nslimit{}               = True-sameAttribute Nslimit1{}              Nslimit1{}              = True-sameAttribute Ordering{}              Ordering{}              = True-sameAttribute Orientation{}           Orientation{}           = True-sameAttribute OutputOrder{}           OutputOrder{}           = True-sameAttribute Overlap{}               Overlap{}               = True-sameAttribute OverlapScaling{}        OverlapScaling{}        = True-sameAttribute Pack{}                  Pack{}                  = True-sameAttribute PackMode{}              PackMode{}              = True-sameAttribute Pad{}                   Pad{}                   = True-sameAttribute Page{}                  Page{}                  = True-sameAttribute PageDir{}               PageDir{}               = True-sameAttribute PenColor{}              PenColor{}              = True-sameAttribute PenWidth{}              PenWidth{}              = True-sameAttribute Peripheries{}           Peripheries{}           = True-sameAttribute Pin{}                   Pin{}                   = True-sameAttribute Pos{}                   Pos{}                   = True-sameAttribute QuadTree{}              QuadTree{}              = True-sameAttribute Quantum{}               Quantum{}               = True-sameAttribute Rank{}                  Rank{}                  = True-sameAttribute RankDir{}               RankDir{}               = True-sameAttribute RankSep{}               RankSep{}               = True-sameAttribute Ratio{}                 Ratio{}                 = True-sameAttribute Rects{}                 Rects{}                 = True-sameAttribute Regular{}               Regular{}               = True-sameAttribute ReMinCross{}            ReMinCross{}            = True-sameAttribute RepulsiveForce{}        RepulsiveForce{}        = True-sameAttribute Root{}                  Root{}                  = True-sameAttribute Rotate{}                Rotate{}                = True-sameAttribute Rotation{}              Rotation{}              = True-sameAttribute SameHead{}              SameHead{}              = True-sameAttribute SameTail{}              SameTail{}              = True-sameAttribute SamplePoints{}          SamplePoints{}          = True-sameAttribute Scale{}                 Scale{}                 = True-sameAttribute SearchSize{}            SearchSize{}            = True-sameAttribute Sep{}                   Sep{}                   = True-sameAttribute Shape{}                 Shape{}                 = True-sameAttribute ShapeFile{}             ShapeFile{}             = True-sameAttribute ShowBoxes{}             ShowBoxes{}             = True-sameAttribute Sides{}                 Sides{}                 = True-sameAttribute Size{}                  Size{}                  = True-sameAttribute Skew{}                  Skew{}                  = True-sameAttribute Smoothing{}             Smoothing{}             = True-sameAttribute SortV{}                 SortV{}                 = True-sameAttribute Splines{}               Splines{}               = True-sameAttribute Start{}                 Start{}                 = True-sameAttribute Style{}                 Style{}                 = True-sameAttribute StyleSheet{}            StyleSheet{}            = True-sameAttribute TailURL{}               TailURL{}               = True-sameAttribute TailClip{}              TailClip{}              = True-sameAttribute TailLabel{}             TailLabel{}             = True-sameAttribute TailPort{}              TailPort{}              = True-sameAttribute TailTarget{}            TailTarget{}            = True-sameAttribute TailTooltip{}           TailTooltip{}           = True-sameAttribute Target{}                Target{}                = True-sameAttribute Tooltip{}               Tooltip{}               = True-sameAttribute TrueColor{}             TrueColor{}             = True-sameAttribute Vertices{}              Vertices{}              = True-sameAttribute ViewPort{}              ViewPort{}              = True-sameAttribute VoroMargin{}            VoroMargin{}            = True-sameAttribute Weight{}                Weight{}                = True-sameAttribute Width{}                 Width{}                 = True-sameAttribute XLabel{}                XLabel{}                = True-sameAttribute Z{}                     Z{}                     = True-sameAttribute (UnknownAttribute a1 _) (UnknownAttribute a2 _) = a1 == a2-sameAttribute _                       _                       = False---- | Return the default value for a specific 'Attribute' if possible; graph/cluster values are preferred over node/edge values.-defaultAttributeValue                      :: Attribute -> Maybe Attribute-defaultAttributeValue Damping{}            = Just $ Damping 0.99-defaultAttributeValue K{}                  = Just $ K 0.3-defaultAttributeValue URL{}                = Just $ URL ""-defaultAttributeValue ArrowHead{}          = Just $ ArrowHead normal-defaultAttributeValue ArrowSize{}          = Just $ ArrowSize 1-defaultAttributeValue ArrowTail{}          = Just $ ArrowTail normal-defaultAttributeValue ColorScheme{}        = Just $ ColorScheme X11-defaultAttributeValue BgColor{}            = Just $ BgColor [X11Color Transparent]-defaultAttributeValue Center{}             = Just $ Center False-defaultAttributeValue ClusterRank{}        = Just $ ClusterRank Local-defaultAttributeValue Color{}              = Just $ Color [X11Color Black]-defaultAttributeValue Comment{}            = Just $ Comment ""-defaultAttributeValue Compound{}           = Just $ Compound False-defaultAttributeValue Concentrate{}        = Just $ Concentrate False-defaultAttributeValue Constraint{}         = Just $ Constraint True-defaultAttributeValue Decorate{}           = Just $ Decorate False-defaultAttributeValue Dim{}                = Just $ Dim 2-defaultAttributeValue Dimen{}              = Just $ Dimen 2-defaultAttributeValue DirEdgeConstraints{} = Just $ DirEdgeConstraints NoConstraints-defaultAttributeValue Distortion{}         = Just $ Distortion 0-defaultAttributeValue EdgeURL{}            = Just $ EdgeURL ""-defaultAttributeValue ESep{}               = Just $ ESep (DVal 3)-defaultAttributeValue FillColor{}          = Just $ FillColor [X11Color Black]-defaultAttributeValue FixedSize{}          = Just $ FixedSize False-defaultAttributeValue FontColor{}          = Just $ FontColor (X11Color Black)-defaultAttributeValue FontName{}           = Just $ FontName "Times-Roman"-defaultAttributeValue FontNames{}          = Just $ FontNames ""-defaultAttributeValue FontSize{}           = Just $ FontSize 14-defaultAttributeValue ForceLabels{}        = Just $ ForceLabels False-defaultAttributeValue GradientAngle{}      = Just $ GradientAngle 0-defaultAttributeValue Group{}              = Just $ Group ""-defaultAttributeValue HeadURL{}            = Just $ HeadURL ""-defaultAttributeValue HeadClip{}           = Just $ HeadClip True-defaultAttributeValue HeadLabel{}          = Just $ HeadLabel (StrLabel "")-defaultAttributeValue HeadPort{}           = Just $ HeadPort (CompassPoint CenterPoint)-defaultAttributeValue HeadTarget{}         = Just $ HeadTarget ""-defaultAttributeValue HeadTooltip{}        = Just $ HeadTooltip ""-defaultAttributeValue Height{}             = Just $ Height 0.5-defaultAttributeValue ID{}                 = Just $ ID ""-defaultAttributeValue Image{}              = Just $ Image ""-defaultAttributeValue ImagePath{}          = Just $ ImagePath (Paths [])-defaultAttributeValue ImageScale{}         = Just $ ImageScale NoScale-defaultAttributeValue Label{}              = Just $ Label (StrLabel "")-defaultAttributeValue LabelURL{}           = Just $ LabelURL ""-defaultAttributeValue LabelScheme{}        = Just $ LabelScheme NotEdgeLabel-defaultAttributeValue LabelAngle{}         = Just $ LabelAngle (-25)-defaultAttributeValue LabelDistance{}      = Just $ LabelDistance 1-defaultAttributeValue LabelFloat{}         = Just $ LabelFloat False-defaultAttributeValue LabelFontColor{}     = Just $ LabelFontColor (X11Color Black)-defaultAttributeValue LabelFontName{}      = Just $ LabelFontName "Times-Roman"-defaultAttributeValue LabelFontSize{}      = Just $ LabelFontSize 14-defaultAttributeValue LabelJust{}          = Just $ LabelJust JCenter-defaultAttributeValue LabelLoc{}           = Just $ LabelLoc VTop-defaultAttributeValue LabelTarget{}        = Just $ LabelTarget ""-defaultAttributeValue LabelTooltip{}       = Just $ LabelTooltip ""-defaultAttributeValue Landscape{}          = Just $ Landscape False-defaultAttributeValue Layers{}             = Just $ Layers (LL [])-defaultAttributeValue LayerSep{}           = Just $ LayerSep (LSep " :\t")-defaultAttributeValue Layout{}             = Just $ Layout ""-defaultAttributeValue LevelsGap{}          = Just $ LevelsGap 0-defaultAttributeValue Levels{}             = Just $ Levels maxBound-defaultAttributeValue LHead{}              = Just $ LHead ""-defaultAttributeValue LTail{}              = Just $ LTail ""-defaultAttributeValue MCLimit{}            = Just $ MCLimit 1-defaultAttributeValue MinDist{}            = Just $ MinDist 1-defaultAttributeValue MinLen{}             = Just $ MinLen 1-defaultAttributeValue Mode{}               = Just $ Mode Major-defaultAttributeValue Model{}              = Just $ Model ShortPath-defaultAttributeValue Mosek{}              = Just $ Mosek False-defaultAttributeValue NodeSep{}            = Just $ NodeSep 0.25-defaultAttributeValue NoJustify{}          = Just $ NoJustify False-defaultAttributeValue Normalize{}          = Just $ Normalize False-defaultAttributeValue Orientation{}        = Just $ Orientation 0-defaultAttributeValue OutputOrder{}        = Just $ OutputOrder BreadthFirst-defaultAttributeValue Overlap{}            = Just $ Overlap KeepOverlaps-defaultAttributeValue OverlapScaling{}     = Just $ OverlapScaling (-4)-defaultAttributeValue Pack{}               = Just $ Pack DontPack-defaultAttributeValue PackMode{}           = Just $ PackMode PackNode-defaultAttributeValue Pad{}                = Just $ Pad (DVal 0.0555)-defaultAttributeValue PageDir{}            = Just $ PageDir Bl-defaultAttributeValue PenColor{}           = Just $ PenColor (X11Color Black)-defaultAttributeValue PenWidth{}           = Just $ PenWidth 1-defaultAttributeValue Peripheries{}        = Just $ Peripheries 1-defaultAttributeValue Pin{}                = Just $ Pin False-defaultAttributeValue QuadTree{}           = Just $ QuadTree NormalQT-defaultAttributeValue Quantum{}            = Just $ Quantum 0-defaultAttributeValue RankDir{}            = Just $ RankDir FromTop-defaultAttributeValue Regular{}            = Just $ Regular False-defaultAttributeValue ReMinCross{}         = Just $ ReMinCross False-defaultAttributeValue RepulsiveForce{}     = Just $ RepulsiveForce 1-defaultAttributeValue Root{}               = Just $ Root (NodeName "")-defaultAttributeValue Rotate{}             = Just $ Rotate 0-defaultAttributeValue Rotation{}           = Just $ Rotation 0-defaultAttributeValue SameHead{}           = Just $ SameHead ""-defaultAttributeValue SameTail{}           = Just $ SameTail ""-defaultAttributeValue SearchSize{}         = Just $ SearchSize 30-defaultAttributeValue Sep{}                = Just $ Sep (DVal 4)-defaultAttributeValue Shape{}              = Just $ Shape Ellipse-defaultAttributeValue ShapeFile{}          = Just $ ShapeFile ""-defaultAttributeValue ShowBoxes{}          = Just $ ShowBoxes 0-defaultAttributeValue Sides{}              = Just $ Sides 4-defaultAttributeValue Skew{}               = Just $ Skew 0-defaultAttributeValue Smoothing{}          = Just $ Smoothing NoSmooth-defaultAttributeValue SortV{}              = Just $ SortV 0-defaultAttributeValue Splines{}            = Just $ Splines SplineEdges-defaultAttributeValue StyleSheet{}         = Just $ StyleSheet ""-defaultAttributeValue TailURL{}            = Just $ TailURL ""-defaultAttributeValue TailClip{}           = Just $ TailClip True-defaultAttributeValue TailLabel{}          = Just $ TailLabel (StrLabel "")-defaultAttributeValue TailPort{}           = Just $ TailPort (CompassPoint CenterPoint)-defaultAttributeValue TailTarget{}         = Just $ TailTarget ""-defaultAttributeValue TailTooltip{}        = Just $ TailTooltip ""-defaultAttributeValue Target{}             = Just $ Target ""-defaultAttributeValue Tooltip{}            = Just $ Tooltip ""-defaultAttributeValue VoroMargin{}         = Just $ VoroMargin 0.05-defaultAttributeValue Width{}              = Just $ Width 0.75-defaultAttributeValue XLabel{}             = Just $ XLabel (StrLabel "")-defaultAttributeValue Z{}                  = Just $ Z 0-defaultAttributeValue _                    = Nothing---- | Determine if the provided 'Text' value is a valid name for an 'UnknownAttribute'.-validUnknown     :: AttributeName -> Bool-validUnknown txt = T.toLower txt `S.notMember` names-                   && isIDString txt-  where-    names = (S.fromList . map T.toLower-             $ [ "Damping"-               , "K"-               , "URL"-               , "href"-               , "arrowhead"-               , "arrowsize"-               , "arrowtail"-               , "aspect"-               , "bb"-               , "colorscheme"-               , "bgcolor"-               , "center"-               , "clusterrank"-               , "color"-               , "comment"-               , "compound"-               , "concentrate"-               , "constraint"-               , "decorate"-               , "defaultdist"-               , "dim"-               , "dimen"-               , "dir"-               , "diredgeconstraints"-               , "distortion"-               , "dpi"-               , "resolution"-               , "edgeURL"-               , "edgehref"-               , "edgetarget"-               , "edgetooltip"-               , "epsilon"-               , "esep"-               , "fillcolor"-               , "fixedsize"-               , "fontcolor"-               , "fontname"-               , "fontnames"-               , "fontpath"-               , "fontsize"-               , "forcelabels"-               , "gradientangle"-               , "group"-               , "headURL"-               , "headhref"-               , "headclip"-               , "headlabel"-               , "headport"-               , "headtarget"-               , "headtooltip"-               , "height"-               , "id"-               , "image"-               , "imagepath"-               , "imagescale"-               , "label"-               , "labelURL"-               , "labelhref"-               , "label_scheme"-               , "labelangle"-               , "labeldistance"-               , "labelfloat"-               , "labelfontcolor"-               , "labelfontname"-               , "labelfontsize"-               , "labeljust"-               , "labelloc"-               , "labeltarget"-               , "labeltooltip"-               , "landscape"-               , "layer"-               , "layers"-               , "layersep"-               , "layout"-               , "len"-               , "levelsgap"-               , "levels"-               , "lhead"-               , "LHeight"-               , "lp"-               , "ltail"-               , "lwidth"-               , "margin"-               , "maxiter"-               , "mclimit"-               , "mindist"-               , "minlen"-               , "mode"-               , "model"-               , "mosek"-               , "nodesep"-               , "nojustify"-               , "normalize"-               , "nslimit"-               , "nslimit1"-               , "ordering"-               , "orientation"-               , "outputorder"-               , "overlap"-               , "overlap_scaling"-               , "pack"-               , "packmode"-               , "pad"-               , "page"-               , "pagedir"-               , "pencolor"-               , "penwidth"-               , "peripheries"-               , "pin"-               , "pos"-               , "quadtree"-               , "quantum"-               , "rank"-               , "rankdir"-               , "ranksep"-               , "ratio"-               , "rects"-               , "regular"-               , "remincross"-               , "repulsiveforce"-               , "root"-               , "rotate"-               , "rotation"-               , "samehead"-               , "sametail"-               , "samplepoints"-               , "scale"-               , "searchsize"-               , "sep"-               , "shape"-               , "shapefile"-               , "showboxes"-               , "sides"-               , "size"-               , "skew"-               , "smoothing"-               , "sortv"-               , "splines"-               , "start"-               , "style"-               , "stylesheet"-               , "tailURL"-               , "tailhref"-               , "tailclip"-               , "taillabel"-               , "tailport"-               , "tailtarget"-               , "tailtooltip"-               , "target"-               , "tooltip"-               , "truecolor"-               , "vertices"-               , "viewport"-               , "voro_margin"-               , "weight"-               , "width"-               , "xlabel"-               , "z"-               , "charset" -- Defined upstream, just not used here.-               ])-            `S.union`-            keywords-{- Delete to here -}---- -------------------------------------------------------------------------------{- | If performing any custom pre-/post-processing on Dot code, you-     may wish to utilise some custom 'Attributes'.  These are wrappers-     around the 'UnknownAttribute' constructor (and thus 'CustomAttribute'-     is just an alias for 'Attribute').--     You should ensure that 'validUnknown' is 'True' for any potential-     custom attribute name.---}-type CustomAttribute = Attribute---- | Create a custom attribute.-customAttribute :: AttributeName -> Text -> CustomAttribute-customAttribute = UnknownAttribute---- | Determines whether or not this is a custom attribute.-isCustom                    :: Attribute -> Bool-isCustom UnknownAttribute{} = True-isCustom _                  = False--isSpecifiedCustom :: AttributeName -> Attribute -> Bool-isSpecifiedCustom nm (UnknownAttribute nm' _) = nm == nm'-isSpecifiedCustom _  _                        = False---- | The value of a custom attribute.  Will throw a---   'GraphvizException' if the provided 'Attribute' isn't a custom---   one.-customValue :: CustomAttribute -> Text-customValue (UnknownAttribute _ v) = v-customValue attr                   = throw . NotCustomAttr . T.unpack-                                     $ printIt attr---- | The name of a custom attribute.  Will throw a---   'GraphvizException' if the provided 'Attribute' isn't a custom---   one.-customName :: CustomAttribute -> AttributeName-customName (UnknownAttribute nm _) = nm-customName attr                    = throw . NotCustomAttr . T.unpack-                                      $ printIt attr---- | Returns all custom attributes and the list of non-custom Attributes.-findCustoms :: Attributes -> ([CustomAttribute], Attributes)-findCustoms = partition isCustom---- | Find the (first instance of the) specified custom attribute and---   returns it along with all other Attributes.-findSpecifiedCustom :: AttributeName -> Attributes-                       -> Maybe (CustomAttribute, Attributes)-findSpecifiedCustom nm attrs-  = case break (isSpecifiedCustom nm) attrs of-      (bf,cust:aft) -> Just (cust, bf ++ aft)-      _             -> Nothing---- | Delete all custom attributes (actually, this will delete all---   'UnknownAttribute' values; as such it can also be used to remove---   legacy attributes).-deleteCustomAttributes :: Attributes -> Attributes-deleteCustomAttributes = filter (not . isCustom)---- | Removes all instances of the specified custom attribute.-deleteSpecifiedCustom :: AttributeName -> Attributes -> Attributes-deleteSpecifiedCustom nm = filter (not . isSpecifiedCustom nm)---- -------------------------------------------------------------------------------{- |--   Some 'Attribute's (mainly label-like ones) take a 'String' argument-   that allows for extra escape codes.  This library doesn't do any-   extra checks or special parsing for these escape codes, but usage-   of 'EscString' rather than 'Text' indicates that the Graphviz-   tools will recognise these extra escape codes for these-   'Attribute's.--   The extra escape codes include (note that these are all Strings):--     [@\\N@] Replace with the name of the node (for Node 'Attribute's).--     [@\\G@] Replace with the name of the graph (for Node 'Attribute's)-             or the name of the graph or cluster, whichever is-             applicable (for Graph, Cluster and Edge 'Attribute's).--     [@\\E@] Replace with the name of the edge, formed by the two-             adjoining nodes and the edge type (for Edge 'Attribute's).--     [@\\T@] Replace with the name of the tail node (for Edge-             'Attribute's).--     [@\\H@] Replace with the name of the head node (for Edge-             'Attribute's).--     [@\\L@] Replace with the object's label (for all 'Attribute's).--   Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or-   'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines-   centered, left-justified and right-justified respectively.-- -}-type EscString = Text---- --------------------------------------------------------------------------------- | /Dot/ has a basic grammar of arrow shapes which allows usage of---   up to 1,544,761 different shapes from 9 different basic---   'ArrowShape's.  Note that whilst an explicit list is used in the---   definition of 'ArrowType', there must be at least one tuple and a---   maximum of 4 (since that is what is required by Dot).  For more---   information, see: <http://graphviz.org/doc/info/arrows.html>------   The 19 basic arrows shown on the overall attributes page have---   been defined below as a convenience.  Parsing of the 5---   backward-compatible special cases is also supported.-newtype ArrowType = AType [(ArrowModifier, ArrowShape)]-    deriving (Eq, Ord, Show, Read)---- Used for default-normal :: ArrowType-normal = AType [(noMods, Normal)]---- Used for backward-compatible parsing-eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType--eDiamond = AType [(openMod, Diamond)]-openArr = AType [(noMods, Vee)]-halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]-emptyArr = AType [(openMod, Normal)]-invEmpty = AType [ (noMods, Inv)-                 , (openMod, Normal)]--instance PrintDot ArrowType where-  unqtDot (AType mas) = hcat $ mapM appMod mas-    where-      appMod (m, a) = unqtDot m <> unqtDot a--instance ParseDot ArrowType where-  parseUnqt = specialArrowParse-              `onFail`-              do mas <- many1 $ do m <- parseUnqt-                                   a <- parseUnqt-                                   return (m,a)-                 return $ AType mas--specialArrowParse :: Parse ArrowType-specialArrowParse = stringValue [ ("ediamond", eDiamond)-                                , ("open", openArr)-                                , ("halfopen", halfOpen)-                                , ("empty", emptyArr)-                                , ("invempty", invEmpty)-                                ]--data ArrowShape = Box-                | Crow-                | Diamond-                | DotArrow-                | Inv-                | NoArrow-                | Normal-                | Tee-                | Vee-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ArrowShape where-  unqtDot Box      = unqtText "box"-  unqtDot Crow     = unqtText "crow"-  unqtDot Diamond  = unqtText "diamond"-  unqtDot DotArrow = unqtText "dot"-  unqtDot Inv      = unqtText "inv"-  unqtDot NoArrow  = unqtText "none"-  unqtDot Normal   = unqtText "normal"-  unqtDot Tee      = unqtText "tee"-  unqtDot Vee      = unqtText "vee"--instance ParseDot ArrowShape where-  parseUnqt = stringValue [ ("box", Box)-                          , ("crow", Crow)-                          , ("diamond", Diamond)-                          , ("dot", DotArrow)-                          , ("inv", Inv)-                          , ("none", NoArrow)-                          , ("normal", Normal)-                          , ("tee", Tee)-                          , ("vee", Vee)-                          ]---- | What modifications to apply to an 'ArrowShape'.-data ArrowModifier = ArrMod { arrowFill :: ArrowFill-                            , arrowSide :: ArrowSide-                            }-                   deriving (Eq, Ord, Show, Read)---- | Apply no modifications to an 'ArrowShape'.-noMods :: ArrowModifier-noMods = ArrMod FilledArrow BothSides---- | 'OpenArrow' and 'BothSides'-openMod :: ArrowModifier-openMod = ArrMod OpenArrow BothSides--instance PrintDot ArrowModifier where-  unqtDot (ArrMod f s) = unqtDot f <> unqtDot s--instance ParseDot ArrowModifier where-  parseUnqt = do f <- parseUnqt-                 s <- parseUnqt-                 return $ ArrMod f s--data ArrowFill = OpenArrow-               | FilledArrow-               deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ArrowFill where-  unqtDot OpenArrow   = char 'o'-  unqtDot FilledArrow = empty--instance ParseDot ArrowFill where-  parseUnqt = liftM (bool FilledArrow OpenArrow . isJust)-              $ optional (character 'o')--  -- Not used individually-  parse = parseUnqt---- | Represents which side (when looking towards the node the arrow is---   pointing to) is drawn.-data ArrowSide = LeftSide-               | RightSide-               | BothSides-               deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ArrowSide where-  unqtDot LeftSide  = char 'l'-  unqtDot RightSide = char 'r'-  unqtDot BothSides = empty--instance ParseDot ArrowSide where-  parseUnqt = liftM getSideType-              $ optional (oneOf $ map character ['l', 'r'])-    where-      getSideType = maybe BothSides-                          (bool RightSide LeftSide . (==) 'l')--  -- Not used individually-  parse = parseUnqt---- -------------------------------------------------------------------------------data AspectType = RatioOnly Double-                | RatioPassCount Double Int-                deriving (Eq, Ord, Show, Read)--instance PrintDot AspectType where-  unqtDot (RatioOnly r)        = unqtDot r-  unqtDot (RatioPassCount r p) = commaDel r p--  toDot at@RatioOnly{}      = unqtDot at-  toDot at@RatioPassCount{} = dquotes $ unqtDot at--instance ParseDot AspectType where-  parseUnqt = liftM (uncurry RatioPassCount) commaSepUnqt-              `onFail`-              liftM RatioOnly parseUnqt---  parse = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)-          `onFail`-          liftM RatioOnly parse---- --------------------------------------------------------------------------------- | Should only have 2D points (i.e. created with 'createPoint').-data Rect = Rect Point Point-            deriving (Eq, Ord, Show, Read)--instance PrintDot Rect where-  unqtDot (Rect p1 p2) = commaDel p1 p2--  toDot = dquotes . unqtDot--  unqtListToDot = hsep . mapM unqtDot--instance ParseDot Rect where-  parseUnqt = liftM (uncurry Rect) $ commaSep' parsePoint2D parsePoint2D--  parse = quotedParse parseUnqt--  parseUnqtList = sepBy1 parseUnqt whitespace1---- -------------------------------------------------------------------------------data ClusterMode = Local-                 | Global-                 | NoCluster-                 deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ClusterMode where-  unqtDot Local     = unqtText "local"-  unqtDot Global    = unqtText "global"-  unqtDot NoCluster = unqtText "none"--instance ParseDot ClusterMode where-  parseUnqt = oneOf [ stringRep Local "local"-                    , stringRep Global "global"-                    , stringRep NoCluster "none"-                    ]---- --------------------------------------------------------------------------------- | Specify where to place arrow heads on an edge.-data DirType = Forward -- ^ Draw a directed edge with an arrow to the-                       --   node it's pointing go.-             | Back    -- ^ Draw a reverse directed edge with an arrow-                       --   to the node it's coming from.-             | Both    -- ^ Draw arrows on both ends of the edge.-             | NoDir   -- ^ Draw an undirected edge.-             deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot DirType where-  unqtDot Forward = unqtText "forward"-  unqtDot Back    = unqtText "back"-  unqtDot Both    = unqtText "both"-  unqtDot NoDir   = unqtText "none"--instance ParseDot DirType where-  parseUnqt = oneOf [ stringRep Forward "forward"-                    , stringRep Back "back"-                    , stringRep Both "both"-                    , stringRep NoDir "none"-                    ]---- --------------------------------------------------------------------------------- | Only when @mode == 'IpSep'@.-data DEConstraints = EdgeConstraints-                   | NoConstraints-                   | HierConstraints-                   deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot DEConstraints where-  unqtDot EdgeConstraints = unqtDot True-  unqtDot NoConstraints   = unqtDot False-  unqtDot HierConstraints = text "hier"--instance ParseDot DEConstraints where-  parseUnqt = liftM (bool NoConstraints EdgeConstraints) parse-              `onFail`-              stringRep HierConstraints "hier"---- --------------------------------------------------------------------------------- | Either a 'Double' or a (2D) 'Point' (i.e. created with---   'createPoint').-data DPoint = DVal Double-            | PVal Point-            deriving (Eq, Ord, Show, Read)--instance PrintDot DPoint where-  unqtDot (DVal d) = unqtDot d-  unqtDot (PVal p) = unqtDot p--  toDot (DVal d) = toDot d-  toDot (PVal p) = toDot p--instance ParseDot DPoint where-  parseUnqt = liftM PVal parsePoint2D-              `onFail`-              liftM DVal parseUnqt--  parse = quotedParse parseUnqt-          `onFail`-          liftM DVal parseUnqt---- -------------------------------------------------------------------------------data ModeType = Major-              | KK-              | Hier-              | IpSep-              deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ModeType where-  unqtDot Major = text "major"-  unqtDot KK    = text "KK"-  unqtDot Hier  = text "hier"-  unqtDot IpSep = text "ipsep"--instance ParseDot ModeType where-  parseUnqt = oneOf [ stringRep Major "major"-                    , stringRep KK "KK"-                    , stringRep Hier "hier"-                    , stringRep IpSep "ipsep"-                    ]---- -------------------------------------------------------------------------------data Model = ShortPath-           | SubSet-           | Circuit-           deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Model where-  unqtDot ShortPath = text "shortpath"-  unqtDot SubSet    = text "subset"-  unqtDot Circuit   = text "circuit"--instance ParseDot Model where-  parseUnqt = oneOf [ stringRep ShortPath "shortpath"-                    , stringRep SubSet "subset"-                    , stringRep Circuit "circuit"-                    ]---- -------------------------------------------------------------------------------data Label = StrLabel EscString-           | HtmlLabel Html.Label -- ^ If 'PlainText' is used, the-                                  --   'Html.Label' value is the entire-                                  --   \"shape\"; if anything else-                                  --   except 'PointShape' is used then-                                  --   the 'Html.Label' is embedded-                                  --   within the shape.-           | RecordLabel RecordFields -- ^ For nodes only; requires-                                      --   either 'Record' or-                                      --   'MRecord' as the shape.-           deriving (Eq, Ord, Show, Read)--instance PrintDot Label where-  unqtDot (StrLabel s)     = unqtDot s-  unqtDot (HtmlLabel h)    = angled $ unqtDot h-  unqtDot (RecordLabel fs) = unqtDot fs--  toDot (StrLabel s)     = toDot s-  toDot h@HtmlLabel{}    = unqtDot h-  toDot (RecordLabel fs) = toDot fs--instance ParseDot Label where-  -- Don't have to worry about being able to tell the difference-  -- between an HtmlLabel and a RecordLabel starting with a PortPos,-  -- since the latter will be in quotes and the former won't.--  parseUnqt = oneOf [ liftM HtmlLabel $ parseAngled parseUnqt-                    , liftM RecordLabel parseUnqt-                    , liftM StrLabel parseUnqt-                    ]--  parse = oneOf [ liftM HtmlLabel $ parseAngled parse-                , liftM RecordLabel parse-                , liftM StrLabel parse-                ]---- --------------------------------------------------------------------------------- | A RecordFields value should never be empty.-type RecordFields = [RecordField]---- | Specifies the sub-values of a record-based label.  By default,---   the cells are laid out horizontally; use 'FlipFields' to change---   the orientation of the fields (can be applied recursively).  To---   change the default orientation, use 'RankDir'.-data RecordField = LabelledTarget PortName EscString-                 | PortName PortName -- ^ Will result in no label for-                                     --   that cell.-                 | FieldLabel EscString-                 | FlipFields RecordFields-                 deriving (Eq, Ord, Show, Read)--instance PrintDot RecordField where-  -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.-  unqtDot (LabelledTarget t s) = printPortName t <+> unqtRecordString s-  unqtDot (PortName t)         = printPortName t-  unqtDot (FieldLabel s)       = unqtRecordString s-  unqtDot (FlipFields rs)      = braces $ unqtDot rs--  toDot (FieldLabel s) = printEscaped recordEscChars s-  toDot rf             = dquotes $ unqtDot rf--  unqtListToDot [f] = unqtDot f-  unqtListToDot fs  = hcat . punctuate (char '|') $ mapM unqtDot fs--  listToDot [f] = toDot f-  listToDot fs  = dquotes $ unqtListToDot fs--instance ParseDot RecordField where-  parseUnqt = do t <- liftM PN $ parseAngled parseRecord-                 ml <- optional (whitespace1 >> parseRecord)-                 return $ maybe (PortName t)-                                (LabelledTarget t)-                                ml-              `onFail`-              liftM FieldLabel parseRecord-              `onFail`-              liftM FlipFields (parseBraced parseUnqt)--  parse = quotedParse parseUnqt--  parseUnqtList = wrapWhitespace $ sepBy1 parseUnqt (wrapWhitespace $ character '|')--  -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it-  -- will cause parsing problems for other 'Label' types.-  parseList = do rfs <- quotedParse parseUnqtList-                 if validRFs rfs-                   then return rfs-                   else fail "This is a StrLabel, not a RecordLabel"-    where-      validRFs [FieldLabel str] = T.any (`elem` recordEscChars) str-      validRFs _                = True---- | Print a 'PortName' value as expected within a Record data---   structure.-printPortName :: PortName -> DotCode-printPortName = angled . unqtRecordString . portName--parseRecord :: Parse Text-parseRecord = parseEscaped False recordEscChars []--unqtRecordString :: Text -> DotCode-unqtRecordString = unqtEscaped recordEscChars--recordEscChars :: [Char]-recordEscChars = ['{', '}', '|', ' ', '<', '>']---- --------------------------------------------------------------------------------- | How to treat a node whose name is of the form @|edgelabel|*@" as a---   special node representing an edge label.-data LabelScheme = NotEdgeLabel        -- ^ No effect-                 | CloseToCenter       -- ^ Make node close to center of neighbor-                 | CloseToOldCenter    -- ^ Make node close to old center of neighbor-                 | RemoveAndStraighten -- ^ Use a two-step process.-                 deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot LabelScheme where-  unqtDot NotEdgeLabel        = int 0-  unqtDot CloseToCenter       = int 1-  unqtDot CloseToOldCenter    = int 2-  unqtDot RemoveAndStraighten = int 3--instance ParseDot LabelScheme where-  -- Use string-based parsing rather than parsing an integer just to make it easier-  parseUnqt = stringValue [ ("0", NotEdgeLabel)-                          , ("1", CloseToCenter)-                          , ("2", CloseToOldCenter)-                          , ("3", RemoveAndStraighten)-                          ]---- -------------------------------------------------------------------------------data Point = Point { xCoord   :: Double-                   , yCoord   :: Double-                      -- | Can only be 'Just' for @'Dim' 3@ or greater.-                   , zCoord   :: Maybe Double-                     -- | Input to Graphviz only: specify that the-                     --   node position should not change.-                   , forcePos :: Bool-                   }-           deriving (Eq, Ord, Show, Read)---- | Create a point with only @x@ and @y@ values.-createPoint     :: Double -> Double -> Point-createPoint x y = Point x y Nothing False--parsePoint2D :: Parse Point-parsePoint2D = liftM (uncurry createPoint) commaSepUnqt--instance PrintDot Point where-  unqtDot (Point x y mz frs) = bool id (<> char '!') frs-                               . maybe id (\ z -> (<> unqtDot z) . (<> comma)) mz-                               $ commaDel x y--  toDot = dquotes . unqtDot--  unqtListToDot = hsep . mapM unqtDot--  listToDot = dquotes . unqtListToDot--instance ParseDot Point where-  parseUnqt = do (x,y) <- commaSepUnqt-                 mz <- optional $ parseComma >> parseUnqt-                 bng <- liftM isJust . optional $ character '!'-                 return $ Point x y mz bng--  parse = quotedParse parseUnqt--  parseUnqtList = sepBy1 parseUnqt whitespace1---- -------------------------------------------------------------------------------data Overlap = KeepOverlaps-             | ScaleOverlaps-             | ScaleXYOverlaps-             | PrismOverlap (Maybe Word16) -- ^ Only when sfdp is-                                           --   available, @'Nothing'@-                                           --   is equivalent to-                                           --   @'Just' 1000@.-             | CompressOverlap-             | VpscOverlap-             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@-             deriving (Eq, Ord, Show, Read)--instance PrintDot Overlap where-  unqtDot KeepOverlaps     = unqtDot True-  unqtDot ScaleOverlaps    = text "scale"-  unqtDot ScaleXYOverlaps  = text "scalexy"-  unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism"-  unqtDot CompressOverlap  = text "compress"-  unqtDot VpscOverlap      = text "vpsc"-  unqtDot IpsepOverlap     = text "ipsep"--instance ParseDot Overlap where-  parseUnqt = oneOf [ stringRep KeepOverlaps "true"-                    , stringRep ScaleXYOverlaps "scalexy"-                    , stringRep ScaleOverlaps "scale"-                    , string "prism" >> liftM PrismOverlap (optional parse)-                    , stringRep (PrismOverlap Nothing) "false"-                    , stringRep CompressOverlap "compress"-                    , stringRep VpscOverlap "vpsc"-                    , stringRep IpsepOverlap "ipsep"-                    ]---- -------------------------------------------------------------------------------newtype LayerSep = LSep Text-                 deriving (Eq, Ord, Show, Read)--instance PrintDot LayerSep where-  unqtDot (LSep ls) = do setLayerSep $ T.unpack ls-                         unqtDot ls--  toDot (LSep ls) = do setLayerSep $ T.unpack ls-                       toDot ls--instance ParseDot LayerSep where-  parseUnqt = do ls <- parseUnqt-                 setLayerSep $ T.unpack ls-                 return $ LSep ls--  parse = do ls <- parse-             setLayerSep $ T.unpack ls-             return $ LSep ls--data LayerRange = LRID LayerID-                | LRS LayerID LayerID-                deriving (Eq, Ord, Show, Read)--instance PrintDot LayerRange where-  unqtDot (LRID lid)    = unqtDot lid-  unqtDot (LRS id1 id2) = do ls <- getLayerSep-                             let s = unqtDot $ head ls-                             unqtDot id1 <> s <> unqtDot id2--  toDot (LRID lid) = toDot lid-  toDot lrs        = dquotes $ unqtDot lrs--instance ParseDot LayerRange where-  parseUnqt = do id1 <- parseUnqt-                 _   <- parseLayerSep-                 id2 <- parseUnqt-                 return $ LRS id1 id2-              `onFail`-              liftM LRID parseUnqt---  parse = quotedParse ( do id1 <- parseUnqt-                           _   <- parseLayerSep-                           id2 <- parseUnqt-                           return $ LRS id1 id2-                      )-          `onFail`-          liftM LRID parse--parseLayerSep :: Parse ()-parseLayerSep = do ls <- getLayerSep-                   many1Satisfy (`elem` ls)-                   return ()--parseLayerName :: Parse Text-parseLayerName = parseEscaped False [] =<< getLayerSep--parseLayerName' :: Parse Text-parseLayerName' = stringBlock-                  `onFail`-                  quotedParse parseLayerName---- | You should not have any layer separator characters for the---   'LRName' option, as they won't be parseable.-data LayerID = AllLayers-             | LRInt Int-             | LRName Text -- ^ Should not be a number of @"all"@.-             deriving (Eq, Ord, Show, Read)--instance PrintDot LayerID where-  unqtDot AllLayers   = text "all"-  unqtDot (LRInt n)   = unqtDot n-  unqtDot (LRName nm) = unqtDot nm--  toDot (LRName nm) = toDot nm-  -- Other two don't need quotes-  toDot li          = unqtDot li--  unqtListToDot ll = do ls <- getLayerSep-                        let s = unqtDot $ head ls-                        hcat . punctuate s $ mapM unqtDot ll--  listToDot [l] = toDot l-  -- Might not need quotes, but probably will.  Can't tell either-  -- way since we don't know what the separator character will be.-  listToDot ll  = dquotes $ unqtDot ll--instance ParseDot LayerID where-  parseUnqt = liftM checkLayerName parseLayerName -- tests for Int and All--  parse = oneOf [ liftM checkLayerName parseLayerName'-                , liftM LRInt parse -- Mainly for unquoted case.-                ]--checkLayerName     :: Text -> LayerID-checkLayerName str = maybe checkAll LRInt $ stringToInt str-  where-    checkAll = if T.toLower str == "all"-               then AllLayers-               else LRName str---- | A list of layer names.  The names should all be 'LRName' values,---   and when printed will use an arbitrary character from---   'defLayerSep'.-newtype LayerList = LL [LayerID]-                  deriving (Eq, Ord, Show, Read)--instance PrintDot LayerList where-  unqtDot (LL ll) = unqtDot ll--  toDot (LL ll) = toDot ll--instance ParseDot LayerList where-  parseUnqt = liftM LL $ sepBy1 parseUnqt parseLayerSep--  parse = quotedParse parseUnqt-          `onFail`-          liftM (LL . (:[]) . LRName) stringBlock-          `onFail`-          quotedParse (stringRep (LL []) "")---- -------------------------------------------------------------------------------data Order = OutEdges -- ^ Draw outgoing edges in order specified.-           | InEdges  -- ^ Draw incoming edges in order specified.-           deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Order where-  unqtDot OutEdges = text "out"-  unqtDot InEdges  = text "in"--instance ParseDot Order where-  parseUnqt = oneOf [ stringRep OutEdges "out"-                    , stringRep InEdges  "in"-                    ]---- -------------------------------------------------------------------------------data OutputMode = BreadthFirst | NodesFirst | EdgesFirst-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot OutputMode where-  unqtDot BreadthFirst = text "breadthfirst"-  unqtDot NodesFirst   = text "nodesfirst"-  unqtDot EdgesFirst   = text "edgesfirst"--instance ParseDot OutputMode where-  parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"-                    , stringRep NodesFirst "nodesfirst"-                    , stringRep EdgesFirst "edgesfirst"-                    ]---- -------------------------------------------------------------------------------data Pack = DoPack-          | DontPack-          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.-          deriving (Eq, Ord, Show, Read)--instance PrintDot Pack where-  unqtDot DoPack         = unqtDot True-  unqtDot DontPack       = unqtDot False-  unqtDot (PackMargin m) = unqtDot m--instance ParseDot Pack where-  -- What happens if it parses 0?  It's non-negative, but parses as False-  parseUnqt = oneOf [ liftM PackMargin parseUnqt-                    , liftM (bool DontPack DoPack) onlyBool-                    ]---- -------------------------------------------------------------------------------data PackMode = PackNode-              | PackClust-              | PackGraph-              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort-                                                -- by user, number of-                                                -- rows/cols-              deriving (Eq, Ord, Show, Read)--instance PrintDot PackMode where-  unqtDot PackNode           = text "node"-  unqtDot PackClust          = text "clust"-  unqtDot PackGraph          = text "graph"-  unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder-                               $ text "array"-    where-      addNum = maybe id (flip (<>) . unqtDot) mi-      isUnder = if c || u-                then flip (<>) $ char '_'-                else id-      isC = if c-            then flip (<>) $ char 'c'-            else id-      isU = if u-            then flip (<>) $ char 'u'-            else id--instance ParseDot PackMode where-  parseUnqt = oneOf [ stringRep PackNode "node"-                    , stringRep PackClust "clust"-                    , stringRep PackGraph "graph"-                    , do string "array"-                         mcu <- optional $ do character '_'-                                              many1 $ satisfy isCU-                         let c = hasCharacter mcu 'c'-                             u = hasCharacter mcu 'u'-                         mi <- optional parseUnqt-                         return $ PackArray c u mi-                    ]-    where-      hasCharacter ms c = maybe False (elem c) ms-      -- Also checks and removes quote characters-      isCU = flip elem ['c', 'u']---- -------------------------------------------------------------------------------data Pos = PointPos Point-         | SplinePos [Spline]-         deriving (Eq, Ord, Show, Read)--instance PrintDot Pos where-  unqtDot (PointPos p)   = unqtDot p-  unqtDot (SplinePos ss) = unqtDot ss--  toDot (PointPos p)   = toDot p-  toDot (SplinePos ss) = toDot ss--instance ParseDot Pos where-  -- Have to be careful with this: if we try to parse points first,-  -- then a spline with no start and end points will erroneously get-  -- parsed as a point and then the parser will crash as it expects a-  -- closing quote character...-  parseUnqt = do splns <- parseUnqt-                 case splns of-                   [Spline Nothing Nothing [p]] -> return $ PointPos p-                   _                            -> return $ SplinePos splns--  parse = quotedParse parseUnqt---- --------------------------------------------------------------------------------- | Controls how (and if) edges are represented.-data EdgeType = SplineEdges-              | LineEdges-              | NoEdges-              | PolyLine-              | CompoundEdge -- ^ fdp only-              deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot EdgeType where-  unqtDot SplineEdges  = toDot True-  unqtDot LineEdges    = toDot False-  unqtDot NoEdges      = empty-  unqtDot PolyLine     = text "polyline"-  unqtDot CompoundEdge = text "compound"--  toDot NoEdges = dquotes empty-  toDot et      = unqtDot et--instance ParseDot EdgeType where-  -- Can't parse NoEdges without quotes.-  parseUnqt = oneOf [ liftM (bool LineEdges SplineEdges) parse-                    , stringRep SplineEdges "spline"-                    , stringRep LineEdges "line"-                    , stringRep PolyLine "polyline"-                    , stringRep CompoundEdge "compound"-                    ]--  parse = stringRep NoEdges "\"\""-          `onFail`-          optionalQuoted parseUnqt---- --------------------------------------------------------------------------------- | Upper-case first character is major order;---   lower-case second character is minor order.-data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt-             deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot PageDir where-  unqtDot Bl = text "BL"-  unqtDot Br = text "BR"-  unqtDot Tl = text "TL"-  unqtDot Tr = text "TR"-  unqtDot Rb = text "RB"-  unqtDot Rt = text "RT"-  unqtDot Lb = text "LB"-  unqtDot Lt = text "LT"--instance ParseDot PageDir where-  parseUnqt = stringValue [ ("BL", Bl)-                          , ("BR", Br)-                          , ("TL", Tl)-                          , ("TR", Tr)-                          , ("RB", Rb)-                          , ("RT", Rt)-                          , ("LB", Lb)-                          , ("LT", Lt)-                          ]---- --------------------------------------------------------------------------------- | The number of points in the list must be equivalent to 1 mod 3;---   note that this is not checked.-data Spline = Spline (Maybe Point) (Maybe Point) [Point]-            deriving (Eq, Ord, Show, Read)--instance PrintDot Spline where-  unqtDot (Spline ms me ps) = addS . addE-                             . hsep-                             $ mapM unqtDot ps-    where-      addP t = maybe id ((<+>) . commaDel t)-      addS = addP 's' ms-      addE = addP 'e' me--  toDot = dquotes . unqtDot--  unqtListToDot = hcat . punctuate semi . mapM unqtDot--  listToDot = dquotes . unqtListToDot--instance ParseDot Spline where-  parseUnqt = do ms <- parseP 's'-                 me <- parseP 'e'-                 ps <- sepBy1 parseUnqt whitespace1-                 return $ Spline ms me ps-      where-        parseP t = optional $ do character t-                                 parseComma-                                 parseUnqt `discard` whitespace1--  parse = quotedParse parseUnqt--  parseUnqtList = sepBy1 parseUnqt (character ';')---- -------------------------------------------------------------------------------data QuadType = NormalQT-              | FastQT-              | NoQT-              deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot QuadType where-  unqtDot NormalQT = text "normal"-  unqtDot FastQT   = text "fast"-  unqtDot NoQT     = text "none"--instance ParseDot QuadType where-  -- Have to take into account the slightly different interpretation-  -- of Bool used as an option for parsing QuadType-  parseUnqt = oneOf [ stringRep NormalQT "normal"-                    , stringRep FastQT "fast"-                    , stringRep NoQT "none"-                    , character '2'   >> return FastQT -- weird bool-                    , liftM (bool NoQT NormalQT) parse-                    ]---- --------------------------------------------------------------------------------- | Specify the root node either as a Node attribute or a Graph attribute.-data Root = IsCentral     -- ^ For Nodes only-          | NotCentral    -- ^ For Nodes only-          | NodeName Text -- ^ For Graphs only-          deriving (Eq, Ord, Show, Read)--instance PrintDot Root where-  unqtDot IsCentral    = unqtDot True-  unqtDot NotCentral   = unqtDot False-  unqtDot (NodeName n) = unqtDot n--  toDot (NodeName n) = toDot n-  toDot r            = unqtDot r--instance ParseDot Root where-  parseUnqt = liftM (bool NotCentral IsCentral) onlyBool-              `onFail`-              liftM NodeName parseUnqt--  parse = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool)-          `onFail`-          liftM NodeName parse---- -------------------------------------------------------------------------------data RankType = SameRank-              | MinRank-              | SourceRank-              | MaxRank-              | SinkRank-              deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot RankType where-  unqtDot SameRank   = text "same"-  unqtDot MinRank    = text "min"-  unqtDot SourceRank = text "source"-  unqtDot MaxRank    = text "max"-  unqtDot SinkRank   = text "sink"--instance ParseDot RankType where-  parseUnqt = stringValue [ ("same", SameRank)-                          , ("min", MinRank)-                          , ("source", SourceRank)-                          , ("max", MaxRank)-                          , ("sink", SinkRank)-                          ]---- -------------------------------------------------------------------------------data RankDir = FromTop-             | FromLeft-             | FromBottom-             | FromRight-             deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot RankDir where-  unqtDot FromTop    = text "TB"-  unqtDot FromLeft   = text "LR"-  unqtDot FromBottom = text "BT"-  unqtDot FromRight  = text "RL"--instance ParseDot RankDir where-  parseUnqt = oneOf [ stringRep FromTop "TB"-                    , stringRep FromLeft "LR"-                    , stringRep FromBottom "BT"-                    , stringRep FromRight "RL"-                    ]---- -------------------------------------------------------------------------------data Shape-    = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.-    | Polygon-    | Ellipse-    | Circle-    | PointShape-    | Egg-    | Triangle-    | PlainText -- ^ Has synonym of /none/.-    | DiamondShape-    | Trapezium-    | Parallelogram-    | House-    | Pentagon-    | Hexagon-    | Septagon-    | Octagon-    | DoubleCircle-    | DoubleOctagon-    | TripleOctagon-    | InvTriangle-    | InvTrapezium-    | InvHouse-    | MDiamond-    | MSquare-    | MCircle-    | Note-    | Tab-    | Folder-    | Box3D-    | Component-    | Record -- ^ Must specify the record shape with a 'Label'.-    | MRecord -- ^ Must specify the record shape with a 'Label'.-    deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Shape where-  unqtDot BoxShape      = text "box"-  unqtDot Polygon       = text "polygon"-  unqtDot Ellipse       = text "ellipse"-  unqtDot Circle        = text "circle"-  unqtDot PointShape    = text "point"-  unqtDot Egg           = text "egg"-  unqtDot Triangle      = text "triangle"-  unqtDot PlainText     = text "plaintext"-  unqtDot DiamondShape  = text "diamond"-  unqtDot Trapezium     = text "trapezium"-  unqtDot Parallelogram = text "parallelogram"-  unqtDot House         = text "house"-  unqtDot Pentagon      = text "pentagon"-  unqtDot Hexagon       = text "hexagon"-  unqtDot Septagon      = text "septagon"-  unqtDot Octagon       = text "octagon"-  unqtDot DoubleCircle  = text "doublecircle"-  unqtDot DoubleOctagon = text "doubleoctagon"-  unqtDot TripleOctagon = text "tripleoctagon"-  unqtDot InvTriangle   = text "invtriangle"-  unqtDot InvTrapezium  = text "invtrapezium"-  unqtDot InvHouse      = text "invhouse"-  unqtDot MDiamond      = text "Mdiamond"-  unqtDot MSquare       = text "Msquare"-  unqtDot MCircle       = text "Mcircle"-  unqtDot Note          = text "note"-  unqtDot Tab           = text "tab"-  unqtDot Folder        = text "folder"-  unqtDot Box3D         = text "box3d"-  unqtDot Component     = text "component"-  unqtDot Record        = text "record"-  unqtDot MRecord       = text "Mrecord"--instance ParseDot Shape where-  parseUnqt = stringValue [ ("box3d", Box3D)-                          , ("box", BoxShape)-                          , ("rectangle", BoxShape)-                          , ("rect", BoxShape)-                          , ("polygon", Polygon)-                          , ("ellipse", Ellipse)-                          , ("circle", Circle)-                          , ("point", PointShape)-                          , ("egg", Egg)-                          , ("triangle", Triangle)-                          , ("plaintext", PlainText)-                          , ("none", PlainText)-                          , ("diamond", DiamondShape)-                          , ("trapezium", Trapezium)-                          , ("parallelogram", Parallelogram)-                          , ("house", House)-                          , ("pentagon", Pentagon)-                          , ("hexagon", Hexagon)-                          , ("septagon", Septagon)-                          , ("octagon", Octagon)-                          , ("doublecircle", DoubleCircle)-                          , ("doubleoctagon", DoubleOctagon)-                          , ("tripleoctagon", TripleOctagon)-                          , ("invtriangle", InvTriangle)-                          , ("invtrapezium", InvTrapezium)-                          , ("invhouse", InvHouse)-                          , ("Mdiamond", MDiamond)-                          , ("Msquare", MSquare)-                          , ("Mcircle", MCircle)-                          , ("note", Note)-                          , ("tab", Tab)-                          , ("folder", Folder)-                          , ("component", Component)-                          , ("record", Record)-                          , ("Mrecord", MRecord)-                          ]---- -------------------------------------------------------------------------------data SmoothType = NoSmooth-                | AvgDist-                | GraphDist-                | PowerDist-                | RNG-                | Spring-                | TriangleSmooth-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot SmoothType where-  unqtDot NoSmooth       = text "none"-  unqtDot AvgDist        = text "avg_dist"-  unqtDot GraphDist      = text "graph_dist"-  unqtDot PowerDist      = text "power_dist"-  unqtDot RNG            = text "rng"-  unqtDot Spring         = text "spring"-  unqtDot TriangleSmooth = text "triangle"--instance ParseDot SmoothType where-  parseUnqt = oneOf [ stringRep NoSmooth "none"-                    , stringRep AvgDist "avg_dist"-                    , stringRep GraphDist "graph_dist"-                    , stringRep PowerDist "power_dist"-                    , stringRep RNG "rng"-                    , stringRep Spring "spring"-                    , stringRep TriangleSmooth "triangle"-                    ]---- -------------------------------------------------------------------------------data StartType = StartStyle STStyle-               | StartSeed Int-               | StartStyleSeed STStyle Int-               deriving (Eq, Ord, Show, Read)--instance PrintDot StartType where-  unqtDot (StartStyle ss)       = unqtDot ss-  unqtDot (StartSeed s)         = unqtDot s-  unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s--instance ParseDot StartType where-  parseUnqt = oneOf [ do ss <- parseUnqt-                         s  <- parseUnqt-                         return $ StartStyleSeed ss s-                    , liftM StartStyle parseUnqt-                    , liftM StartSeed parseUnqt-                    ]--data STStyle = RegularStyle-             | SelfStyle-             | RandomStyle-             deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot STStyle where-  unqtDot RegularStyle = text "regular"-  unqtDot SelfStyle    = text "self"-  unqtDot RandomStyle  = text "random"--instance ParseDot STStyle where-  parseUnqt = oneOf [ stringRep RegularStyle "regular"-                    , stringRep SelfStyle "self"-                    , stringRep RandomStyle "random"-                    ]---- --------------------------------------------------------------------------------- | An individual style item.  Except for 'DD', the @['String']@---   should be empty.-data StyleItem = SItem StyleName [Text]-               deriving (Eq, Ord, Show, Read)--instance PrintDot StyleItem where-  unqtDot (SItem nm args)-    | null args = dnm-    | otherwise = dnm <> parens args'-    where-      dnm = unqtDot nm-      args' = hcat . punctuate comma $ mapM unqtDot args--  toDot si@(SItem nm args)-    | null args = toDot nm-    | otherwise = dquotes $ unqtDot si--  unqtListToDot = hcat . punctuate comma . mapM unqtDot--  listToDot [SItem nm []] = toDot nm-  listToDot sis           = dquotes $ unqtListToDot sis--instance ParseDot StyleItem where-  parseUnqt = do nm <- parseUnqt-                 args <- tryParseList' parseArgs-                 return $ SItem nm args--  parse = quotedParse (liftM2 SItem parseUnqt parseArgs)-          `onFail`-          liftM (flip SItem []) parse--  parseUnqtList = sepBy1 parseUnqt parseComma--  parseList = quotedParse parseUnqtList-              `onFail`-              -- Might not necessarily need to be quoted if a singleton...-              liftM return parse--parseArgs :: Parse [Text]-parseArgs = bracketSep (character '(')-                       parseComma-                       (character ')')-                       parseStyleName--data StyleName = Dashed    -- ^ Nodes and Edges-               | Dotted    -- ^ Nodes and Edges-               | Solid     -- ^ Nodes and Edges-               | Bold      -- ^ Nodes and Edges-               | Invisible -- ^ Nodes and Edges-               | Filled    -- ^ Nodes and Clusters-               | Diagonals -- ^ Nodes only-               | Rounded   -- ^ Nodes and Clusters-               | Tapered   -- ^ Edges only; requires Graphviz >=-                           --   2.29.0.-               | Radial    -- ^ Nodes, Clusters and Graphs, for use-                           --   with 'GradientAngle'; requires-                           --   Graphviz >= 2.29.0.-               | DD Text   -- ^ Device Dependent-               deriving (Eq, Ord, Show, Read)--instance PrintDot StyleName where-  unqtDot Dashed    = text "dashed"-  unqtDot Dotted    = text "dotted"-  unqtDot Solid     = text "solid"-  unqtDot Bold      = text "bold"-  unqtDot Invisible = text "invis"-  unqtDot Filled    = text "filled"-  unqtDot Diagonals = text "diagonals"-  unqtDot Rounded   = text "rounded"-  unqtDot Tapered   = text "tapered"-  unqtDot Radial    = text "radial"-  unqtDot (DD nm)   = unqtDot nm--  toDot (DD nm) = toDot nm-  toDot sn      = unqtDot sn--instance ParseDot StyleName where-  parseUnqt = liftM checkDD parseStyleName--  parse = quotedParse parseUnqt-          `onFail`-          liftM checkDD quotelessString--checkDD     :: Text -> StyleName-checkDD str = case T.toLower str of-                "dashed"    -> Dashed-                "dotted"    -> Dotted-                "solid"     -> Solid-                "bold"      -> Bold-                "invis"     -> Invisible-                "filled"    -> Filled-                "diagonals" -> Diagonals-                "rounded"   -> Rounded-                "tapered"   -> Tapered-                "radial"    -> Radial-                _           -> DD str--parseStyleName :: Parse Text-parseStyleName = do f <- orEscaped . noneOf $ ' ' : disallowedChars-                    r <- parseEscaped True [] disallowedChars-                    return $ f `T.cons` r-  where-    disallowedChars = [quoteChar, '(', ')', ',']-    -- Used because the first character has slightly stricter requirements than the rest.-    orSlash p = stringRep '\\' "\\\\" `onFail` p-    orEscaped = orQuote . orSlash---- -------------------------------------------------------------------------------data ViewPort = VP { wVal  :: Double-                   , hVal  :: Double-                   , zVal  :: Double-                   , focus :: Maybe FocusType-                   }-              deriving (Eq, Ord, Show, Read)--instance PrintDot ViewPort where-  unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)-               $ focus vp-    where-      vs = hcat . punctuate comma-           $ mapM (unqtDot . flip ($) vp) [wVal, hVal, zVal]--  toDot = dquotes . unqtDot--instance ParseDot ViewPort where-  parseUnqt = do wv <- parseUnqt-                 parseComma-                 hv <- parseUnqt-                 parseComma-                 zv <- parseUnqt-                 mf <- optional $ parseComma >> parseUnqt-                 return $ VP wv hv zv mf--  parse = quotedParse parseUnqt---- | For use with 'ViewPort'.-data FocusType = XY Point-               | NodeFocus Text-               deriving (Eq, Ord, Show, Read)--instance PrintDot FocusType where-  unqtDot (XY p)         = unqtDot p-  unqtDot (NodeFocus nm) = unqtDot nm--  toDot (XY p)         = toDot p-  toDot (NodeFocus nm) = toDot nm--instance ParseDot FocusType where-  parseUnqt = liftM XY parseUnqt-              `onFail`-              liftM NodeFocus parseUnqt--  parse = liftM XY parse-          `onFail`-          liftM NodeFocus parse---- -------------------------------------------------------------------------------data VerticalPlacement = VTop-                       | VCenter -- ^ Only valid for Nodes.-                       | VBottom-                       deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot VerticalPlacement where-  unqtDot VTop    = char 't'-  unqtDot VCenter = char 'c'-  unqtDot VBottom = char 'b'--instance ParseDot VerticalPlacement where-  parseUnqt = oneOf [ stringRep VTop "t"-                    , stringRep VCenter "c"-                    , stringRep VBottom "b"-                    ]---- -------------------------------------------------------------------------------newtype Paths = Paths { paths :: [FilePath] }-    deriving (Eq, Ord, Show, Read)--instance PrintDot Paths where-    unqtDot = unqtDot . intercalate [searchPathSeparator] . paths--    toDot (Paths [p]) = toDot p-    toDot ps          = dquotes $ unqtDot ps--instance ParseDot Paths where-    parseUnqt = liftM (Paths . splitSearchPath) parseUnqt--    parse = quotedParse parseUnqt-            `onFail`-            liftM (Paths . (:[]) . T.unpack) quotelessString---- -------------------------------------------------------------------------------data ScaleType = UniformScale-               | NoScale-               | FillWidth-               | FillHeight-               | FillBoth-               deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ScaleType where-  unqtDot UniformScale = unqtDot True-  unqtDot NoScale      = unqtDot False-  unqtDot FillWidth    = text "width"-  unqtDot FillHeight   = text "height"-  unqtDot FillBoth     = text "both"--instance ParseDot ScaleType where-  parseUnqt = oneOf [ stringRep UniformScale "true"-                    , stringRep NoScale "false"-                    , stringRep FillWidth "width"-                    , stringRep FillHeight "height"-                    , stringRep FillBoth "both"-                    ]---- -------------------------------------------------------------------------------data Justification = JLeft-                   | JRight-                   | JCenter-                   deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Justification where-  unqtDot JLeft   = char 'l'-  unqtDot JRight  = char 'r'-  unqtDot JCenter = char 'c'--instance ParseDot Justification where-  parseUnqt = oneOf [ stringRep JLeft "l"-                    , stringRep JRight "r"-                    , stringRep JCenter "c"-                    ]---- -------------------------------------------------------------------------------data Ratios = AspectRatio Double-            | FillRatio-            | CompressRatio-            | ExpandRatio-            | AutoRatio-            deriving (Eq, Ord, Show, Read)--instance PrintDot Ratios where-  unqtDot (AspectRatio r) = unqtDot r-  unqtDot FillRatio       = text "fill"-  unqtDot CompressRatio   = text "compress"-  unqtDot ExpandRatio     = text "expand"-  unqtDot AutoRatio       = text "auto"--instance ParseDot Ratios where-  parseUnqt = oneOf [ liftM AspectRatio parseUnqt-                    , stringRep FillRatio "fill"-                    , stringRep CompressRatio "compress"-                    , stringRep ExpandRatio "expand"-                    , stringRep AutoRatio "auto"-                    ]+{-# LANGUAGE CPP, OverloadedStrings #-}++{- |+   Module      : Data.GraphViz.Attributes.Complete+   Description : Definition of the Graphviz attributes.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   If you are just using graphviz to create basic Dot graphs, then you+   probably want to use "Data.GraphViz.Attributes" rather than this+   module.++   This module defines the various attributes that different parts of+   a Graphviz graph can have.  These attributes are based on the+   documentation found at:+     <http://graphviz.org/doc/info/attrs.html>++   For more information on usage, etc. please see that document.++   A summary of known current constraints\/limitations\/differences:++   * Note that for an edge, in /Dot/ parlance if the edge goes from+     /A/ to /B/, then /A/ is the tail node and /B/ is the head node+     (since /A/ is at the tail end of the arrow).++   * @ColorList@, @DoubleList@ and @PointfList@ are defined as actual+     lists (@'LayerList'@ needs a newtype for other reasons).  All of these+     are assumed to be non-empty lists.++   * For the various @*Color@ attributes that take in a list of+     'Color' values, usually only one color is used.  The @Color@+     attribute for edges allows multiple values; for other attributes,+     two values are supported for gradient fills in Graphviz >=+     2.29.0.++   * Style is implemented as a list of 'StyleItem' values; note that+     empty lists are not allowed.++   * A lot of values have a possible value of @none@.  These now+     have custom constructors.  In fact, most constructors have been+     expanded upon to give an idea of what they represent rather than+     using generic terms.++   * 'Rect' uses two 'Point' values to denote the lower-left and+     top-right corners.++   * The two 'LabelLoc' attributes have been combined.++   * @SplineType@ has been replaced with @['Spline']@.++   * Only polygon-based 'Shape's are available.++   * Not every 'Attribute' is fully documented/described.  However,+     all those which have specific allowed values should be covered.++   * Deprecated 'Overlap' algorithms are not defined.  Furthermore,+     the ability to specify an integer prefix for use with the fdp layout+     is /not/ supported.++   * The global @Orientation@ attribute is not defined, as it is+     difficult to distinguish from the node-based 'Orientation'+     'Attribute'; also, its behaviour is duplicated by 'Rotate'.++   * The @charset@ attribute is not available, as graphviz only+     supports UTF-8 encoding (as it is not currently feasible nor needed to+     also support Latin1 encoding).++   * In Graphviz, when a node or edge has a list of attributes, the+     colorscheme which is used to identify a color can be set /after/+     that color (e.g. @[colorscheme=x11,color=grey,colorscheme=svg]@+     uses the svg colorscheme's definition of grey, which is different+     from the x11 one.  Instead, graphviz parses them in order.++ -}+module Data.GraphViz.Attributes.Complete+       ( -- * The actual /Dot/ attributes.+         -- $attributes+         Attribute(..)+       , Attributes+       , sameAttribute+       , defaultAttributeValue+       , rmUnwantedAttributes+         -- ** Validity functions on @Attribute@ values.+       , usedByGraphs+       , usedBySubGraphs+       , usedByClusters+       , usedByNodes+       , usedByEdges+       , validUnknown++         -- ** Custom attributes.+       , AttributeName+       , CustomAttribute+       , customAttribute+       , isCustom+       , isSpecifiedCustom+       , customValue+       , customName+       , findCustoms+       , findSpecifiedCustom+       , deleteCustomAttributes+       , deleteSpecifiedCustom++         -- * Value types for @Attribute@s.+       , module Data.GraphViz.Attributes.Colors++         -- ** Generic types+       , Number (..)++         -- ** Labels+       , EscString+       , Label(..)+       , VerticalPlacement(..)+       , LabelScheme(..)+       , SVGFontNames(..)+         -- *** Types representing the Dot grammar for records.+       , RecordFields+       , RecordField(..)+       , Rect(..)+       , Justification(..)++         -- ** Nodes+       , Shape(..)+       , Paths(..)+       , ScaleType(..)+       , NodeSize(..)++         -- ** Edges+       , DirType(..)+       , EdgeType(..)+         -- *** Modifying where edges point+       , PortName(..)+       , PortPos(..)+       , CompassPoint(..)+         -- *** Arrows+       , ArrowType(..)+       , ArrowShape(..)+       , ArrowModifier(..)+       , ArrowFill(..)+       , ArrowSide(..)+         -- **** @ArrowModifier@ values+       , noMods+       , openMod++         -- ** Positioning+       , Point(..)+       , createPoint+       , Pos(..)+       , Spline(..)+       , DPoint(..)+       , Normalized (..)++         -- ** Layout+       , GraphvizCommand(..)+       , GraphSize(..)+       , ClusterMode(..)+       , Model(..)+       , Overlap(..)+       , Root(..)+       , Order(..)+       , OutputMode(..)+       , Pack(..)+       , PackMode(..)+       , PageDir(..)+       , QuadType(..)+       , RankType(..)+       , RankDir(..)+       , StartType(..)+       , ViewPort(..)+       , FocusType(..)+       , Ratios(..)++         -- ** Modes+       , ModeType(..)+       , DEConstraints(..)++         -- ** Layers+       , LayerSep(..)+       , LayerListSep(..)+       , LayerRange+       , LayerRangeElem(..)+       , LayerID(..)+       , LayerList(..)++         -- ** Stylistic+       , SmoothType(..)+       , STStyle(..)+       , StyleItem(..)+       , StyleName(..)+       ) where++import Data.GraphViz.Attributes.Arrows+import Data.GraphViz.Attributes.Colors+import Data.GraphViz.Attributes.Colors.X11 (X11Color(Black))+import Data.GraphViz.Attributes.Internal+import Data.GraphViz.Attributes.Values+import Data.GraphViz.Commands.Available+import Data.GraphViz.Exception             (GraphvizException(NotCustomAttr),+                                            throw)+import Data.GraphViz.Internal.State        (getsGS, parseStrictly)+import Data.GraphViz.Internal.Util         (bool, isIDString, keywords,+                                            restIDString)+import Data.GraphViz.Parsing+import Data.GraphViz.Printing++import           Data.List      (partition)+import           Data.Maybe     (isNothing)+import qualified Data.Set       as S+import           Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import           Data.Version   (Version(..))+import           Data.Word      (Word16)++#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif++-- -----------------------------------------------------------------------------++{- $attributes++   These attributes have been implemented in a /permissive/ manner:+   that is, rather than split them up based on which type of value+   they are allowed, they have all been included in the one data type,+   with functions to determine if they are indeed valid for what+   they're being applied to.++   To interpret the /Valid for/ listings:++     [@G@] Valid for Graphs.++     [@C@] Valid for Clusters.++     [@S@] Valid for Sub-Graphs (and also Clusters).++     [@N@] Valid for Nodes.++     [@E@] Valid for Edges.++   The /Default/ listings are those that the various Graphviz commands+   use if that 'Attribute' isn't specified (in cases where this is+   /none/, this is equivalent to a 'Nothing' value; that is, no value+   is used).  The /Parsing Default/ listings represent what value is+   used (i.e. corresponds to 'True') when the 'Attribute' name is+   listed on its own in /Dot/ source code.++   Please note that the 'UnknownAttribute' 'Attribute' is defined+   primarily for backwards-compatibility purposes.  It is possible to use+   it directly for custom purposes; for more information, please see+   'CustomAttribute'.  The 'deleteCustomAttributes' can be used to delete+   these values.++ -}++-- | Attributes are used to customise the layout and design of Dot+--   graphs.  Care must be taken to ensure that the attribute you use+--   is valid, as not all attributes can be used everywhere.+data Attribute+  = Damping Double                      -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: 'Neato' only+  | K Double                            -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: 'Sfdp', 'Fdp' only+  | URL EscString                       -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only+  | Area Double                         -- ^ /Valid for/: NC; /Default/: @1.0@; /Minimum/: @>0@; /Notes/: 'Patchwork' only, requires Graphviz >= 2.30.0+  | ArrowHead ArrowType                 -- ^ /Valid for/: E; /Default/: @'normal'@+  | ArrowSize Double                    -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@+  | ArrowTail ArrowType                 -- ^ /Valid for/: E; /Default/: @'normal'@+  | Background Text                     -- ^ /Valid for/: G; /Default/: none; /Notes/: xdot only+  | BoundingBox Rect                    -- ^ /Valid for/: G; /Notes/: write only+  | BgColor ColorList                   -- ^ /Valid for/: GC; /Default/: @[]@+  | Center Bool                         -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+  | ClusterRank ClusterMode             -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: 'Dot' only+  | Color ColorList                     -- ^ /Valid for/: ENC; /Default/: @['WC' ('X11Color' 'Black') Nothing]@+  | ColorScheme ColorScheme             -- ^ /Valid for/: ENCG; /Default/: @'X11'@+  | Comment Text                        -- ^ /Valid for/: ENG; /Default/: @\"\"@+  | Compound Bool                       -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Dot' only+  | Concentrate Bool                    -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+  | Constraint Bool                     -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: 'Dot' only+  | Decorate Bool                       -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'+  | DefaultDist Double                  -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(abs(V))@ (unable to statically define); /Minimum/: The value of 'Epsilon'.; /Notes/: 'Neato' only, only if @'Pack' 'DontPack'@+  | Dim Int                             -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only+  | Dimen Int                           -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only+  | Dir DirType                         -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)+  | DirEdgeConstraints DEConstraints    -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: 'Neato' only+  | Distortion Double                   -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@+  | DPI Double                          -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym+  | EdgeURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | EdgeTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | EdgeTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Epsilon Double                      -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: 'Neato' only+  | ESep DPoint                         -- ^ /Valid for/: G; /Default/: @'DVal' 3@; /Notes/: not 'Dot'+  | FillColor ColorList                 -- ^ /Valid for/: NEC; /Default/: @['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters)+  | FixedSize NodeSize                  -- ^ /Valid for/: N; /Default/: @'GrowAsNeeded'@; /Parsing Default/: 'SetNodeSize'+  | FontColor Color                     -- ^ /Valid for/: ENGC; /Default/: @'X11Color' 'Black'@+  | FontName Text                       -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@+  | FontNames SVGFontNames              -- ^ /Valid for/: G; /Default/: @'SvgNames'@; /Notes/: svg only+  | FontPath Paths                      -- ^ /Valid for/: G; /Default/: system dependent+  | FontSize Double                     -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@+  | ForceLabels Bool                    -- ^ /Valid for/: G; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: only for 'XLabel' attributes, requires Graphviz >= 2.29.0+  | GradientAngle Int                   -- ^ /Valid for/: NCG; /Default/: 0; /Notes/: requires Graphviz >= 2.29.0+  | Group Text                          -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: 'Dot' only+  | HeadURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | Head_LP Point                       -- ^ /Valid for/: E; /Notes/: write only, requires Graphviz >= 2.30.0+  | HeadClip Bool                       -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'+  | HeadLabel Label                     -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@+  | HeadPort PortPos                    -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@+  | HeadTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | HeadTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Height Double                       -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@+  | ID EscString                        -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only+  | Image Text                          -- ^ /Valid for/: N; /Default/: @\"\"@+  | ImagePath Paths                     -- ^ /Valid for/: G; /Default/: @'Paths' []@; /Notes/: Printing and parsing is OS-specific, requires Graphviz >= 2.29.0+  | ImageScale ScaleType                -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'+  | InputScale Double                   -- ^ /Valid for/: N; /Default/: none; /Notes/: 'Fdp', 'Neato' only, a value of @0@ is equivalent to being @72@, requires Graphviz >= 2.36.0+  | Label Label                         -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)+  | LabelURL EscString                  -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | LabelScheme LabelScheme             -- ^ /Valid for/: G; /Default/: @'NotEdgeLabel'@; /Notes/: 'Sfdp' only, requires Graphviz >= 2.28.0+  | LabelAngle Double                   -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@+  | LabelDistance Double                -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@+  | LabelFloat Bool                     -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'+  | LabelFontColor Color                -- ^ /Valid for/: E; /Default/: @'X11Color' 'Black'@+  | LabelFontName Text                  -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@+  | LabelFontSize Double                -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@+  | LabelJust Justification             -- ^ /Valid for/: GC; /Default/: @'JCenter'@+  | LabelLoc VerticalPlacement          -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)+  | LabelTarget EscString               -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | LabelTooltip EscString              -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Landscape Bool                      -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+  | Layer LayerRange                    -- ^ /Valid for/: ENC; /Default/: @[]@+  | LayerListSep LayerListSep           -- ^ /Valid for/: G; /Default/: @'LLSep' \",\"@; /Notes/: requires Graphviz >= 2.30.0+  | Layers LayerList                    -- ^ /Valid for/: G; /Default/: @'LL' []@+  | LayerSelect LayerRange              -- ^ /Valid for/: G; /Default/: @[]@+  | LayerSep LayerSep                   -- ^ /Valid for/: G; /Default/: @'LSep' \" :\t\"@+  | Layout GraphvizCommand              -- ^ /Valid for/: G+  | Len Double                          -- ^ /Valid for/: E; /Default/: @1.0@ ('Neato'), @0.3@ ('Fdp'); /Notes/: 'Fdp', 'Neato' only+  | Levels Int                          -- ^ /Valid for/: G; /Default/: @'maxBound'@; /Minimum/: @0@; /Notes/: 'Sfdp' only+  | LevelsGap Double                    -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: 'Neato' only+  | LHead Text                          -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only+  | LHeight Double                      -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0+  | LPos Point                          -- ^ /Valid for/: EGC; /Notes/: write only+  | LTail Text                          -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only+  | LWidth Double                       -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0+  | Margin DPoint                       -- ^ /Valid for/: NGC; /Default/: device dependent+  | MaxIter Int                         -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ ('Fdp'); /Notes/: 'Fdp', 'Neato' only+  | MCLimit Double                      -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: 'Dot' only+  | MinDist Double                      -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: 'Circo' only+  | MinLen Int                          -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: 'Dot' only+  | Mode ModeType                       -- ^ /Valid for/: G; /Default/: @'Major'@ (actually @'Spring'@ for 'Sfdp', but this isn't used as a default in this library); /Notes/: 'Neato', 'Sfdp' only+  | Model Model                         -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: 'Neato' only+  | Mosek Bool                          -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Neato' only; requires the Mosek software+  | NodeSep Double                      -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@+  | NoJustify Bool                      -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True'+  | Normalize Normalized                -- ^ /Valid for/: G; /Default/: @'NotNormalized'@; /Parsing Default/: 'IsNormalized'; /Notes/: not 'Dot'+  | NoTranslate Bool                    -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Neato' only, requires Graphviz >= 2.38.0+  | Nslimit Double                      -- ^ /Valid for/: G; /Notes/: 'Dot' only+  | Nslimit1 Double                     -- ^ /Valid for/: G; /Notes/: 'Dot' only+  | Ordering Order                      -- ^ /Valid for/: GN; /Default/: none; /Notes/: 'Dot' only+  | Orientation Double                  -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@+  | OutputOrder OutputMode              -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@+  | Overlap Overlap                     -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not 'Dot'+  | OverlapScaling Double               -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: 'PrismOverlap' only+  | OverlapShrink Bool                  -- ^ /Valid for/: G; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: 'PrismOverlap' only, requires Graphviz >= 2.36.0+  | Pack Pack                           -- ^ /Valid for/: G; /Default/: @'DontPack'@; /Parsing Default/: 'DoPack'+  | PackMode PackMode                   -- ^ /Valid for/: G; /Default/: @'PackNode'@+  | Pad DPoint                          -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)+  | Page Point                          -- ^ /Valid for/: G+  | PageDir PageDir                     -- ^ /Valid for/: G; /Default/: @'Bl'@+  | PenColor Color                      -- ^ /Valid for/: C; /Default/: @'X11Color' 'Black'@+  | PenWidth Double                     -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@+  | Peripheries Int                     -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0+  | Pin Bool                            -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Fdp', 'Neato' only+  | Pos Pos                             -- ^ /Valid for/: EN+  | QuadTree QuadType                   -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: 'Sfdp' only+  | Quantum Double                      -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@+  | Rank RankType                       -- ^ /Valid for/: S; /Notes/: 'Dot' only+  | RankDir RankDir                     -- ^ /Valid for/: G; /Default/: @'FromTop'@; /Notes/: 'Dot' only+  | RankSep [Double]                    -- ^ /Valid for/: G; /Default/: @[0.5]@ ('Dot'), @[1.0]@ ('Twopi'); /Minimum/: @[0.02]@; /Notes/: 'Twopi', 'Dot' only+  | Ratio Ratios                        -- ^ /Valid for/: G+  | Rects [Rect]                        -- ^ /Valid for/: N; /Notes/: write only+  | Regular Bool                        -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'+  | ReMinCross Bool                     -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Dot' only+  | RepulsiveForce Double               -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: 'Sfdp' only+  | Root Root                           -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: 'Circo', 'Twopi' only+  | Rotate Int                          -- ^ /Valid for/: G; /Default/: @0@+  | Rotation Double                     -- ^ /Valid for/: G; /Default/: @0@; /Notes/: 'Sfdp' only, requires Graphviz >= 2.28.0+  | SameHead Text                       -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only+  | SameTail Text                       -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only+  | SamplePoints Int                    -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)+  | Scale DPoint                        -- ^ /Valid for/: G; /Notes/: Not 'Dot', requires Graphviz >= 2.28.0 (>= 2.38.0 for anything except 'TwoPi')+  | SearchSize Int                      -- ^ /Valid for/: G; /Default/: @30@; /Notes/: 'Dot' only+  | Sep DPoint                          -- ^ /Valid for/: G; /Default/: @'DVal' 4@; /Notes/: not 'Dot'+  | Shape Shape                         -- ^ /Valid for/: N; /Default/: @'Ellipse'@+  | ShowBoxes Int                       -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: 'Dot' only; used for debugging by printing PostScript guide boxes+  | Sides Int                           -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@+  | Size GraphSize                      -- ^ /Valid for/: G+  | Skew Double                         -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@+  | Smoothing SmoothType                -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: 'Sfdp' only+  | SortV Word16                        -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@+  | Splines EdgeType                    -- ^ /Valid for/: G; /Default/: @'SplineEdges'@ ('Dot'), @'LineEdges'@ (other); /Parsing Default/: 'SplineEdges'+  | Start StartType                     -- ^ /Valid for/: G; /Default/: @'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed.; /Notes/: 'Fdp', 'Neato' only+  | Style [StyleItem]                   -- ^ /Valid for/: ENCG+  | StyleSheet Text                     -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only+  | TailURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | Tail_LP Point                       -- ^ /Valid for/: E; /Notes/: write only, requires Graphviz >= 2.30.0+  | TailClip Bool                       -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'+  | TailLabel Label                     -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@+  | TailPort PortPos                    -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@+  | TailTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | TailTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Target EscString                    -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only+  | Tooltip EscString                   -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only+  | TrueColor Bool                      -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only+  | Vertices [Point]                    -- ^ /Valid for/: N; /Notes/: write only+  | ViewPort ViewPort                   -- ^ /Valid for/: G; /Default/: none+  | VoroMargin Double                   -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not 'Dot'+  | Weight Number                       -- ^ /Valid for/: E; /Default/: @'Int' 1@; /Minimum/: @'Int' 0@ ('Dot'), @'Int' 1@ ('Neato','Fdp','Sfdp'); /Notes/: as of Graphviz 2.30: weights for dot need to be 'Int's+  | Width Double                        -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@+  | XDotVersion Version                 -- ^ /Valid for/: G; /Notes/: xdot only, requires Graphviz >= 2.34.0, equivalent to specifying version of xdot to be used+  | XLabel Label                        -- ^ /Valid for/: EN; /Default/: @'StrLabel' \"\"@; /Notes/: requires Graphviz >= 2.29.0+  | XLP Point                           -- ^ /Valid for/: EN; /Notes/: write only, requires Graphviz >= 2.29.0+  | UnknownAttribute AttributeName Text -- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively.+  deriving (Eq, Ord, Show, Read)++type Attributes = [Attribute]++-- | The name for an UnknownAttribute; must satisfy  'validUnknown'.+type AttributeName = Text++instance PrintDot Attribute where+  unqtDot (Damping v)            = printField "Damping" v+  unqtDot (K v)                  = printField "K" v+  unqtDot (URL v)                = printField "URL" v+  unqtDot (Area v)               = printField "area" v+  unqtDot (ArrowHead v)          = printField "arrowhead" v+  unqtDot (ArrowSize v)          = printField "arrowsize" v+  unqtDot (ArrowTail v)          = printField "arrowtail" v+  unqtDot (Background v)         = printField "_background" v+  unqtDot (BoundingBox v)        = printField "bb" v+  unqtDot (BgColor v)            = printField "bgcolor" v+  unqtDot (Center v)             = printField "center" v+  unqtDot (ClusterRank v)        = printField "clusterrank" v+  unqtDot (Color v)              = printField "color" v+  unqtDot (ColorScheme v)        = printField "colorscheme" v+  unqtDot (Comment v)            = printField "comment" v+  unqtDot (Compound v)           = printField "compound" v+  unqtDot (Concentrate v)        = printField "concentrate" v+  unqtDot (Constraint v)         = printField "constraint" v+  unqtDot (Decorate v)           = printField "decorate" v+  unqtDot (DefaultDist v)        = printField "defaultdist" v+  unqtDot (Dim v)                = printField "dim" v+  unqtDot (Dimen v)              = printField "dimen" v+  unqtDot (Dir v)                = printField "dir" v+  unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v+  unqtDot (Distortion v)         = printField "distortion" v+  unqtDot (DPI v)                = printField "dpi" v+  unqtDot (EdgeURL v)            = printField "edgeURL" v+  unqtDot (EdgeTarget v)         = printField "edgetarget" v+  unqtDot (EdgeTooltip v)        = printField "edgetooltip" v+  unqtDot (Epsilon v)            = printField "epsilon" v+  unqtDot (ESep v)               = printField "esep" v+  unqtDot (FillColor v)          = printField "fillcolor" v+  unqtDot (FixedSize v)          = printField "fixedsize" v+  unqtDot (FontColor v)          = printField "fontcolor" v+  unqtDot (FontName v)           = printField "fontname" v+  unqtDot (FontNames v)          = printField "fontnames" v+  unqtDot (FontPath v)           = printField "fontpath" v+  unqtDot (FontSize v)           = printField "fontsize" v+  unqtDot (ForceLabels v)        = printField "forcelabels" v+  unqtDot (GradientAngle v)      = printField "gradientangle" v+  unqtDot (Group v)              = printField "group" v+  unqtDot (HeadURL v)            = printField "headURL" v+  unqtDot (Head_LP v)            = printField "head_lp" v+  unqtDot (HeadClip v)           = printField "headclip" v+  unqtDot (HeadLabel v)          = printField "headlabel" v+  unqtDot (HeadPort v)           = printField "headport" v+  unqtDot (HeadTarget v)         = printField "headtarget" v+  unqtDot (HeadTooltip v)        = printField "headtooltip" v+  unqtDot (Height v)             = printField "height" v+  unqtDot (ID v)                 = printField "id" v+  unqtDot (Image v)              = printField "image" v+  unqtDot (ImagePath v)          = printField "imagepath" v+  unqtDot (ImageScale v)         = printField "imagescale" v+  unqtDot (InputScale v)         = printField "inputscale" v+  unqtDot (Label v)              = printField "label" v+  unqtDot (LabelURL v)           = printField "labelURL" v+  unqtDot (LabelScheme v)        = printField "label_scheme" v+  unqtDot (LabelAngle v)         = printField "labelangle" v+  unqtDot (LabelDistance v)      = printField "labeldistance" v+  unqtDot (LabelFloat v)         = printField "labelfloat" v+  unqtDot (LabelFontColor v)     = printField "labelfontcolor" v+  unqtDot (LabelFontName v)      = printField "labelfontname" v+  unqtDot (LabelFontSize v)      = printField "labelfontsize" v+  unqtDot (LabelJust v)          = printField "labeljust" v+  unqtDot (LabelLoc v)           = printField "labelloc" v+  unqtDot (LabelTarget v)        = printField "labeltarget" v+  unqtDot (LabelTooltip v)       = printField "labeltooltip" v+  unqtDot (Landscape v)          = printField "landscape" v+  unqtDot (Layer v)              = printField "layer" v+  unqtDot (LayerListSep v)       = printField "layerlistsep" v+  unqtDot (Layers v)             = printField "layers" v+  unqtDot (LayerSelect v)        = printField "layerselect" v+  unqtDot (LayerSep v)           = printField "layersep" v+  unqtDot (Layout v)             = printField "layout" v+  unqtDot (Len v)                = printField "len" v+  unqtDot (Levels v)             = printField "levels" v+  unqtDot (LevelsGap v)          = printField "levelsgap" v+  unqtDot (LHead v)              = printField "lhead" v+  unqtDot (LHeight v)            = printField "LHeight" v+  unqtDot (LPos v)               = printField "lp" v+  unqtDot (LTail v)              = printField "ltail" v+  unqtDot (LWidth v)             = printField "lwidth" v+  unqtDot (Margin v)             = printField "margin" v+  unqtDot (MaxIter v)            = printField "maxiter" v+  unqtDot (MCLimit v)            = printField "mclimit" v+  unqtDot (MinDist v)            = printField "mindist" v+  unqtDot (MinLen v)             = printField "minlen" v+  unqtDot (Mode v)               = printField "mode" v+  unqtDot (Model v)              = printField "model" v+  unqtDot (Mosek v)              = printField "mosek" v+  unqtDot (NodeSep v)            = printField "nodesep" v+  unqtDot (NoJustify v)          = printField "nojustify" v+  unqtDot (Normalize v)          = printField "normalize" v+  unqtDot (NoTranslate v)        = printField "notranslate" v+  unqtDot (Nslimit v)            = printField "nslimit" v+  unqtDot (Nslimit1 v)           = printField "nslimit1" v+  unqtDot (Ordering v)           = printField "ordering" v+  unqtDot (Orientation v)        = printField "orientation" v+  unqtDot (OutputOrder v)        = printField "outputorder" v+  unqtDot (Overlap v)            = printField "overlap" v+  unqtDot (OverlapScaling v)     = printField "overlap_scaling" v+  unqtDot (OverlapShrink v)      = printField "overlap_shrink" v+  unqtDot (Pack v)               = printField "pack" v+  unqtDot (PackMode v)           = printField "packmode" v+  unqtDot (Pad v)                = printField "pad" v+  unqtDot (Page v)               = printField "page" v+  unqtDot (PageDir v)            = printField "pagedir" v+  unqtDot (PenColor v)           = printField "pencolor" v+  unqtDot (PenWidth v)           = printField "penwidth" v+  unqtDot (Peripheries v)        = printField "peripheries" v+  unqtDot (Pin v)                = printField "pin" v+  unqtDot (Pos v)                = printField "pos" v+  unqtDot (QuadTree v)           = printField "quadtree" v+  unqtDot (Quantum v)            = printField "quantum" v+  unqtDot (Rank v)               = printField "rank" v+  unqtDot (RankDir v)            = printField "rankdir" v+  unqtDot (RankSep v)            = printField "ranksep" v+  unqtDot (Ratio v)              = printField "ratio" v+  unqtDot (Rects v)              = printField "rects" v+  unqtDot (Regular v)            = printField "regular" v+  unqtDot (ReMinCross v)         = printField "remincross" v+  unqtDot (RepulsiveForce v)     = printField "repulsiveforce" v+  unqtDot (Root v)               = printField "root" v+  unqtDot (Rotate v)             = printField "rotate" v+  unqtDot (Rotation v)           = printField "rotation" v+  unqtDot (SameHead v)           = printField "samehead" v+  unqtDot (SameTail v)           = printField "sametail" v+  unqtDot (SamplePoints v)       = printField "samplepoints" v+  unqtDot (Scale v)              = printField "scale" v+  unqtDot (SearchSize v)         = printField "searchsize" v+  unqtDot (Sep v)                = printField "sep" v+  unqtDot (Shape v)              = printField "shape" v+  unqtDot (ShowBoxes v)          = printField "showboxes" v+  unqtDot (Sides v)              = printField "sides" v+  unqtDot (Size v)               = printField "size" v+  unqtDot (Skew v)               = printField "skew" v+  unqtDot (Smoothing v)          = printField "smoothing" v+  unqtDot (SortV v)              = printField "sortv" v+  unqtDot (Splines v)            = printField "splines" v+  unqtDot (Start v)              = printField "start" v+  unqtDot (Style v)              = printField "style" v+  unqtDot (StyleSheet v)         = printField "stylesheet" v+  unqtDot (TailURL v)            = printField "tailURL" v+  unqtDot (Tail_LP v)            = printField "tail_lp" v+  unqtDot (TailClip v)           = printField "tailclip" v+  unqtDot (TailLabel v)          = printField "taillabel" v+  unqtDot (TailPort v)           = printField "tailport" v+  unqtDot (TailTarget v)         = printField "tailtarget" v+  unqtDot (TailTooltip v)        = printField "tailtooltip" v+  unqtDot (Target v)             = printField "target" v+  unqtDot (Tooltip v)            = printField "tooltip" v+  unqtDot (TrueColor v)          = printField "truecolor" v+  unqtDot (Vertices v)           = printField "vertices" v+  unqtDot (ViewPort v)           = printField "viewport" v+  unqtDot (VoroMargin v)         = printField "voro_margin" v+  unqtDot (Weight v)             = printField "weight" v+  unqtDot (Width v)              = printField "width" v+  unqtDot (XDotVersion v)        = printField "xdotversion" v+  unqtDot (XLabel v)             = printField "xlabel" v+  unqtDot (XLP v)                = printField "xlp" v+  unqtDot (UnknownAttribute a v) = toDot a <> equals <> toDot v++  listToDot = unqtListToDot++instance ParseDot Attribute where+  parseUnqt = stringParse (concat [ parseField Damping "Damping"+                                  , parseField K "K"+                                  , parseFields URL ["URL", "href"]+                                  , parseField Area "area"+                                  , parseField ArrowHead "arrowhead"+                                  , parseField ArrowSize "arrowsize"+                                  , parseField ArrowTail "arrowtail"+                                  , parseField Background "_background"+                                  , parseField BoundingBox "bb"+                                  , parseField BgColor "bgcolor"+                                  , parseFieldBool Center "center"+                                  , parseField ClusterRank "clusterrank"+                                  , parseField Color "color"+                                  , parseField ColorScheme "colorscheme"+                                  , parseField Comment "comment"+                                  , parseFieldBool Compound "compound"+                                  , parseFieldBool Concentrate "concentrate"+                                  , parseFieldBool Constraint "constraint"+                                  , parseFieldBool Decorate "decorate"+                                  , parseField DefaultDist "defaultdist"+                                  , parseField Dim "dim"+                                  , parseField Dimen "dimen"+                                  , parseField Dir "dir"+                                  , parseFieldDef DirEdgeConstraints EdgeConstraints "diredgeconstraints"+                                  , parseField Distortion "distortion"+                                  , parseFields DPI ["dpi", "resolution"]+                                  , parseFields EdgeURL ["edgeURL", "edgehref"]+                                  , parseField EdgeTarget "edgetarget"+                                  , parseField EdgeTooltip "edgetooltip"+                                  , parseField Epsilon "epsilon"+                                  , parseField ESep "esep"+                                  , parseField FillColor "fillcolor"+                                  , parseFieldDef FixedSize SetNodeSize "fixedsize"+                                  , parseField FontColor "fontcolor"+                                  , parseField FontName "fontname"+                                  , parseField FontNames "fontnames"+                                  , parseField FontPath "fontpath"+                                  , parseField FontSize "fontsize"+                                  , parseFieldBool ForceLabels "forcelabels"+                                  , parseField GradientAngle "gradientangle"+                                  , parseField Group "group"+                                  , parseFields HeadURL ["headURL", "headhref"]+                                  , parseField Head_LP "head_lp"+                                  , parseFieldBool HeadClip "headclip"+                                  , parseField HeadLabel "headlabel"+                                  , parseField HeadPort "headport"+                                  , parseField HeadTarget "headtarget"+                                  , parseField HeadTooltip "headtooltip"+                                  , parseField Height "height"+                                  , parseField ID "id"+                                  , parseField Image "image"+                                  , parseField ImagePath "imagepath"+                                  , parseFieldDef ImageScale UniformScale "imagescale"+                                  , parseField InputScale "inputscale"+                                  , parseField Label "label"+                                  , parseFields LabelURL ["labelURL", "labelhref"]+                                  , parseField LabelScheme "label_scheme"+                                  , parseField LabelAngle "labelangle"+                                  , parseField LabelDistance "labeldistance"+                                  , parseFieldBool LabelFloat "labelfloat"+                                  , parseField LabelFontColor "labelfontcolor"+                                  , parseField LabelFontName "labelfontname"+                                  , parseField LabelFontSize "labelfontsize"+                                  , parseField LabelJust "labeljust"+                                  , parseField LabelLoc "labelloc"+                                  , parseField LabelTarget "labeltarget"+                                  , parseField LabelTooltip "labeltooltip"+                                  , parseFieldBool Landscape "landscape"+                                  , parseField Layer "layer"+                                  , parseField LayerListSep "layerlistsep"+                                  , parseField Layers "layers"+                                  , parseField LayerSelect "layerselect"+                                  , parseField LayerSep "layersep"+                                  , parseField Layout "layout"+                                  , parseField Len "len"+                                  , parseField Levels "levels"+                                  , parseField LevelsGap "levelsgap"+                                  , parseField LHead "lhead"+                                  , parseField LHeight "LHeight"+                                  , parseField LPos "lp"+                                  , parseField LTail "ltail"+                                  , parseField LWidth "lwidth"+                                  , parseField Margin "margin"+                                  , parseField MaxIter "maxiter"+                                  , parseField MCLimit "mclimit"+                                  , parseField MinDist "mindist"+                                  , parseField MinLen "minlen"+                                  , parseField Mode "mode"+                                  , parseField Model "model"+                                  , parseFieldBool Mosek "mosek"+                                  , parseField NodeSep "nodesep"+                                  , parseFieldBool NoJustify "nojustify"+                                  , parseFieldDef Normalize IsNormalized "normalize"+                                  , parseFieldBool NoTranslate "notranslate"+                                  , parseField Nslimit "nslimit"+                                  , parseField Nslimit1 "nslimit1"+                                  , parseField Ordering "ordering"+                                  , parseField Orientation "orientation"+                                  , parseField OutputOrder "outputorder"+                                  , parseFieldDef Overlap KeepOverlaps "overlap"+                                  , parseField OverlapScaling "overlap_scaling"+                                  , parseFieldBool OverlapShrink "overlap_shrink"+                                  , parseFieldDef Pack DoPack "pack"+                                  , parseField PackMode "packmode"+                                  , parseField Pad "pad"+                                  , parseField Page "page"+                                  , parseField PageDir "pagedir"+                                  , parseField PenColor "pencolor"+                                  , parseField PenWidth "penwidth"+                                  , parseField Peripheries "peripheries"+                                  , parseFieldBool Pin "pin"+                                  , parseField Pos "pos"+                                  , parseFieldDef QuadTree NormalQT "quadtree"+                                  , parseField Quantum "quantum"+                                  , parseField Rank "rank"+                                  , parseField RankDir "rankdir"+                                  , parseField RankSep "ranksep"+                                  , parseField Ratio "ratio"+                                  , parseField Rects "rects"+                                  , parseFieldBool Regular "regular"+                                  , parseFieldBool ReMinCross "remincross"+                                  , parseField RepulsiveForce "repulsiveforce"+                                  , parseFieldDef Root IsCentral "root"+                                  , parseField Rotate "rotate"+                                  , parseField Rotation "rotation"+                                  , parseField SameHead "samehead"+                                  , parseField SameTail "sametail"+                                  , parseField SamplePoints "samplepoints"+                                  , parseField Scale "scale"+                                  , parseField SearchSize "searchsize"+                                  , parseField Sep "sep"+                                  , parseField Shape "shape"+                                  , parseField ShowBoxes "showboxes"+                                  , parseField Sides "sides"+                                  , parseField Size "size"+                                  , parseField Skew "skew"+                                  , parseField Smoothing "smoothing"+                                  , parseField SortV "sortv"+                                  , parseFieldDef Splines SplineEdges "splines"+                                  , parseField Start "start"+                                  , parseField Style "style"+                                  , parseField StyleSheet "stylesheet"+                                  , parseFields TailURL ["tailURL", "tailhref"]+                                  , parseField Tail_LP "tail_lp"+                                  , parseFieldBool TailClip "tailclip"+                                  , parseField TailLabel "taillabel"+                                  , parseField TailPort "tailport"+                                  , parseField TailTarget "tailtarget"+                                  , parseField TailTooltip "tailtooltip"+                                  , parseField Target "target"+                                  , parseField Tooltip "tooltip"+                                  , parseFieldBool TrueColor "truecolor"+                                  , parseField Vertices "vertices"+                                  , parseField ViewPort "viewport"+                                  , parseField VoroMargin "voro_margin"+                                  , parseField Weight "weight"+                                  , parseField Width "width"+                                  , parseField XDotVersion "xdotversion"+                                  , parseField XLabel "xlabel"+                                  , parseField XLP "xlp"+                                  ])+              `onFail`+              do attrName <- stringBlock+                 liftEqParse ("UnknownAttribute (" ++ T.unpack attrName ++ ")")+                             (UnknownAttribute attrName)++  parse = parseUnqt++  parseList = parseUnqtList++-- | Determine if this 'Attribute' is valid for use with Graphs.+usedByGraphs                      :: Attribute -> Bool+usedByGraphs Damping{}            = True+usedByGraphs K{}                  = True+usedByGraphs URL{}                = True+usedByGraphs Background{}         = True+usedByGraphs BoundingBox{}        = True+usedByGraphs BgColor{}            = True+usedByGraphs Center{}             = True+usedByGraphs ClusterRank{}        = True+usedByGraphs ColorScheme{}        = True+usedByGraphs Comment{}            = True+usedByGraphs Compound{}           = True+usedByGraphs Concentrate{}        = True+usedByGraphs DefaultDist{}        = True+usedByGraphs Dim{}                = True+usedByGraphs Dimen{}              = True+usedByGraphs DirEdgeConstraints{} = True+usedByGraphs DPI{}                = True+usedByGraphs Epsilon{}            = True+usedByGraphs ESep{}               = True+usedByGraphs FontColor{}          = True+usedByGraphs FontName{}           = True+usedByGraphs FontNames{}          = True+usedByGraphs FontPath{}           = True+usedByGraphs FontSize{}           = True+usedByGraphs ForceLabels{}        = True+usedByGraphs GradientAngle{}      = True+usedByGraphs ID{}                 = True+usedByGraphs ImagePath{}          = True+usedByGraphs Label{}              = True+usedByGraphs LabelScheme{}        = True+usedByGraphs LabelJust{}          = True+usedByGraphs LabelLoc{}           = True+usedByGraphs Landscape{}          = True+usedByGraphs LayerListSep{}       = True+usedByGraphs Layers{}             = True+usedByGraphs LayerSelect{}        = True+usedByGraphs LayerSep{}           = True+usedByGraphs Layout{}             = True+usedByGraphs Levels{}             = True+usedByGraphs LevelsGap{}          = True+usedByGraphs LHeight{}            = True+usedByGraphs LPos{}               = True+usedByGraphs LWidth{}             = True+usedByGraphs Margin{}             = True+usedByGraphs MaxIter{}            = True+usedByGraphs MCLimit{}            = True+usedByGraphs MinDist{}            = True+usedByGraphs Mode{}               = True+usedByGraphs Model{}              = True+usedByGraphs Mosek{}              = True+usedByGraphs NodeSep{}            = True+usedByGraphs NoJustify{}          = True+usedByGraphs Normalize{}          = True+usedByGraphs NoTranslate{}        = True+usedByGraphs Nslimit{}            = True+usedByGraphs Nslimit1{}           = True+usedByGraphs Ordering{}           = True+usedByGraphs OutputOrder{}        = True+usedByGraphs Overlap{}            = True+usedByGraphs OverlapScaling{}     = True+usedByGraphs OverlapShrink{}      = True+usedByGraphs Pack{}               = True+usedByGraphs PackMode{}           = True+usedByGraphs Pad{}                = True+usedByGraphs Page{}               = True+usedByGraphs PageDir{}            = True+usedByGraphs QuadTree{}           = True+usedByGraphs Quantum{}            = True+usedByGraphs RankDir{}            = True+usedByGraphs RankSep{}            = True+usedByGraphs Ratio{}              = True+usedByGraphs ReMinCross{}         = True+usedByGraphs RepulsiveForce{}     = True+usedByGraphs Root{}               = True+usedByGraphs Rotate{}             = True+usedByGraphs Rotation{}           = True+usedByGraphs Scale{}              = True+usedByGraphs SearchSize{}         = True+usedByGraphs Sep{}                = True+usedByGraphs ShowBoxes{}          = True+usedByGraphs Size{}               = True+usedByGraphs Smoothing{}          = True+usedByGraphs SortV{}              = True+usedByGraphs Splines{}            = True+usedByGraphs Start{}              = True+usedByGraphs Style{}              = True+usedByGraphs StyleSheet{}         = True+usedByGraphs Target{}             = True+usedByGraphs TrueColor{}          = True+usedByGraphs ViewPort{}           = True+usedByGraphs VoroMargin{}         = True+usedByGraphs XDotVersion{}        = True+usedByGraphs UnknownAttribute{}   = True+usedByGraphs _                    = False++-- | Determine if this 'Attribute' is valid for use with Clusters.+usedByClusters                    :: Attribute -> Bool+usedByClusters K{}                = True+usedByClusters URL{}              = True+usedByClusters Area{}             = True+usedByClusters BgColor{}          = True+usedByClusters Color{}            = True+usedByClusters ColorScheme{}      = True+usedByClusters FillColor{}        = True+usedByClusters FontColor{}        = True+usedByClusters FontName{}         = True+usedByClusters FontSize{}         = True+usedByClusters GradientAngle{}    = True+usedByClusters Label{}            = True+usedByClusters LabelJust{}        = True+usedByClusters LabelLoc{}         = True+usedByClusters Layer{}            = True+usedByClusters LHeight{}          = True+usedByClusters LPos{}             = True+usedByClusters LWidth{}           = True+usedByClusters Margin{}           = True+usedByClusters NoJustify{}        = True+usedByClusters PenColor{}         = True+usedByClusters PenWidth{}         = True+usedByClusters Peripheries{}      = True+usedByClusters Rank{}             = True+usedByClusters SortV{}            = True+usedByClusters Style{}            = True+usedByClusters Target{}           = True+usedByClusters Tooltip{}          = True+usedByClusters UnknownAttribute{} = True+usedByClusters _                  = False++-- | Determine if this 'Attribute' is valid for use with SubGraphs.+usedBySubGraphs                    :: Attribute -> Bool+usedBySubGraphs Rank{}             = True+usedBySubGraphs UnknownAttribute{} = True+usedBySubGraphs _                  = False++-- | Determine if this 'Attribute' is valid for use with Nodes.+usedByNodes                    :: Attribute -> Bool+usedByNodes URL{}              = True+usedByNodes Area{}             = True+usedByNodes Color{}            = True+usedByNodes ColorScheme{}      = True+usedByNodes Comment{}          = True+usedByNodes Distortion{}       = True+usedByNodes FillColor{}        = True+usedByNodes FixedSize{}        = True+usedByNodes FontColor{}        = True+usedByNodes FontName{}         = True+usedByNodes FontSize{}         = True+usedByNodes GradientAngle{}    = True+usedByNodes Group{}            = True+usedByNodes Height{}           = True+usedByNodes ID{}               = True+usedByNodes Image{}            = True+usedByNodes ImageScale{}       = True+usedByNodes InputScale{}       = True+usedByNodes Label{}            = True+usedByNodes LabelLoc{}         = True+usedByNodes Layer{}            = True+usedByNodes Margin{}           = True+usedByNodes NoJustify{}        = True+usedByNodes Ordering{}         = True+usedByNodes Orientation{}      = True+usedByNodes PenWidth{}         = True+usedByNodes Peripheries{}      = True+usedByNodes Pin{}              = True+usedByNodes Pos{}              = True+usedByNodes Rects{}            = True+usedByNodes Regular{}          = True+usedByNodes Root{}             = True+usedByNodes SamplePoints{}     = True+usedByNodes Shape{}            = True+usedByNodes ShowBoxes{}        = True+usedByNodes Sides{}            = True+usedByNodes Skew{}             = True+usedByNodes SortV{}            = True+usedByNodes Style{}            = True+usedByNodes Target{}           = True+usedByNodes Tooltip{}          = True+usedByNodes Vertices{}         = True+usedByNodes Width{}            = True+usedByNodes XLabel{}           = True+usedByNodes XLP{}              = True+usedByNodes UnknownAttribute{} = True+usedByNodes _                  = False++-- | Determine if this 'Attribute' is valid for use with Edges.+usedByEdges                    :: Attribute -> Bool+usedByEdges URL{}              = True+usedByEdges ArrowHead{}        = True+usedByEdges ArrowSize{}        = True+usedByEdges ArrowTail{}        = True+usedByEdges Color{}            = True+usedByEdges ColorScheme{}      = True+usedByEdges Comment{}          = True+usedByEdges Constraint{}       = True+usedByEdges Decorate{}         = True+usedByEdges Dir{}              = True+usedByEdges EdgeURL{}          = True+usedByEdges EdgeTarget{}       = True+usedByEdges EdgeTooltip{}      = True+usedByEdges FillColor{}        = True+usedByEdges FontColor{}        = True+usedByEdges FontName{}         = True+usedByEdges FontSize{}         = True+usedByEdges HeadURL{}          = True+usedByEdges Head_LP{}          = True+usedByEdges HeadClip{}         = True+usedByEdges HeadLabel{}        = True+usedByEdges HeadPort{}         = True+usedByEdges HeadTarget{}       = True+usedByEdges HeadTooltip{}      = True+usedByEdges ID{}               = True+usedByEdges Label{}            = True+usedByEdges LabelURL{}         = True+usedByEdges LabelAngle{}       = True+usedByEdges LabelDistance{}    = True+usedByEdges LabelFloat{}       = True+usedByEdges LabelFontColor{}   = True+usedByEdges LabelFontName{}    = True+usedByEdges LabelFontSize{}    = True+usedByEdges LabelTarget{}      = True+usedByEdges LabelTooltip{}     = True+usedByEdges Layer{}            = True+usedByEdges Len{}              = True+usedByEdges LHead{}            = True+usedByEdges LPos{}             = True+usedByEdges LTail{}            = True+usedByEdges MinLen{}           = True+usedByEdges NoJustify{}        = True+usedByEdges PenWidth{}         = True+usedByEdges Pos{}              = True+usedByEdges SameHead{}         = True+usedByEdges SameTail{}         = True+usedByEdges ShowBoxes{}        = True+usedByEdges Style{}            = True+usedByEdges TailURL{}          = True+usedByEdges Tail_LP{}          = True+usedByEdges TailClip{}         = True+usedByEdges TailLabel{}        = True+usedByEdges TailPort{}         = True+usedByEdges TailTarget{}       = True+usedByEdges TailTooltip{}      = True+usedByEdges Target{}           = True+usedByEdges Tooltip{}          = True+usedByEdges Weight{}           = True+usedByEdges XLabel{}           = True+usedByEdges XLP{}              = True+usedByEdges UnknownAttribute{} = True+usedByEdges _                  = False++-- | Determine if two 'Attributes' are the same type of 'Attribute'.+sameAttribute                                                 :: Attribute -> Attribute -> Bool+sameAttribute Damping{}               Damping{}               = True+sameAttribute K{}                     K{}                     = True+sameAttribute URL{}                   URL{}                   = True+sameAttribute Area{}                  Area{}                  = True+sameAttribute ArrowHead{}             ArrowHead{}             = True+sameAttribute ArrowSize{}             ArrowSize{}             = True+sameAttribute ArrowTail{}             ArrowTail{}             = True+sameAttribute Background{}            Background{}            = True+sameAttribute BoundingBox{}           BoundingBox{}           = True+sameAttribute BgColor{}               BgColor{}               = True+sameAttribute Center{}                Center{}                = True+sameAttribute ClusterRank{}           ClusterRank{}           = True+sameAttribute Color{}                 Color{}                 = True+sameAttribute ColorScheme{}           ColorScheme{}           = True+sameAttribute Comment{}               Comment{}               = True+sameAttribute Compound{}              Compound{}              = True+sameAttribute Concentrate{}           Concentrate{}           = True+sameAttribute Constraint{}            Constraint{}            = True+sameAttribute Decorate{}              Decorate{}              = True+sameAttribute DefaultDist{}           DefaultDist{}           = True+sameAttribute Dim{}                   Dim{}                   = True+sameAttribute Dimen{}                 Dimen{}                 = True+sameAttribute Dir{}                   Dir{}                   = True+sameAttribute DirEdgeConstraints{}    DirEdgeConstraints{}    = True+sameAttribute Distortion{}            Distortion{}            = True+sameAttribute DPI{}                   DPI{}                   = True+sameAttribute EdgeURL{}               EdgeURL{}               = True+sameAttribute EdgeTarget{}            EdgeTarget{}            = True+sameAttribute EdgeTooltip{}           EdgeTooltip{}           = True+sameAttribute Epsilon{}               Epsilon{}               = True+sameAttribute ESep{}                  ESep{}                  = True+sameAttribute FillColor{}             FillColor{}             = True+sameAttribute FixedSize{}             FixedSize{}             = True+sameAttribute FontColor{}             FontColor{}             = True+sameAttribute FontName{}              FontName{}              = True+sameAttribute FontNames{}             FontNames{}             = True+sameAttribute FontPath{}              FontPath{}              = True+sameAttribute FontSize{}              FontSize{}              = True+sameAttribute ForceLabels{}           ForceLabels{}           = True+sameAttribute GradientAngle{}         GradientAngle{}         = True+sameAttribute Group{}                 Group{}                 = True+sameAttribute HeadURL{}               HeadURL{}               = True+sameAttribute Head_LP{}               Head_LP{}               = True+sameAttribute HeadClip{}              HeadClip{}              = True+sameAttribute HeadLabel{}             HeadLabel{}             = True+sameAttribute HeadPort{}              HeadPort{}              = True+sameAttribute HeadTarget{}            HeadTarget{}            = True+sameAttribute HeadTooltip{}           HeadTooltip{}           = True+sameAttribute Height{}                Height{}                = True+sameAttribute ID{}                    ID{}                    = True+sameAttribute Image{}                 Image{}                 = True+sameAttribute ImagePath{}             ImagePath{}             = True+sameAttribute ImageScale{}            ImageScale{}            = True+sameAttribute InputScale{}            InputScale{}            = True+sameAttribute Label{}                 Label{}                 = True+sameAttribute LabelURL{}              LabelURL{}              = True+sameAttribute LabelScheme{}           LabelScheme{}           = True+sameAttribute LabelAngle{}            LabelAngle{}            = True+sameAttribute LabelDistance{}         LabelDistance{}         = True+sameAttribute LabelFloat{}            LabelFloat{}            = True+sameAttribute LabelFontColor{}        LabelFontColor{}        = True+sameAttribute LabelFontName{}         LabelFontName{}         = True+sameAttribute LabelFontSize{}         LabelFontSize{}         = True+sameAttribute LabelJust{}             LabelJust{}             = True+sameAttribute LabelLoc{}              LabelLoc{}              = True+sameAttribute LabelTarget{}           LabelTarget{}           = True+sameAttribute LabelTooltip{}          LabelTooltip{}          = True+sameAttribute Landscape{}             Landscape{}             = True+sameAttribute Layer{}                 Layer{}                 = True+sameAttribute LayerListSep{}          LayerListSep{}          = True+sameAttribute Layers{}                Layers{}                = True+sameAttribute LayerSelect{}           LayerSelect{}           = True+sameAttribute LayerSep{}              LayerSep{}              = True+sameAttribute Layout{}                Layout{}                = True+sameAttribute Len{}                   Len{}                   = True+sameAttribute Levels{}                Levels{}                = True+sameAttribute LevelsGap{}             LevelsGap{}             = True+sameAttribute LHead{}                 LHead{}                 = True+sameAttribute LHeight{}               LHeight{}               = True+sameAttribute LPos{}                  LPos{}                  = True+sameAttribute LTail{}                 LTail{}                 = True+sameAttribute LWidth{}                LWidth{}                = True+sameAttribute Margin{}                Margin{}                = True+sameAttribute MaxIter{}               MaxIter{}               = True+sameAttribute MCLimit{}               MCLimit{}               = True+sameAttribute MinDist{}               MinDist{}               = True+sameAttribute MinLen{}                MinLen{}                = True+sameAttribute Mode{}                  Mode{}                  = True+sameAttribute Model{}                 Model{}                 = True+sameAttribute Mosek{}                 Mosek{}                 = True+sameAttribute NodeSep{}               NodeSep{}               = True+sameAttribute NoJustify{}             NoJustify{}             = True+sameAttribute Normalize{}             Normalize{}             = True+sameAttribute NoTranslate{}           NoTranslate{}           = True+sameAttribute Nslimit{}               Nslimit{}               = True+sameAttribute Nslimit1{}              Nslimit1{}              = True+sameAttribute Ordering{}              Ordering{}              = True+sameAttribute Orientation{}           Orientation{}           = True+sameAttribute OutputOrder{}           OutputOrder{}           = True+sameAttribute Overlap{}               Overlap{}               = True+sameAttribute OverlapScaling{}        OverlapScaling{}        = True+sameAttribute OverlapShrink{}         OverlapShrink{}         = True+sameAttribute Pack{}                  Pack{}                  = True+sameAttribute PackMode{}              PackMode{}              = True+sameAttribute Pad{}                   Pad{}                   = True+sameAttribute Page{}                  Page{}                  = True+sameAttribute PageDir{}               PageDir{}               = True+sameAttribute PenColor{}              PenColor{}              = True+sameAttribute PenWidth{}              PenWidth{}              = True+sameAttribute Peripheries{}           Peripheries{}           = True+sameAttribute Pin{}                   Pin{}                   = True+sameAttribute Pos{}                   Pos{}                   = True+sameAttribute QuadTree{}              QuadTree{}              = True+sameAttribute Quantum{}               Quantum{}               = True+sameAttribute Rank{}                  Rank{}                  = True+sameAttribute RankDir{}               RankDir{}               = True+sameAttribute RankSep{}               RankSep{}               = True+sameAttribute Ratio{}                 Ratio{}                 = True+sameAttribute Rects{}                 Rects{}                 = True+sameAttribute Regular{}               Regular{}               = True+sameAttribute ReMinCross{}            ReMinCross{}            = True+sameAttribute RepulsiveForce{}        RepulsiveForce{}        = True+sameAttribute Root{}                  Root{}                  = True+sameAttribute Rotate{}                Rotate{}                = True+sameAttribute Rotation{}              Rotation{}              = True+sameAttribute SameHead{}              SameHead{}              = True+sameAttribute SameTail{}              SameTail{}              = True+sameAttribute SamplePoints{}          SamplePoints{}          = True+sameAttribute Scale{}                 Scale{}                 = True+sameAttribute SearchSize{}            SearchSize{}            = True+sameAttribute Sep{}                   Sep{}                   = True+sameAttribute Shape{}                 Shape{}                 = True+sameAttribute ShowBoxes{}             ShowBoxes{}             = True+sameAttribute Sides{}                 Sides{}                 = True+sameAttribute Size{}                  Size{}                  = True+sameAttribute Skew{}                  Skew{}                  = True+sameAttribute Smoothing{}             Smoothing{}             = True+sameAttribute SortV{}                 SortV{}                 = True+sameAttribute Splines{}               Splines{}               = True+sameAttribute Start{}                 Start{}                 = True+sameAttribute Style{}                 Style{}                 = True+sameAttribute StyleSheet{}            StyleSheet{}            = True+sameAttribute TailURL{}               TailURL{}               = True+sameAttribute Tail_LP{}               Tail_LP{}               = True+sameAttribute TailClip{}              TailClip{}              = True+sameAttribute TailLabel{}             TailLabel{}             = True+sameAttribute TailPort{}              TailPort{}              = True+sameAttribute TailTarget{}            TailTarget{}            = True+sameAttribute TailTooltip{}           TailTooltip{}           = True+sameAttribute Target{}                Target{}                = True+sameAttribute Tooltip{}               Tooltip{}               = True+sameAttribute TrueColor{}             TrueColor{}             = True+sameAttribute Vertices{}              Vertices{}              = True+sameAttribute ViewPort{}              ViewPort{}              = True+sameAttribute VoroMargin{}            VoroMargin{}            = True+sameAttribute Weight{}                Weight{}                = True+sameAttribute Width{}                 Width{}                 = True+sameAttribute XDotVersion{}           XDotVersion{}           = True+sameAttribute XLabel{}                XLabel{}                = True+sameAttribute XLP{}                   XLP{}                   = True+sameAttribute (UnknownAttribute a1 _) (UnknownAttribute a2 _) = a1 == a2+sameAttribute _                       _                       = False++-- | Return the default value for a specific 'Attribute' if possible; graph/cluster values are preferred over node/edge values.+defaultAttributeValue                      :: Attribute -> Maybe Attribute+defaultAttributeValue Damping{}            = Just $ Damping 0.99+defaultAttributeValue K{}                  = Just $ K 0.3+defaultAttributeValue URL{}                = Just $ URL ""+defaultAttributeValue Area{}               = Just $ Area 1.0+defaultAttributeValue ArrowHead{}          = Just $ ArrowHead normal+defaultAttributeValue ArrowSize{}          = Just $ ArrowSize 1.0+defaultAttributeValue ArrowTail{}          = Just $ ArrowTail normal+defaultAttributeValue Background{}         = Just $ Background ""+defaultAttributeValue BgColor{}            = Just $ BgColor []+defaultAttributeValue Center{}             = Just $ Center False+defaultAttributeValue ClusterRank{}        = Just $ ClusterRank Local+defaultAttributeValue Color{}              = Just $ Color [toWColor Black]+defaultAttributeValue ColorScheme{}        = Just $ ColorScheme X11+defaultAttributeValue Comment{}            = Just $ Comment ""+defaultAttributeValue Compound{}           = Just $ Compound False+defaultAttributeValue Concentrate{}        = Just $ Concentrate False+defaultAttributeValue Constraint{}         = Just $ Constraint True+defaultAttributeValue Decorate{}           = Just $ Decorate False+defaultAttributeValue Dim{}                = Just $ Dim 2+defaultAttributeValue Dimen{}              = Just $ Dimen 2+defaultAttributeValue DirEdgeConstraints{} = Just $ DirEdgeConstraints NoConstraints+defaultAttributeValue Distortion{}         = Just $ Distortion 0.0+defaultAttributeValue DPI{}                = Just $ DPI 96.0+defaultAttributeValue EdgeURL{}            = Just $ EdgeURL ""+defaultAttributeValue EdgeTooltip{}        = Just $ EdgeTooltip ""+defaultAttributeValue ESep{}               = Just $ ESep (DVal 3)+defaultAttributeValue FillColor{}          = Just $ FillColor [toWColor Black]+defaultAttributeValue FixedSize{}          = Just $ FixedSize GrowAsNeeded+defaultAttributeValue FontColor{}          = Just $ FontColor (X11Color Black)+defaultAttributeValue FontName{}           = Just $ FontName "Times-Roman"+defaultAttributeValue FontNames{}          = Just $ FontNames SvgNames+defaultAttributeValue FontSize{}           = Just $ FontSize 14.0+defaultAttributeValue ForceLabels{}        = Just $ ForceLabels True+defaultAttributeValue GradientAngle{}      = Just $ GradientAngle 0+defaultAttributeValue Group{}              = Just $ Group ""+defaultAttributeValue HeadURL{}            = Just $ HeadURL ""+defaultAttributeValue HeadClip{}           = Just $ HeadClip True+defaultAttributeValue HeadLabel{}          = Just $ HeadLabel (StrLabel "")+defaultAttributeValue HeadPort{}           = Just $ HeadPort (CompassPoint CenterPoint)+defaultAttributeValue HeadTarget{}         = Just $ HeadTarget ""+defaultAttributeValue HeadTooltip{}        = Just $ HeadTooltip ""+defaultAttributeValue Height{}             = Just $ Height 0.5+defaultAttributeValue ID{}                 = Just $ ID ""+defaultAttributeValue Image{}              = Just $ Image ""+defaultAttributeValue ImagePath{}          = Just $ ImagePath (Paths [])+defaultAttributeValue ImageScale{}         = Just $ ImageScale NoScale+defaultAttributeValue Label{}              = Just $ Label (StrLabel "")+defaultAttributeValue LabelURL{}           = Just $ LabelURL ""+defaultAttributeValue LabelScheme{}        = Just $ LabelScheme NotEdgeLabel+defaultAttributeValue LabelAngle{}         = Just $ LabelAngle (-25.0)+defaultAttributeValue LabelDistance{}      = Just $ LabelDistance 1.0+defaultAttributeValue LabelFloat{}         = Just $ LabelFloat False+defaultAttributeValue LabelFontColor{}     = Just $ LabelFontColor (X11Color Black)+defaultAttributeValue LabelFontName{}      = Just $ LabelFontName "Times-Roman"+defaultAttributeValue LabelFontSize{}      = Just $ LabelFontSize 14.0+defaultAttributeValue LabelJust{}          = Just $ LabelJust JCenter+defaultAttributeValue LabelLoc{}           = Just $ LabelLoc VTop+defaultAttributeValue LabelTarget{}        = Just $ LabelTarget ""+defaultAttributeValue LabelTooltip{}       = Just $ LabelTooltip ""+defaultAttributeValue Landscape{}          = Just $ Landscape False+defaultAttributeValue Layer{}              = Just $ Layer []+defaultAttributeValue LayerListSep{}       = Just $ LayerListSep (LLSep ",")+defaultAttributeValue Layers{}             = Just $ Layers (LL [])+defaultAttributeValue LayerSelect{}        = Just $ LayerSelect []+defaultAttributeValue LayerSep{}           = Just $ LayerSep (LSep " :\t")+defaultAttributeValue Levels{}             = Just $ Levels maxBound+defaultAttributeValue LevelsGap{}          = Just $ LevelsGap 0.0+defaultAttributeValue LHead{}              = Just $ LHead ""+defaultAttributeValue LTail{}              = Just $ LTail ""+defaultAttributeValue MCLimit{}            = Just $ MCLimit 1.0+defaultAttributeValue MinDist{}            = Just $ MinDist 1.0+defaultAttributeValue MinLen{}             = Just $ MinLen 1+defaultAttributeValue Mode{}               = Just $ Mode Major+defaultAttributeValue Model{}              = Just $ Model ShortPath+defaultAttributeValue Mosek{}              = Just $ Mosek False+defaultAttributeValue NodeSep{}            = Just $ NodeSep 0.25+defaultAttributeValue NoJustify{}          = Just $ NoJustify False+defaultAttributeValue Normalize{}          = Just $ Normalize NotNormalized+defaultAttributeValue NoTranslate{}        = Just $ NoTranslate False+defaultAttributeValue Orientation{}        = Just $ Orientation 0.0+defaultAttributeValue OutputOrder{}        = Just $ OutputOrder BreadthFirst+defaultAttributeValue Overlap{}            = Just $ Overlap KeepOverlaps+defaultAttributeValue OverlapScaling{}     = Just $ OverlapScaling (-4)+defaultAttributeValue OverlapShrink{}      = Just $ OverlapShrink True+defaultAttributeValue Pack{}               = Just $ Pack DontPack+defaultAttributeValue PackMode{}           = Just $ PackMode PackNode+defaultAttributeValue Pad{}                = Just $ Pad (DVal 0.0555)+defaultAttributeValue PageDir{}            = Just $ PageDir Bl+defaultAttributeValue PenColor{}           = Just $ PenColor (X11Color Black)+defaultAttributeValue PenWidth{}           = Just $ PenWidth 1.0+defaultAttributeValue Peripheries{}        = Just $ Peripheries 1+defaultAttributeValue Pin{}                = Just $ Pin False+defaultAttributeValue QuadTree{}           = Just $ QuadTree NormalQT+defaultAttributeValue Quantum{}            = Just $ Quantum 0+defaultAttributeValue RankDir{}            = Just $ RankDir FromTop+defaultAttributeValue Regular{}            = Just $ Regular False+defaultAttributeValue ReMinCross{}         = Just $ ReMinCross False+defaultAttributeValue RepulsiveForce{}     = Just $ RepulsiveForce 1.0+defaultAttributeValue Root{}               = Just $ Root (NodeName "")+defaultAttributeValue Rotate{}             = Just $ Rotate 0+defaultAttributeValue Rotation{}           = Just $ Rotation 0+defaultAttributeValue SameHead{}           = Just $ SameHead ""+defaultAttributeValue SameTail{}           = Just $ SameTail ""+defaultAttributeValue SearchSize{}         = Just $ SearchSize 30+defaultAttributeValue Sep{}                = Just $ Sep (DVal 4)+defaultAttributeValue Shape{}              = Just $ Shape Ellipse+defaultAttributeValue ShowBoxes{}          = Just $ ShowBoxes 0+defaultAttributeValue Sides{}              = Just $ Sides 4+defaultAttributeValue Skew{}               = Just $ Skew 0.0+defaultAttributeValue Smoothing{}          = Just $ Smoothing NoSmooth+defaultAttributeValue SortV{}              = Just $ SortV 0+defaultAttributeValue StyleSheet{}         = Just $ StyleSheet ""+defaultAttributeValue TailURL{}            = Just $ TailURL ""+defaultAttributeValue TailClip{}           = Just $ TailClip True+defaultAttributeValue TailLabel{}          = Just $ TailLabel (StrLabel "")+defaultAttributeValue TailPort{}           = Just $ TailPort (CompassPoint CenterPoint)+defaultAttributeValue TailTarget{}         = Just $ TailTarget ""+defaultAttributeValue TailTooltip{}        = Just $ TailTooltip ""+defaultAttributeValue Target{}             = Just $ Target ""+defaultAttributeValue Tooltip{}            = Just $ Tooltip ""+defaultAttributeValue VoroMargin{}         = Just $ VoroMargin 0.05+defaultAttributeValue Weight{}             = Just $ Weight (Int 1)+defaultAttributeValue Width{}              = Just $ Width 0.75+defaultAttributeValue XLabel{}             = Just $ XLabel (StrLabel "")+defaultAttributeValue _                    = Nothing++-- | Determine if the provided 'Text' value is a valid name for an 'UnknownAttribute'.+validUnknown     :: AttributeName -> Bool+validUnknown txt = T.toLower txt `S.notMember` names+                   && isIDString txt+  where+    names = (S.fromList . map T.toLower+             $ [ "Damping"+               , "K"+               , "URL"+               , "href"+               , "area"+               , "arrowhead"+               , "arrowsize"+               , "arrowtail"+               , "_background"+               , "bb"+               , "bgcolor"+               , "center"+               , "clusterrank"+               , "color"+               , "colorscheme"+               , "comment"+               , "compound"+               , "concentrate"+               , "constraint"+               , "decorate"+               , "defaultdist"+               , "dim"+               , "dimen"+               , "dir"+               , "diredgeconstraints"+               , "distortion"+               , "dpi"+               , "resolution"+               , "edgeURL"+               , "edgehref"+               , "edgetarget"+               , "edgetooltip"+               , "epsilon"+               , "esep"+               , "fillcolor"+               , "fixedsize"+               , "fontcolor"+               , "fontname"+               , "fontnames"+               , "fontpath"+               , "fontsize"+               , "forcelabels"+               , "gradientangle"+               , "group"+               , "headURL"+               , "headhref"+               , "head_lp"+               , "headclip"+               , "headlabel"+               , "headport"+               , "headtarget"+               , "headtooltip"+               , "height"+               , "id"+               , "image"+               , "imagepath"+               , "imagescale"+               , "inputscale"+               , "label"+               , "labelURL"+               , "labelhref"+               , "label_scheme"+               , "labelangle"+               , "labeldistance"+               , "labelfloat"+               , "labelfontcolor"+               , "labelfontname"+               , "labelfontsize"+               , "labeljust"+               , "labelloc"+               , "labeltarget"+               , "labeltooltip"+               , "landscape"+               , "layer"+               , "layerlistsep"+               , "layers"+               , "layerselect"+               , "layersep"+               , "layout"+               , "len"+               , "levels"+               , "levelsgap"+               , "lhead"+               , "LHeight"+               , "lp"+               , "ltail"+               , "lwidth"+               , "margin"+               , "maxiter"+               , "mclimit"+               , "mindist"+               , "minlen"+               , "mode"+               , "model"+               , "mosek"+               , "nodesep"+               , "nojustify"+               , "normalize"+               , "notranslate"+               , "nslimit"+               , "nslimit1"+               , "ordering"+               , "orientation"+               , "outputorder"+               , "overlap"+               , "overlap_scaling"+               , "overlap_shrink"+               , "pack"+               , "packmode"+               , "pad"+               , "page"+               , "pagedir"+               , "pencolor"+               , "penwidth"+               , "peripheries"+               , "pin"+               , "pos"+               , "quadtree"+               , "quantum"+               , "rank"+               , "rankdir"+               , "ranksep"+               , "ratio"+               , "rects"+               , "regular"+               , "remincross"+               , "repulsiveforce"+               , "root"+               , "rotate"+               , "rotation"+               , "samehead"+               , "sametail"+               , "samplepoints"+               , "scale"+               , "searchsize"+               , "sep"+               , "shape"+               , "showboxes"+               , "sides"+               , "size"+               , "skew"+               , "smoothing"+               , "sortv"+               , "splines"+               , "start"+               , "style"+               , "stylesheet"+               , "tailURL"+               , "tailhref"+               , "tail_lp"+               , "tailclip"+               , "taillabel"+               , "tailport"+               , "tailtarget"+               , "tailtooltip"+               , "target"+               , "tooltip"+               , "truecolor"+               , "vertices"+               , "viewport"+               , "voro_margin"+               , "weight"+               , "width"+               , "xdotversion"+               , "xlabel"+               , "xlp"+               , "charset" -- Defined upstream, just not used here.+               ])+            `S.union`+            keywords+{- Delete to here -}++-- | Remove attributes that we don't want to consider:+--+--   * Those that are defaults+--   * colorscheme (as the colors embed it anyway)+rmUnwantedAttributes :: Attributes -> Attributes+rmUnwantedAttributes = filter (not . (`any` tests) . flip ($))+  where+    tests = [isDefault, isColorScheme]++    isDefault a = maybe False (a==) $ defaultAttributeValue a++    isColorScheme ColorScheme{} = True+    isColorScheme _             = False++-- -----------------------------------------------------------------------------+-- These parsing combinators are defined here for customisation purposes.++parseField       :: (ParseDot a) => (a -> Attribute) -> String+                    -> [(String, Parse Attribute)]+parseField c fld = [(fld, liftEqParse fld c)]++parseFields   :: (ParseDot a) => (a -> Attribute) -> [String]+                 -> [(String, Parse Attribute)]+parseFields c = concatMap (parseField c)++parseFieldBool :: (Bool -> Attribute) -> String -> [(String, Parse Attribute)]+parseFieldBool = (`parseFieldDef` True)++-- | For 'Bool'-like data structures where the presence of the field+--   name without a value implies a default value.+parseFieldDef         :: (ParseDot a) => (a -> Attribute) -> a -> String+                         -> [(String, Parse Attribute)]+parseFieldDef c d fld = [(fld, p)]+  where+    p = liftEqParse fld c+        `onFail`+        do nxt <- optional $ satisfy restIDString+           bool (fail "Not actually the field you were after")+                (return $ c d)+                (isNothing nxt)++-- | Attempt to parse the @\"=value\"@ part of a @key=value@ pair.  If+--   there is an equal sign but the @value@ part doesn't parse, throw+--   an un-recoverable error.+liftEqParse :: (ParseDot a) => String -> (a -> Attribute) -> Parse Attribute+liftEqParse k c = do pStrict <- getsGS parseStrictly+                     let adjErr = bool adjustErr adjustErrBad pStrict+                     parseEq+                       *> ( hasDef (fmap c parse)+                            `adjErr`+                            (("Unable to parse key=value with key of " ++ k+                              ++ "\n\t") ++)+                          )+  where+    hasDef p = maybe p (onFail p . (`stringRep` "\"\""))+               . defaultAttributeValue $ c undefined++-- -----------------------------------------------------------------------------++{- | If performing any custom pre-/post-processing on Dot code, you+     may wish to utilise some custom 'Attributes'.  These are wrappers+     around the 'UnknownAttribute' constructor (and thus 'CustomAttribute'+     is just an alias for 'Attribute').++     You should ensure that 'validUnknown' is 'True' for any potential+     custom attribute name.++-}+type CustomAttribute = Attribute++-- | Create a custom attribute.+customAttribute :: AttributeName -> Text -> CustomAttribute+customAttribute = UnknownAttribute++-- | Determines whether or not this is a custom attribute.+isCustom                    :: Attribute -> Bool+isCustom UnknownAttribute{} = True+isCustom _                  = False++isSpecifiedCustom :: AttributeName -> Attribute -> Bool+isSpecifiedCustom nm (UnknownAttribute nm' _) = nm == nm'+isSpecifiedCustom _  _                        = False++-- | The value of a custom attribute.  Will throw a+--   'GraphvizException' if the provided 'Attribute' isn't a custom+--   one.+customValue :: CustomAttribute -> Text+customValue (UnknownAttribute _ v) = v+customValue attr                   = throw . NotCustomAttr . T.unpack+                                     $ printIt attr++-- | The name of a custom attribute.  Will throw a+--   'GraphvizException' if the provided 'Attribute' isn't a custom+--   one.+customName :: CustomAttribute -> AttributeName+customName (UnknownAttribute nm _) = nm+customName attr                    = throw . NotCustomAttr . T.unpack+                                      $ printIt attr++-- | Returns all custom attributes and the list of non-custom Attributes.+findCustoms :: Attributes -> ([CustomAttribute], Attributes)+findCustoms = partition isCustom++-- | Find the (first instance of the) specified custom attribute and+--   returns it along with all other Attributes.+findSpecifiedCustom :: AttributeName -> Attributes+                       -> Maybe (CustomAttribute, Attributes)+findSpecifiedCustom nm attrs+  = case break (isSpecifiedCustom nm) attrs of+      (bf,cust:aft) -> Just (cust, bf ++ aft)+      _             -> Nothing++-- | Delete all custom attributes (actually, this will delete all+--   'UnknownAttribute' values; as such it can also be used to remove+--   legacy attributes).+deleteCustomAttributes :: Attributes -> Attributes+deleteCustomAttributes = filter (not . isCustom)++-- | Removes all instances of the specified custom attribute.+deleteSpecifiedCustom :: AttributeName -> Attributes -> Attributes+deleteSpecifiedCustom nm = filter (not . isSpecifiedCustom nm)
Data/GraphViz/Attributes/HTML.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, PatternGuards #-}+{-# LANGUAGE CPP, OverloadedStrings, PatternGuards #-}  {- |    Module      : Data.GraphViz.Attributes.HTML@@ -64,25 +64,31 @@        , Attribute(..)        , Align(..)        , VAlign(..)+       , CellFormat(..)        , Scale(..)+       , Side(..)+       , Style(..)        ) where -import Data.GraphViz.Parsing-import Data.GraphViz.Printing import Data.GraphViz.Attributes.Colors import Data.GraphViz.Attributes.Internal-import Data.GraphViz.Util(bool)+import Data.GraphViz.Internal.Util       (bool)+import Data.GraphViz.Parsing+import Data.GraphViz.Printing -import Numeric(readHex)-import Data.Char(chr, ord, isSpace)-import Data.Function(on)-import Data.List(delete)-import Data.Maybe(catMaybes, listToMaybe)-import Data.Word(Word8, Word16)-import qualified Data.Map as Map+import           Data.Char      (chr, isSpace, ord)+import           Data.Function  (on)+import           Data.List      (delete)+import qualified Data.Map       as Map+import           Data.Maybe     (catMaybes, listToMaybe) import qualified Data.Text.Lazy as T-import Control.Monad(liftM, liftM2)+import           Data.Word      (Word16, Word8)+import           Numeric        (readHex) +#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif+ -- -----------------------------------------------------------------------------  -- | The overall type for HTML-like labels.  Fundamentally, HTML-like@@ -99,9 +105,9 @@  instance ParseDot Label where   -- Try parsing Table first in case of a FONT tag being used.-  parseUnqt = liftM Table parseUnqt+  parseUnqt = fmap Table parseUnqt               `onFail`-              liftM Text parseUnqt+              fmap Text parseUnqt               `adjustErr`               ("Can't parse Html.Label\n\t"++) @@ -140,7 +146,7 @@   listToDot = unqtListToDot  instance ParseDot TextItem where-  parseUnqt = oneOf [ liftM Str unescapeValue+  parseUnqt = oneOf [ fmap Str unescapeValue                     , parseEmptyTag Newline "BR"                     , parseFontTag Font parseUnqt                     , parseTagRep Format parseUnqt parseUnqt@@ -150,21 +156,23 @@    parse = parseUnqt -  parseUnqtList = many1 parseUnqt -- sepBy1 parseUnqt whitespace+  parseUnqtList = many parseUnqt    parseList = parseUnqtList  data Format = Italics-                | Bold-                | Underline-                | Subscript-                | Superscript-                deriving (Eq, Ord, Bounded, Enum, Show, Read)+              | Bold+              | Underline+              | Overline -- ^ Requires Graphviz >= 2.38.0.+              | Subscript+              | Superscript+              deriving (Eq, Ord, Bounded, Enum, Show, Read)  instance PrintDot Format where   unqtDot Italics     = text "I"   unqtDot Bold        = text "B"   unqtDot Underline   = text "U"+  unqtDot Overline    = text "O"   unqtDot Subscript   = text "SUB"   unqtDot Superscript = text "SUP" @@ -172,6 +180,7 @@   parseUnqt = stringValue [ ("I", Italics)                           , ("B", Bold)                           , ("U", Underline)+                          , ("O", Overline)                           , ("SUB", Subscript)                           , ("SUP", Superscript)                           ]@@ -264,13 +273,13 @@  instance ParseDot Cell where   parseUnqt = oneOf [ parseCell LabelCell parse-                    , parseCell ImgCell $ wrapWhitespace parseUnqt+                    , parseCell ImgCell $ wrapWhitespace parse                     , parseEmptyTag (const VerticalRule) "VR"                     ]               `adjustErr`               ("Can't parse Html.Cell\n\t"++)     where-      parseCell = flip parseTag "TD"+      parseCell = (`parseTag` "TD")    parse = parseUnqt @@ -299,55 +308,65 @@  -- | Note that not all 'Attribute' values are valid everywhere: --   see the comments for each one on where it is valid.-data Attribute = Align Align       -- ^ Valid for:  'Table', 'Cell', 'Newline'.-               | BAlign Align      -- ^ Valid for: 'Cell'.-               | BGColor Color     -- ^ Valid for: 'Table' (including 'tableFontAttrs'), 'Cell', 'Font'.-               | Border Word8      -- ^ Valid for: 'Table', 'Cell'.  Default is @1@; @0@ represents no border.-               | CellBorder Word8  -- ^ Valid for: 'Table'.  Default is @1@; @0@ represents no border.-               | CellPadding Word8 -- ^ Valid for: 'Table', 'Cell'.  Default is @2@.-               | CellSpacing Word8 -- ^ Valid for: 'Table', 'Cell'.  Default is @2@; maximum is @127@.-               | Color Color       -- ^ Valid for: 'Table', 'Cell'.-               | ColSpan Word16    -- ^ Valid for: 'Cell'.  Default is @1@.-               | Face T.Text       -- ^ Valid for: 'tableFontAttrs', 'Font'.-               | FixedSize Bool    -- ^ Valid for: 'Table', 'Cell'.  Default is @'False'@.-               | Height Word16     -- ^ Valid for: 'Table', 'Cell'.-               | HRef T.Text       -- ^ Valid for: 'Table', 'Cell'.-               | ID T.Text         -- ^ Valid for: 'Table', 'Cell'.  Requires Graphviz >= 2.29.0-               | PointSize Double  -- ^ Valid for: 'tableFontAttrs', 'Font'.-               | Port PortName     -- ^ Valid for: 'Table', 'Cell'.-               | RowSpan Word16    -- ^ Valid for: 'Cell'.-               | Scale Scale       -- ^ Valid for: 'Img'.-               | Src FilePath      -- ^ Valid for: 'Img'.-               | Target T.Text     -- ^ Valid for: 'Table', 'Cell'.-               | Title T.Text      -- ^ Valid for: 'Table', 'Cell'.  Has an alias of @TOOLTIP@.-               | VAlign VAlign     -- ^ Valid for: 'Table', 'Cell'.-               | Width Word16      -- ^ Valid for: 'Table', 'Cell'.+data Attribute = Align Align        -- ^ Valid for: 'Table', 'Cell', 'Newline'.+               | BAlign Align       -- ^ Valid for: 'Cell'.+               | BGColor Color      -- ^ Valid for: 'Table' (including 'tableFontAttrs'), 'Cell', 'Font'.+               | Border Word8       -- ^ Valid for: 'Table', 'Cell'.  Default is @1@; @0@ represents no border.+               | CellBorder Word8   -- ^ Valid for: 'Table'.  Default is @1@; @0@ represents no border.+               | CellPadding Word8  -- ^ Valid for: 'Table', 'Cell'.  Default is @2@.+               | CellSpacing Word8  -- ^ Valid for: 'Table', 'Cell'.  Default is @2@; maximum is @127@.+               | Color Color        -- ^ Valid for: 'Table', 'Cell'.+               | ColSpan Word16     -- ^ Valid for: 'Cell'.  Default is @1@.+               | Columns CellFormat -- ^ Valid for: 'Table'.  Requires Graphviz >= 2.40.1+               | Face T.Text        -- ^ Valid for: 'tableFontAttrs', 'Font'.+               | FixedSize Bool     -- ^ Valid for: 'Table', 'Cell'.  Default is @'False'@.+               | GradientAngle Int  -- ^ Valid for: 'Table', 'Cell'.  Default is @0@.  Requires Graphviz >= 2.40.1+               | Height Word16      -- ^ Valid for: 'Table', 'Cell'.+               | HRef T.Text        -- ^ Valid for: 'Table', 'Cell'.+               | ID T.Text          -- ^ Valid for: 'Table', 'Cell'.  Requires Graphviz >= 2.29.0+               | PointSize Double   -- ^ Valid for: 'tableFontAttrs', 'Font'.+               | Port PortName      -- ^ Valid for: 'Table', 'Cell'.+               | Rows CellFormat    -- ^ Valid for: 'Table'.  Requires Graphviz >= 2.40.1+               | RowSpan Word16     -- ^ Valid for: 'Cell'.+               | Scale Scale        -- ^ Valid for: 'Img'.+               | Sides [Side]       -- ^ Valid for: 'Table', 'Cell'.  Default is @['LeftSide', 'TopSide', 'RightSide', 'BottomSide']@.  Requires Graphviz >= 2.40.1+               | Src FilePath       -- ^ Valid for: 'Img'.+               | Style Style        -- ^ Valid for: 'Table', 'Cell'.  Requires Graphviz >= 2.40.1+               | Target T.Text      -- ^ Valid for: 'Table', 'Cell'.+               | Title T.Text       -- ^ Valid for: 'Table', 'Cell'.  Has an alias of @TOOLTIP@.+               | VAlign VAlign      -- ^ Valid for: 'Table', 'Cell'.+               | Width Word16       -- ^ Valid for: 'Table', 'Cell'.                deriving (Eq, Ord, Show, Read)  instance PrintDot Attribute where-  unqtDot (Align v)       = printHtmlField  "ALIGN" v-  unqtDot (BAlign v)      = printHtmlField  "BALIGN" v-  unqtDot (BGColor v)     = printHtmlField  "BGCOLOR" v-  unqtDot (Border v)      = printHtmlField  "BORDER" v-  unqtDot (CellBorder v)  = printHtmlField  "CELLBORDER" v-  unqtDot (CellPadding v) = printHtmlField  "CELLPADDING" v-  unqtDot (CellSpacing v) = printHtmlField  "CELLSPACING" v-  unqtDot (Color v)       = printHtmlField  "COLOR" v-  unqtDot (ColSpan v)     = printHtmlField  "COLSPAN" v-  unqtDot (Face v)        = printHtmlField' "FACE" $ escapeAttribute v-  unqtDot (FixedSize v)   = printHtmlField' "FIXEDSIZE" $ printBoolHtml v-  unqtDot (Height v)      = printHtmlField  "HEIGHT" v-  unqtDot (HRef v)        = printHtmlField' "HREF" $ escapeAttribute v-  unqtDot (ID v)          = printHtmlField' "ID" $ escapeAttribute v-  unqtDot (PointSize v)   = printHtmlField  "POINT-SIZE" v-  unqtDot (Port v)        = printHtmlField' "PORT" . escapeAttribute $ portName v-  unqtDot (RowSpan v)     = printHtmlField  "ROWSPAN" v-  unqtDot (Scale v)       = printHtmlField  "SCALE" v-  unqtDot (Src v)         = printHtmlField' "SRC" . escapeAttribute $ T.pack v-  unqtDot (Target v)      = printHtmlField' "TARGET" $ escapeAttribute v-  unqtDot (Title v)       = printHtmlField' "TITLE" $ escapeAttribute v-  unqtDot (VAlign v)      = printHtmlField  "VALIGN" v-  unqtDot (Width v)       = printHtmlField  "WIDTH" v+  unqtDot (Align v)         = printHtmlField  "ALIGN" v+  unqtDot (BAlign v)        = printHtmlField  "BALIGN" v+  unqtDot (BGColor v)       = printHtmlField  "BGCOLOR" v+  unqtDot (Border v)        = printHtmlField  "BORDER" v+  unqtDot (CellBorder v)    = printHtmlField  "CELLBORDER" v+  unqtDot (CellPadding v)   = printHtmlField  "CELLPADDING" v+  unqtDot (CellSpacing v)   = printHtmlField  "CELLSPACING" v+  unqtDot (Color v)         = printHtmlField  "COLOR" v+  unqtDot (ColSpan v)       = printHtmlField  "COLSPAN" v+  unqtDot (Columns v)       = printHtmlField  "COLUMNS" v+  unqtDot (Face v)          = printHtmlField' "FACE" $ escapeAttribute v+  unqtDot (FixedSize v)     = printHtmlField' "FIXEDSIZE" $ printBoolHtml v+  unqtDot (GradientAngle v) = printHtmlField  "GRADIENTANGLE" v+  unqtDot (Height v)        = printHtmlField  "HEIGHT" v+  unqtDot (HRef v)          = printHtmlField' "HREF" $ escapeAttribute v+  unqtDot (ID v)            = printHtmlField' "ID" $ escapeAttribute v+  unqtDot (PointSize v)     = printHtmlField  "POINT-SIZE" v+  unqtDot (Port v)          = printHtmlField' "PORT" . escapeAttribute $ portName v+  unqtDot (Rows v)          = printHtmlField  "ROWS" v+  unqtDot (RowSpan v)       = printHtmlField  "ROWSPAN" v+  unqtDot (Scale v)         = printHtmlField  "SCALE" v+  unqtDot (Sides v)         = printHtmlField  "SIDES" v+  unqtDot (Src v)           = printHtmlField' "SRC" . escapeAttribute $ T.pack v+  unqtDot (Style v)         = printHtmlField  "STYLE" v+  unqtDot (Target v)        = printHtmlField' "TARGET" $ escapeAttribute v+  unqtDot (Title v)         = printHtmlField' "TITLE" $ escapeAttribute v+  unqtDot (VAlign v)        = printHtmlField  "VALIGN" v+  unqtDot (Width v)         = printHtmlField  "WIDTH" v    unqtListToDot = hsep . mapM unqtDot @@ -372,16 +391,21 @@                     , parseHtmlField  CellSpacing "CELLSPACING"                     , parseHtmlField  Color "COLOR"                     , parseHtmlField  ColSpan "COLSPAN"+                    , parseHtmlField  Columns "COLUMNS"                     , parseHtmlField' Face "FACE" unescapeAttribute                     , parseHtmlField' FixedSize "FIXEDSIZE" parseBoolHtml+                    , parseHtmlField  GradientAngle "GRADIENTANGLE"                     , parseHtmlField  Height "HEIGHT"                     , parseHtmlField' HRef "HREF" unescapeAttribute                     , parseHtmlField' ID "ID" unescapeAttribute                     , parseHtmlField  PointSize "POINT-SIZE"                     , parseHtmlField' (Port . PN) "PORT" unescapeAttribute+                    , parseHtmlField  Rows "ROWS"                     , parseHtmlField  RowSpan "ROWSPAN"                     , parseHtmlField  Scale "SCALE"-                    , parseHtmlField' Src "SRC" $ liftM T.unpack unescapeAttribute+                    , parseHtmlField  Sides "SIDES"+                    , parseHtmlField' Src "SRC" $ fmap T.unpack unescapeAttribute+                    , parseHtmlField  Style "STYLE"                     , parseHtmlField' Target "TARGET" unescapeAttribute                     , parseHtmlField' Title "TITLE" unescapeAttribute                       `onFail`@@ -404,9 +428,17 @@  parseHtmlField'       :: (a -> Attribute) -> String -> Parse a                      -> Parse Attribute-parseHtmlField' c f p = do string f-                           parseEq-                           liftM c $ quotedParse p+parseHtmlField' c f p = string f+                        *> parseEq+                        *> ( c <$> ( quotedParse p+                                      `adjustErr`+                                      (("Can't parse HTML.Attribute." ++ f ++ "\n\t")++)+                                   )+                           )+-- Can't use liftEqParse, etc. here because it causes backtracking+-- problems when the attributes could apply to multiple constructors.+-- This includes using commit! (Example: if it starts with a FONT tag,+-- is it a Table or Text?  -- | Specifies horizontal placement. When an object is allocated more --   space than required, this value determines where the extra space@@ -456,15 +488,26 @@    parse = parseUnqt +data CellFormat = RuleBetween+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot CellFormat where+  unqtDot RuleBetween = text "*"++instance ParseDot CellFormat where+  parseUnqt = stringRep RuleBetween "*"++  parse = parseUnqt+ -- | Specifies how an image will use any extra space available in its --   cell.  If undefined, the image inherits the value of the --   @ImageScale@ attribute. data Scale = NaturalSize -- ^ Default value.-               | ScaleUniformly-               | ExpandWidth-               | ExpandHeight-               | ExpandBoth-               deriving (Eq, Ord, Bounded, Enum, Show, Read)+           | ScaleUniformly+           | ExpandWidth+           | ExpandHeight+           | ExpandBoth+           deriving (Eq, Ord, Bounded, Enum, Show, Read)  instance PrintDot Scale where   unqtDot NaturalSize    = text "FALSE"@@ -483,6 +526,52 @@    parse = parseUnqt +-- | Which sides of a border in a cell or table should be drawn, if a+--   border is drawn.+data Side = LeftSide+          | RightSide+          | TopSide+          | BottomSide+          deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Side where+  unqtDot LeftSide   = text "L"+  unqtDot RightSide  = text "R"+  unqtDot TopSide    = text "T"+  unqtDot BottomSide = text "B"++  unqtListToDot = hcat . mapM unqtDot++  listToDot = unqtListToDot++instance ParseDot Side where+  parseUnqt = oneOf [ stringRep LeftSide   "L"+                    , stringRep RightSide  "R"+                    , stringRep TopSide    "T"+                    , stringRep BottomSide "B"+                    ]++  parse = parseUnqt++  parseUnqtList = many parseUnqt++  parseList = parseUnqtList++data Style = Rounded  -- ^ Valid for 'Table'+           | Radial   -- ^ Valid for 'Table', 'Cell'.+           deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Style where+  unqtDot Rounded = text "ROUNDED"+  unqtDot Radial  = text "RADIAL"++instance ParseDot Style where+  parseUnqt = oneOf [ stringRep Rounded "ROUNDED"+                    , stringRep Radial  "RADIAL"+                    ]++  parse = parseUnqt+ -- -----------------------------------------------------------------------------  escapeAttribute :: T.Text -> DotCode@@ -492,14 +581,14 @@ escapeValue = escapeHtml True  escapeHtml               :: Bool -> T.Text -> DotCode-escapeHtml quotesAllowed = hcat . liftM concat+escapeHtml quotesAllowed = hcat . fmap concat                            . mapM (escapeSegment . T.unpack)                            . T.groupBy ((==) `on` isSpace)   where     -- Note: use numeric version of space rather than nbsp, since this     -- matches what Graphviz does (since Inkscape apparently can't     -- cope with nbsp).-    escapeSegment (s:sps) | isSpace s = liftM2 (:) (char s) $ mapM numEscape sps+    escapeSegment (s:sps) | isSpace s = liftA2 (:) (char s) $ mapM numEscape sps     escapeSegment txt                 = mapM xmlChar txt      allowQuotes = if quotesAllowed@@ -523,7 +612,7 @@ --   Note: this /will/ fail if an unknown non-numeric HTML-escape is --   used. unescapeHtml               :: Bool -> Parse T.Text-unescapeHtml quotesAllowed = liftM (T.pack . catMaybes)+unescapeHtml quotesAllowed = fmap (T.pack . catMaybes)                              . many1 . oneOf $ [ parseEscpd                                                , validChars                                                ]@@ -551,7 +640,7 @@      escMap = Map.fromList htmlUnescapes -    validChars = liftM Just $ satisfy (`notElem` needEscaping)+    validChars = fmap Just $ satisfy (`notElem` needEscaping)     needEscaping = allowQuotes $ map fst htmlEscapes  -- | The characters that need to be escaped and what they need to be@@ -562,9 +651,6 @@               , ('>', "gt")               , ('&', "amp")               ]-              ++ map numEscape ['-', '\'']-  where-    numEscape c = (c, T.pack $ '#' : show (ord c))  -- | Flip the order and add extra values that might be escaped.  More --   specifically, provide the escape code for spaces (@\"nbsp\"@) and@@ -572,7 +658,7 @@ htmlUnescapes :: [(T.Text, Char)] htmlUnescapes = maybeEscaped                 ++-                map (uncurry (flip (,))) htmlEscapes+                map (uncurry $ flip (,)) htmlEscapes   where     maybeEscaped = [("nbsp", ' '), ("apos", '\'')] @@ -610,32 +696,38 @@ -- | Parse something like @<FOO ATTR=\"ATTR_VALUE\">value<\/FOO>@ parseTag        :: (Attributes -> val -> tag) -> String                        -> Parse val -> Parse tag-parseTag c t pv = do as <- parseAngled openingTag-                     v <- pv-                     parseAngled $ character '/' >> t' >> whitespace-                     return $ c as v+parseTag c t pv = c <$> parseAngled openingTag+                    <*> wrapWhitespace pv+                    <* parseAngled (character '/' *> t' *> whitespace)+                  `adjustErr`+                  (("Can't parse Html tag: " ++ t ++ "\n\t")++)   where     t' = string t-    openingTag = do t'-                    as <- tryParseList' $ whitespace1 >> parse-                    whitespace-                    return as--parseTagRep :: (tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag-parseTagRep c pt pv = do tn <- parseAngled (pt `discard` whitespace)-                         v <- pv-                         parseAngled $ character '/' >> pt >> whitespace-                         return $ c tn v+    openingTag :: Parse Attributes+    openingTag = t'+                 *> tryParseList' (whitespace1 >> parse)+                 <* whitespace  parseFontTag :: (Attributes -> val -> tag) -> Parse val -> Parse tag-parseFontTag = flip parseTag "FONT"+parseFontTag = (`parseTag` "FONT") +-- Should this just be specialised for tagName ~ Format ?++-- | Parse something like @<FOO>value<\/FOO>@.+parseTagRep :: (tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag+parseTagRep c pt pv = c <$> parseAngled (pt `discard` whitespace)+                        <*> pv+                        <* parseAngled (character '/' *> pt *> whitespace)+                    `adjustErr`+                    ("Can't parse attribute-less Html tag\n\t"++)+ -- | Parse something like @<FOO ATTR=\"ATTR_VALUE\"\/>@ parseEmptyTag     :: (Attributes -> tag) -> String -> Parse tag-parseEmptyTag c t = parseAngled-                        ( do string t-                             as <- tryParseList' $ whitespace1 >> parse-                             whitespace-                             character '/'-                             return $ c as+parseEmptyTag c t = c <$> parseAngled+                        ( string t+                          *> tryParseList' (whitespace1 *> parse)+                          <* whitespace+                          <* character '/'                         )+                    `adjustErr`+                    (("Can't parse empty Html tag: " ++ t ++ "\n\t")++)
Data/GraphViz/Attributes/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-}  {- |@@ -9,7 +9,8 @@    Maintainer  : Ivan.Miljenovic@gmail.com     This module is defined so as to avoid exposing internal functions-   in the external API.+   in the external API.  These are those that are needed for the+   testsuite.   -} @@ -24,12 +25,15 @@ import Data.GraphViz.Parsing import Data.GraphViz.Printing -import Data.Maybe(isNothing)-import qualified Data.Map as Map-import Data.Map(Map)-import Data.Text.Lazy(Text)-import Control.Monad(liftM, liftM2)+import           Data.Map       (Map)+import qualified Data.Map       as Map+import           Data.Maybe     (isNothing)+import           Data.Text.Lazy (Text) +#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif+ -- -----------------------------------------------------------------------------  -- Note that printing and parsing of PortName values is specific to@@ -52,15 +56,14 @@   toDot = toDot . portName  instance ParseDot PortName where-  parseUnqt = liftM PN-              $ parseEscaped False [] ['"', ':']+  parseUnqt = PN <$> parseEscaped False [] ['"', ':']    parse = quotedParse parseUnqt           `onFail`           unqtPortName  unqtPortName :: Parse PortName-unqtPortName = liftM PN quotelessString+unqtPortName = PN <$> quotelessString  -- ----------------------------------------------------------------------------- @@ -86,17 +89,17 @@    parse = quotedParse parseUnqt           `onFail`-          liftM checkPortName unqtPortName+          fmap checkPortName unqtPortName  checkPortName    :: PortName -> PortPos checkPortName pn = maybe (LabelledPort pn Nothing) CompassPoint-                   . flip Map.lookup compassLookup+                   . (`Map.lookup` compassLookup)                    $ portName pn  -- | When attached to a node in a DotEdge definition, the 'PortName' --   and the 'CompassPoint' can be in separate quotes. parseEdgeBasedPP :: Parse PortPos-parseEdgeBasedPP = liftM2 LabelledPort parse (liftM Just $ character ':' >> parse)+parseEdgeBasedPP = liftA2 LabelledPort parse (fmap Just $ character ':' *> parse)                    `onFail`                    parse
Data/GraphViz/Attributes/Same.hs view
@@ -16,6 +16,7 @@        , SAttrs        , toSAttr        , unSame+       , unSameSet        ) where  import Data.GraphViz.Attributes.Complete(Attribute, Attributes, sameAttribute)@@ -47,3 +48,6 @@  unSame :: SAttrs -> Attributes unSame = map getAttr . Set.toList++unSameSet :: SAttrs -> Set Attribute+unSameSet = Set.mapMonotonic getAttr
+ Data/GraphViz/Attributes/Values.hs view
@@ -0,0 +1,1635 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+{-# OPTIONS_HADDOCK hide #-}+{- |+   Module      : Data.GraphViz.Attributes.Values+   Description : Values for use with the Attribute data type+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   Defined to have smaller modules and thus faster compilation times.++ -}+module Data.GraphViz.Attributes.Values where++import qualified Data.GraphViz.Attributes.HTML     as Html+import           Data.GraphViz.Attributes.Internal+import           Data.GraphViz.Internal.State      (getLayerListSep,+                                                    getLayerSep,+                                                    setLayerListSep,+                                                    setLayerSep)+import           Data.GraphViz.Internal.Util       (bool, stringToInt)+import           Data.GraphViz.Parsing+import           Data.GraphViz.Printing++import           Data.List       (intercalate)+import           Data.Maybe      (isJust)+import           Data.Text.Lazy  (Text)+import qualified Data.Text.Lazy  as T+import           Data.Word       (Word16)+import           System.FilePath (searchPathSeparator, splitSearchPath)++#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif++-- -----------------------------------------------------------------------------++{- |++   Some 'Attribute's (mainly label-like ones) take a 'String' argument+   that allows for extra escape codes.  This library doesn't do any+   extra checks or special parsing for these escape codes, but usage+   of 'EscString' rather than 'Text' indicates that the Graphviz+   tools will recognise these extra escape codes for these+   'Attribute's.++   The extra escape codes include (note that these are all Strings):++     [@\\N@] Replace with the name of the node (for Node 'Attribute's).++     [@\\G@] Replace with the name of the graph (for Node 'Attribute's)+             or the name of the graph or cluster, whichever is+             applicable (for Graph, Cluster and Edge 'Attribute's).++     [@\\E@] Replace with the name of the edge, formed by the two+             adjoining nodes and the edge type (for Edge 'Attribute's).++     [@\\T@] Replace with the name of the tail node (for Edge+             'Attribute's).++     [@\\H@] Replace with the name of the head node (for Edge+             'Attribute's).++     [@\\L@] Replace with the object's label (for all 'Attribute's).++   Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or+   'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines+   centered, left-justified and right-justified respectively.++ -}+type EscString = Text++-- -----------------------------------------------------------------------------++-- | Should only have 2D points (i.e. created with 'createPoint').+data Rect = Rect Point Point+            deriving (Eq, Ord, Show, Read)++instance PrintDot Rect where+  unqtDot (Rect p1 p2) = printPoint2DUnqt p1 <> comma <> printPoint2DUnqt p2++  toDot = dquotes . unqtDot++  unqtListToDot = hsep . mapM unqtDot++instance ParseDot Rect where+  parseUnqt = uncurry Rect <$> commaSep' parsePoint2D parsePoint2D++  parse = quotedParse parseUnqt++  parseUnqtList = sepBy1 parseUnqt whitespace1++-- -----------------------------------------------------------------------------++-- | If 'Local', then sub-graphs that are clusters are given special+--   treatment.  'Global' and 'NoCluster' currently appear to be+--   identical and turn off the special cluster processing.+data ClusterMode = Local+                 | Global+                 | NoCluster+                 deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ClusterMode where+  unqtDot Local     = text "local"+  unqtDot Global    = text "global"+  unqtDot NoCluster = text "none"++instance ParseDot ClusterMode where+  parseUnqt = oneOf [ stringRep Local "local"+                    , stringRep Global "global"+                    , stringRep NoCluster "none"+                    ]++-- -----------------------------------------------------------------------------++-- | Specify where to place arrow heads on an edge.+data DirType = Forward -- ^ Draw a directed edge with an arrow to the+                       --   node it's pointing go.+             | Back    -- ^ Draw a reverse directed edge with an arrow+                       --   to the node it's coming from.+             | Both    -- ^ Draw arrows on both ends of the edge.+             | NoDir   -- ^ Draw an undirected edge.+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot DirType where+  unqtDot Forward = text "forward"+  unqtDot Back    = text "back"+  unqtDot Both    = text "both"+  unqtDot NoDir   = text "none"++instance ParseDot DirType where+  parseUnqt = oneOf [ stringRep Forward "forward"+                    , stringRep Back "back"+                    , stringRep Both "both"+                    , stringRep NoDir "none"+                    ]++-- -----------------------------------------------------------------------------++-- | Only when @mode == 'IpSep'@.+data DEConstraints = EdgeConstraints+                   | NoConstraints+                   | HierConstraints+                   deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot DEConstraints where+  unqtDot EdgeConstraints = unqtDot True+  unqtDot NoConstraints   = unqtDot False+  unqtDot HierConstraints = text "hier"++instance ParseDot DEConstraints where+  parseUnqt = fmap (bool NoConstraints EdgeConstraints) parse+              `onFail`+              stringRep HierConstraints "hier"++-- -----------------------------------------------------------------------------++-- | Either a 'Double' or a (2D) 'Point' (i.e. created with+--   'createPoint').+--+--   Whilst it is possible to create a 'Point' value with either a+--   third co-ordinate or a forced position, these are ignored for+--   printing/parsing.+--+--   An optional prefix of @\'+\'@ is allowed when parsing.+data DPoint = DVal Double+            | PVal Point+            deriving (Eq, Ord, Show, Read)++instance PrintDot DPoint where+  unqtDot (DVal d) = unqtDot d+  unqtDot (PVal p) = printPoint2DUnqt p++  toDot (DVal d) = toDot d+  toDot (PVal p) = printPoint2D p++instance ParseDot DPoint where+  parseUnqt = optional (character '+')+              *> oneOf [ PVal <$> parsePoint2D+                       , DVal <$> parseUnqt+                       ]++  parse = quotedParse parseUnqt -- A `+' would need to be quoted.+          `onFail`+          fmap DVal (parseSignedFloat False) -- Don't use parseUnqt!++-- -----------------------------------------------------------------------------++-- | The mapping used for 'FontName' values in SVG output.+--+--   More information can be found at <http://www.graphviz.org/doc/fontfaq.txt>.+data SVGFontNames = SvgNames        -- ^ Use the legal generic SVG font names.+                  | PostScriptNames -- ^ Use PostScript font names.+                  | FontConfigNames -- ^ Use fontconfig font conventions.+                  deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot SVGFontNames where+  unqtDot SvgNames        = text "svg"+  unqtDot PostScriptNames = text "ps"+  unqtDot FontConfigNames = text "gd"++instance ParseDot SVGFontNames where+  parseUnqt = oneOf [ stringRep SvgNames "svg"+                    , stringRep PostScriptNames "ps"+                    , stringRep FontConfigNames "gd"+                    ]++  parse = stringRep SvgNames "\"\""+          `onFail`+          optionalQuoted parseUnqt++-- -----------------------------------------------------------------------------++-- | Maximum width and height of drawing in inches.+data GraphSize = GSize { width       :: Double+                         -- | If @Nothing@, then the height is the+                         --   same as the width.+                       , height      :: Maybe Double+                         -- | If drawing is smaller than specified+                         --   size, this value determines whether it+                         --   is scaled up.+                       , desiredSize :: Bool+                       }+               deriving (Eq, Ord, Show, Read)++instance PrintDot GraphSize where+  unqtDot (GSize w mh ds) = bool id (<> char '!') ds+                            . maybe id (\h -> (<> unqtDot h) . (<> comma)) mh+                            $ unqtDot w++  toDot (GSize w Nothing False) = toDot w+  toDot gs                      = dquotes $ unqtDot gs++instance ParseDot GraphSize where+  parseUnqt = GSize <$> parseUnqt+                    <*> optional (parseComma *> whitespace *> parseUnqt)+                    <*> (isJust <$> optional (character '!'))++  parse = quotedParse parseUnqt+          `onFail`+          fmap (\ w -> GSize w Nothing False) (parseSignedFloat False)++-- -----------------------------------------------------------------------------++-- | For 'Neato' unless indicated otherwise.+data ModeType = Major+              | KK+              | Hier+              | IpSep+              | SpringMode -- ^ For 'Sfdp', requires Graphviz >= 2.32.0.+              | MaxEnt     -- ^ For 'Sfdp', requires Graphviz >= 2.32.0.+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ModeType where+  unqtDot Major      = text "major"+  unqtDot KK         = text "KK"+  unqtDot Hier       = text "hier"+  unqtDot IpSep      = text "ipsep"+  unqtDot SpringMode = text "spring"+  unqtDot MaxEnt     = text "maxent"++instance ParseDot ModeType where+  parseUnqt = oneOf [ stringRep Major "major"+                    , stringRep KK "KK"+                    , stringRep Hier "hier"+                    , stringRep IpSep "ipsep"+                    , stringRep SpringMode "spring"+                    , stringRep MaxEnt "maxent"+                    ]++-- -----------------------------------------------------------------------------++data Model = ShortPath+           | SubSet+           | Circuit+           | MDS+           deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Model where+  unqtDot ShortPath = text "shortpath"+  unqtDot SubSet    = text "subset"+  unqtDot Circuit   = text "circuit"+  unqtDot MDS       = text "mds"++instance ParseDot Model where+  parseUnqt = oneOf [ stringRep ShortPath "shortpath"+                    , stringRep SubSet "subset"+                    , stringRep Circuit "circuit"+                    , stringRep MDS "mds"+                    ]++-- -----------------------------------------------------------------------------++data Label = StrLabel EscString+           | HtmlLabel Html.Label -- ^ If 'PlainText' is used, the+                                  --   'Html.Label' value is the entire+                                  --   \"shape\"; if anything else+                                  --   except 'PointShape' is used then+                                  --   the 'Html.Label' is embedded+                                  --   within the shape.+           | RecordLabel RecordFields -- ^ For nodes only; requires+                                      --   either 'Record' or+                                      --   'MRecord' as the shape.+           deriving (Eq, Ord, Show, Read)++instance PrintDot Label where+  unqtDot (StrLabel s)     = unqtDot s+  unqtDot (HtmlLabel h)    = angled $ unqtDot h+  unqtDot (RecordLabel fs) = unqtDot fs++  toDot (StrLabel s)     = toDot s+  toDot h@HtmlLabel{}    = unqtDot h+  toDot (RecordLabel fs) = toDot fs++instance ParseDot Label where+  -- Don't have to worry about being able to tell the difference+  -- between an HtmlLabel and a RecordLabel starting with a PortPos,+  -- since the latter will be in quotes and the former won't.++  parseUnqt = oneOf [ HtmlLabel <$> parseAngled parseUnqt+                    , RecordLabel <$> parseUnqt+                    , StrLabel <$> parseUnqt+                    ]++  parse = oneOf [ HtmlLabel <$> parseAngled parse+                , RecordLabel <$> parse+                , StrLabel <$> parse+                ]++-- -----------------------------------------------------------------------------++-- | A RecordFields value should never be empty.+type RecordFields = [RecordField]++-- | Specifies the sub-values of a record-based label.  By default,+--   the cells are laid out horizontally; use 'FlipFields' to change+--   the orientation of the fields (can be applied recursively).  To+--   change the default orientation, use 'RankDir'.+data RecordField = LabelledTarget PortName EscString+                 | PortName PortName -- ^ Will result in no label for+                                     --   that cell.+                 | FieldLabel EscString+                 | FlipFields RecordFields+                 deriving (Eq, Ord, Show, Read)++instance PrintDot RecordField where+  -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.+  unqtDot (LabelledTarget t s) = printPortName t <+> unqtRecordString s+  unqtDot (PortName t)         = printPortName t+  unqtDot (FieldLabel s)       = unqtRecordString s+  unqtDot (FlipFields rs)      = braces $ unqtDot rs++  toDot (FieldLabel s) = printEscaped recordEscChars s+  toDot rf             = dquotes $ unqtDot rf++  unqtListToDot [f] = unqtDot f+  unqtListToDot fs  = hcat . punctuate (char '|') $ mapM unqtDot fs++  listToDot [f] = toDot f+  listToDot fs  = dquotes $ unqtListToDot fs++instance ParseDot RecordField where+  parseUnqt = (liftA2 maybe PortName LabelledTarget+                <$> (PN <$> parseAngled parseRecord)+                <*> optional (whitespace1 *> parseRecord)+              )+              `onFail`+              fmap FieldLabel parseRecord+              `onFail`+              fmap FlipFields (parseBraced parseUnqt)+              `onFail`+              fail "Unable to parse RecordField"++  parse = quotedParse parseUnqt++  parseUnqtList = wrapWhitespace $ sepBy1 parseUnqt (wrapWhitespace $ character '|')++  -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it+  -- will cause parsing problems for other 'Label' types.+  parseList = do rfs <- quotedParse parseUnqtList+                 if validRFs rfs+                   then return rfs+                   else fail "This is a StrLabel, not a RecordLabel"+    where+      validRFs [FieldLabel str] = T.any (`elem` recordEscChars) str+      validRFs _                = True++-- | Print a 'PortName' value as expected within a Record data+--   structure.+printPortName :: PortName -> DotCode+printPortName = angled . unqtRecordString . portName++parseRecord :: Parse Text+parseRecord = parseEscaped False recordEscChars []++unqtRecordString :: Text -> DotCode+unqtRecordString = unqtEscaped recordEscChars++recordEscChars :: [Char]+recordEscChars = ['{', '}', '|', ' ', '<', '>']++-- -----------------------------------------------------------------------------++-- | How to treat a node whose name is of the form \"@|edgelabel|*@\"+--   as a special node representing an edge label.+data LabelScheme = NotEdgeLabel        -- ^ No effect+                 | CloseToCenter       -- ^ Make node close to center of neighbor+                 | CloseToOldCenter    -- ^ Make node close to old center of neighbor+                 | RemoveAndStraighten -- ^ Use a two-step process.+                 deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot LabelScheme where+  unqtDot NotEdgeLabel        = int 0+  unqtDot CloseToCenter       = int 1+  unqtDot CloseToOldCenter    = int 2+  unqtDot RemoveAndStraighten = int 3++instance ParseDot LabelScheme where+  -- Use string-based parsing rather than parsing an integer just to make it easier+  parseUnqt = stringValue [ ("0", NotEdgeLabel)+                          , ("1", CloseToCenter)+                          , ("2", CloseToOldCenter)+                          , ("3", RemoveAndStraighten)+                          ]++-- -----------------------------------------------------------------------------++data Point = Point { xCoord   :: Double+                   , yCoord   :: Double+                      -- | Can only be 'Just' for @'Dim' 3@ or greater.+                   , zCoord   :: Maybe Double+                     -- | Input to Graphviz only: specify that the+                     --   node position should not change.+                   , forcePos :: Bool+                   }+           deriving (Eq, Ord, Show, Read)++-- | Create a point with only @x@ and @y@ values.+createPoint     :: Double -> Double -> Point+createPoint x y = Point x y Nothing False++printPoint2DUnqt   :: Point -> DotCode+printPoint2DUnqt p = commaDel (xCoord p) (yCoord p)++printPoint2D :: Point -> DotCode+printPoint2D = dquotes . printPoint2DUnqt++parsePoint2D :: Parse Point+parsePoint2D = uncurry createPoint <$> commaSepUnqt++instance PrintDot Point where+  unqtDot (Point x y mz frs) = bool id (<> char '!') frs+                               . maybe id (\ z -> (<> unqtDot z) . (<> comma)) mz+                               $ commaDel x y++  toDot = dquotes . unqtDot++  unqtListToDot = hsep . mapM unqtDot++  listToDot = dquotes . unqtListToDot++instance ParseDot Point where+  parseUnqt = uncurry Point+                <$> commaSepUnqt+                <*> optional (parseComma *> parseUnqt)+                <*> (isJust <$> optional (character '!'))++  parse = quotedParse parseUnqt++  parseUnqtList = sepBy1 parseUnqt whitespace1++-- -----------------------------------------------------------------------------++-- | How to deal with node overlaps.+--+--   Defaults to 'KeepOverlaps' /except/ for 'Fdp' and 'Sfdp'.+--+--   The ability to specify the number of tries for 'Fdp''s initial+--   force-directed technique is /not/ supported (by default, 'Fdp' uses+--   @9@ passes of its in-built technique, and then @'PrismOverlap'+--   Nothing@).+--+--   For 'Sfdp', the default is @'PrismOverlap' (Just 0)@.+data Overlap = KeepOverlaps+             | ScaleOverlaps -- ^ Remove overlaps by uniformly scaling in x and y.+             | ScaleXYOverlaps -- ^ Remove overlaps by separately scaling x and y.+             | PrismOverlap (Maybe Word16) -- ^ Requires the Prism+                                           --   library to be+                                           --   available (if not,+                                           --   this is equivalent to+                                           --   'VoronoiOverlap'). @'Nothing'@+                                           --   is equivalent to+                                           --   @'Just' 1000@.+                                           --   Influenced by+                                           --   'OverlapScaling'.+             | VoronoiOverlap -- ^ Requires Graphviz >= 2.30.0.+             | CompressOverlap -- ^ Scale layout down as much as+                               --   possible without introducing+                               --   overlaps, assuming none to begin+                               --   with.+             | VpscOverlap -- ^ Uses quadratic optimization to+                           --   minimize node displacement.+             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@+             deriving (Eq, Ord, Show, Read)++instance PrintDot Overlap where+  unqtDot KeepOverlaps     = unqtDot True+  unqtDot ScaleOverlaps    = text "scale"+  unqtDot ScaleXYOverlaps  = text "scalexy"+  unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism"+  unqtDot VoronoiOverlap   = text "voronoi"+  unqtDot CompressOverlap  = text "compress"+  unqtDot VpscOverlap      = text "vpsc"+  unqtDot IpsepOverlap     = text "ipsep"++-- | Note that @overlap=false@ defaults to @'PrismOverlap' Nothing@,+--   but if the Prism library isn't available then it is equivalent to+--   'VoronoiOverlap'.+instance ParseDot Overlap where+  parseUnqt = oneOf [ stringRep KeepOverlaps "true"+                    , stringRep ScaleXYOverlaps "scalexy"+                    , stringRep ScaleOverlaps "scale"+                    , string "prism" *> fmap PrismOverlap (optional parse)+                    , stringRep (PrismOverlap Nothing) "false"+                    , stringRep VoronoiOverlap "voronoi"+                    , stringRep CompressOverlap "compress"+                    , stringRep VpscOverlap "vpsc"+                    , stringRep IpsepOverlap "ipsep"+                    ]++-- -----------------------------------------------------------------------------++newtype LayerSep = LSep Text+                 deriving (Eq, Ord, Show, Read)++instance PrintDot LayerSep where+  unqtDot (LSep ls) = setLayerSep (T.unpack ls) *> unqtDot ls++  toDot (LSep ls) = setLayerSep (T.unpack ls) *> toDot ls++instance ParseDot LayerSep where+  parseUnqt = do ls <- parseUnqt+                 setLayerSep $ T.unpack ls+                 return $ LSep ls++  parse = do ls <- parse+             setLayerSep $ T.unpack ls+             return $ LSep ls++newtype LayerListSep = LLSep Text+                     deriving (Eq, Ord, Show, Read)++instance PrintDot LayerListSep where+  unqtDot (LLSep ls) = setLayerListSep (T.unpack ls) *> unqtDot ls++  toDot (LLSep ls) = setLayerListSep (T.unpack ls) *> toDot ls++instance ParseDot LayerListSep where+  parseUnqt = do ls <- parseUnqt+                 setLayerListSep $ T.unpack ls+                 return $ LLSep ls++  parse = do ls <- parse+             setLayerListSep $ T.unpack ls+             return $ LLSep ls++type LayerRange = [LayerRangeElem]++data LayerRangeElem = LRID LayerID+                    | LRS LayerID LayerID+                    deriving (Eq, Ord, Show, Read)++instance PrintDot LayerRangeElem where+  unqtDot (LRID lid)    = unqtDot lid+  unqtDot (LRS id1 id2) = do ls <- getLayerSep+                             let s = unqtDot $ head ls+                             unqtDot id1 <> s <> unqtDot id2++  toDot (LRID lid) = toDot lid+  toDot lrs        = dquotes $ unqtDot lrs++  unqtListToDot lr = do lls <- getLayerListSep+                        let s = unqtDot $ head lls+                        hcat . punctuate s $ mapM unqtDot lr++  listToDot [lre] = toDot lre+  listToDot lrs   = dquotes $ unqtListToDot lrs++instance ParseDot LayerRangeElem where+  parseUnqt = ignoreSep LRS parseUnqt parseLayerSep parseUnqt+              `onFail`+              fmap LRID parseUnqt++  parse = quotedParse (ignoreSep LRS parseUnqt parseLayerSep parseUnqt)+          `onFail`+          fmap LRID parse++  parseUnqtList = sepBy parseUnqt parseLayerListSep++  parseList = quotedParse parseUnqtList+              `onFail`+              fmap ((:[]) . LRID) parse++parseLayerSep :: Parse ()+parseLayerSep = do ls <- getLayerSep+                   many1Satisfy (`elem` ls) *> return ()++parseLayerName :: Parse Text+parseLayerName = parseEscaped False [] =<< liftA2 (++) getLayerSep getLayerListSep++parseLayerName' :: Parse Text+parseLayerName' = stringBlock+                  `onFail`+                  quotedParse parseLayerName++parseLayerListSep :: Parse ()+parseLayerListSep = do lls <- getLayerListSep+                       many1Satisfy (`elem` lls) *> return ()++-- | You should not have any layer separator characters for the+--   'LRName' option, as they won't be parseable.+data LayerID = AllLayers+             | LRInt Int+             | LRName Text -- ^ Should not be a number or @"all"@.+             deriving (Eq, Ord, Show, Read)++instance PrintDot LayerID where+  unqtDot AllLayers   = text "all"+  unqtDot (LRInt n)   = unqtDot n+  unqtDot (LRName nm) = unqtDot nm++  toDot (LRName nm) = toDot nm+  -- Other two don't need quotes+  toDot li          = unqtDot li++  unqtListToDot ll = do ls <- getLayerSep+                        let s = unqtDot $ head ls+                        hcat . punctuate s $ mapM unqtDot ll++  listToDot [l] = toDot l+  -- Might not need quotes, but probably will.  Can't tell either+  -- way since we don't know what the separator character will be.+  listToDot ll  = dquotes $ unqtDot ll++instance ParseDot LayerID where+  parseUnqt = checkLayerName <$> parseLayerName -- tests for Int and All++  parse = oneOf [ checkLayerName <$> parseLayerName'+                , LRInt <$> parse -- Mainly for unquoted case.+                ]++checkLayerName     :: Text -> LayerID+checkLayerName str = maybe checkAll LRInt $ stringToInt str+  where+    checkAll = if T.toLower str == "all"+               then AllLayers+               else LRName str++-- Remember: this /must/ be a newtype as we can't use arbitrary+-- LayerID values!++-- | A list of layer names.  The names should all be unique 'LRName'+--   values, and when printed will use an arbitrary character from+--   'defLayerSep'.  The values in the list are implicitly numbered+--   @1, 2, ...@.+newtype LayerList = LL [LayerID]+                  deriving (Eq, Ord, Show, Read)++instance PrintDot LayerList where+  unqtDot (LL ll) = unqtDot ll++  toDot (LL ll) = toDot ll++instance ParseDot LayerList where+  parseUnqt = LL <$> sepBy1 parseUnqt parseLayerSep++  parse = quotedParse parseUnqt+          `onFail`+          fmap (LL . (:[]) . LRName) stringBlock+          `onFail`+          quotedParse (stringRep (LL []) "")++-- -----------------------------------------------------------------------------++data Order = OutEdges -- ^ Draw outgoing edges in order specified.+           | InEdges  -- ^ Draw incoming edges in order specified.+           deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Order where+  unqtDot OutEdges = text "out"+  unqtDot InEdges  = text "in"++instance ParseDot Order where+  parseUnqt = oneOf [ stringRep OutEdges "out"+                    , stringRep InEdges  "in"+                    ]++-- -----------------------------------------------------------------------------++data OutputMode = BreadthFirst | NodesFirst | EdgesFirst+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot OutputMode where+  unqtDot BreadthFirst = text "breadthfirst"+  unqtDot NodesFirst   = text "nodesfirst"+  unqtDot EdgesFirst   = text "edgesfirst"++instance ParseDot OutputMode where+  parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"+                    , stringRep NodesFirst "nodesfirst"+                    , stringRep EdgesFirst "edgesfirst"+                    ]++-- -----------------------------------------------------------------------------++data Pack = DoPack+          | DontPack+          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.+          deriving (Eq, Ord, Show, Read)++instance PrintDot Pack where+  unqtDot DoPack         = unqtDot True+  unqtDot DontPack       = unqtDot False+  unqtDot (PackMargin m) = unqtDot m++instance ParseDot Pack where+  -- What happens if it parses 0?  It's non-negative, but parses as False+  parseUnqt = oneOf [ PackMargin <$> parseUnqt+                    , bool DontPack DoPack <$> onlyBool+                    ]++-- -----------------------------------------------------------------------------++data PackMode = PackNode+              | PackClust+              | PackGraph+              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort+                                                -- by user, number of+                                                -- rows/cols+              deriving (Eq, Ord, Show, Read)++instance PrintDot PackMode where+  unqtDot PackNode           = text "node"+  unqtDot PackClust          = text "clust"+  unqtDot PackGraph          = text "graph"+  unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder+                               $ text "array"+    where+      addNum = maybe id (flip (<>) . unqtDot) mi+      isUnder = if c || u+                then (<> char '_')+                else id+      isC = if c+            then (<> char 'c')+            else id+      isU = if u+            then (<> char 'u')+            else id++instance ParseDot PackMode where+  parseUnqt = oneOf [ stringRep PackNode "node"+                    , stringRep PackClust "clust"+                    , stringRep PackGraph "graph"+                    , do string "array"+                         mcu <- optional $ character '_' *> many1 (satisfy isCU)+                         let c = hasCharacter mcu 'c'+                             u = hasCharacter mcu 'u'+                         mi <- optional parseUnqt+                         return $ PackArray c u mi+                    ]+    where+      hasCharacter ms c = maybe False (elem c) ms+      -- Also checks and removes quote characters+      isCU = (`elem` ['c', 'u'])++-- -----------------------------------------------------------------------------++data Pos = PointPos Point+         | SplinePos [Spline]+         deriving (Eq, Ord, Show, Read)++instance PrintDot Pos where+  unqtDot (PointPos p)   = unqtDot p+  unqtDot (SplinePos ss) = unqtDot ss++  toDot (PointPos p)   = toDot p+  toDot (SplinePos ss) = toDot ss++instance ParseDot Pos where+  -- Have to be careful with this: if we try to parse points first,+  -- then a spline with no start and end points will erroneously get+  -- parsed as a point and then the parser will crash as it expects a+  -- closing quote character...+  parseUnqt = do splns <- parseUnqt+                 case splns of+                   [Spline Nothing Nothing [p]] -> return $ PointPos p+                   _                            -> return $ SplinePos splns++  parse = quotedParse parseUnqt++-- -----------------------------------------------------------------------------++-- | Controls how (and if) edges are represented.+--+--   For 'Dot', the default is 'SplineEdges'; for all other layouts+--   the default is 'LineEdges'.+data EdgeType = SplineEdges -- ^ Except for 'Dot', requires+                            --   non-overlapping nodes (see+                            --   'Overlap').+              | LineEdges+              | NoEdges+              | PolyLine+              | Ortho -- ^ Does not handle ports or edge labels in 'Dot'.+              | Curved -- ^ Requires Graphviz >= 2.30.0.+              | CompoundEdge -- ^ 'Fdp' only+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot EdgeType where+  unqtDot SplineEdges  = text "spline"+  unqtDot LineEdges    = text "line"+  unqtDot NoEdges      = empty+  unqtDot PolyLine     = text "polyline"+  unqtDot Ortho        = text "ortho"+  unqtDot Curved       = text "curved"+  unqtDot CompoundEdge = text "compound"++  toDot NoEdges = dquotes empty+  toDot et      = unqtDot et++instance ParseDot EdgeType where+  -- Can't parse NoEdges without quotes.+  parseUnqt = oneOf [ bool LineEdges SplineEdges <$> parse+                    , stringRep SplineEdges "spline"+                    , stringRep LineEdges "line"+                    , stringRep NoEdges "none"+                    , stringRep PolyLine "polyline"+                    , stringRep Ortho "ortho"+                    , stringRep Curved "curved"+                    , stringRep CompoundEdge "compound"+                    ]++  parse = stringRep NoEdges "\"\""+          `onFail`+          optionalQuoted parseUnqt++-- -----------------------------------------------------------------------------++-- | Upper-case first character is major order;+--   lower-case second character is minor order.+data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot PageDir where+  unqtDot Bl = text "BL"+  unqtDot Br = text "BR"+  unqtDot Tl = text "TL"+  unqtDot Tr = text "TR"+  unqtDot Rb = text "RB"+  unqtDot Rt = text "RT"+  unqtDot Lb = text "LB"+  unqtDot Lt = text "LT"++instance ParseDot PageDir where+  parseUnqt = stringValue [ ("BL", Bl)+                          , ("BR", Br)+                          , ("TL", Tl)+                          , ("TR", Tr)+                          , ("RB", Rb)+                          , ("RT", Rt)+                          , ("LB", Lb)+                          , ("LT", Lt)+                          ]++-- -----------------------------------------------------------------------------++-- | The number of points in the list must be equivalent to 1 mod 3;+--   note that this is not checked.+data Spline = Spline { endPoint     :: Maybe Point+                     , startPoint   :: Maybe Point+                     , splinePoints :: [Point]+                     }+            deriving (Eq, Ord, Show, Read)++instance PrintDot Spline where+  unqtDot (Spline me ms ps) = addE . addS+                             . hsep+                             $ mapM unqtDot ps+    where+      addP t = maybe id ((<+>) . commaDel t)+      addS = addP 's' ms+      addE = addP 'e' me++  toDot = dquotes . unqtDot++  unqtListToDot = hcat . punctuate semi . mapM unqtDot++  listToDot = dquotes . unqtListToDot++instance ParseDot Spline where+  parseUnqt = Spline <$> parseP 'e' <*> parseP 's'+                     <*> sepBy1 parseUnqt whitespace1+      where+        parseP t = optional (character t *> parseComma *> parseUnqt <* whitespace1)++  parse = quotedParse parseUnqt++  parseUnqtList = sepBy1 parseUnqt (character ';')++-- -----------------------------------------------------------------------------++data QuadType = NormalQT+              | FastQT+              | NoQT+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot QuadType where+  unqtDot NormalQT = text "normal"+  unqtDot FastQT   = text "fast"+  unqtDot NoQT     = text "none"++instance ParseDot QuadType where+  -- Have to take into account the slightly different interpretation+  -- of Bool used as an option for parsing QuadType+  parseUnqt = oneOf [ stringRep NormalQT "normal"+                    , stringRep FastQT "fast"+                    , stringRep NoQT "none"+                    , character '2' *> return FastQT -- weird bool+                    , bool NoQT NormalQT <$> parse+                    ]++-- -----------------------------------------------------------------------------++-- | Specify the root node either as a Node attribute or a Graph attribute.+data Root = IsCentral     -- ^ For Nodes only+          | NotCentral    -- ^ For Nodes only+          | NodeName Text -- ^ For Graphs only+          deriving (Eq, Ord, Show, Read)++instance PrintDot Root where+  unqtDot IsCentral    = unqtDot True+  unqtDot NotCentral   = unqtDot False+  unqtDot (NodeName n) = unqtDot n++  toDot (NodeName n) = toDot n+  toDot r            = unqtDot r++instance ParseDot Root where+  parseUnqt = fmap (bool NotCentral IsCentral) onlyBool+              `onFail`+              fmap NodeName parseUnqt++  parse = optionalQuoted (bool NotCentral IsCentral <$> onlyBool)+          `onFail`+          fmap NodeName parse++-- -----------------------------------------------------------------------------++data RankType = SameRank+              | MinRank+              | SourceRank+              | MaxRank+              | SinkRank+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot RankType where+  unqtDot SameRank   = text "same"+  unqtDot MinRank    = text "min"+  unqtDot SourceRank = text "source"+  unqtDot MaxRank    = text "max"+  unqtDot SinkRank   = text "sink"++instance ParseDot RankType where+  parseUnqt = stringValue [ ("same", SameRank)+                          , ("min", MinRank)+                          , ("source", SourceRank)+                          , ("max", MaxRank)+                          , ("sink", SinkRank)+                          ]++-- -----------------------------------------------------------------------------++data RankDir = FromTop+             | FromLeft+             | FromBottom+             | FromRight+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot RankDir where+  unqtDot FromTop    = text "TB"+  unqtDot FromLeft   = text "LR"+  unqtDot FromBottom = text "BT"+  unqtDot FromRight  = text "RL"++instance ParseDot RankDir where+  parseUnqt = oneOf [ stringRep FromTop "TB"+                    , stringRep FromLeft "LR"+                    , stringRep FromBottom "BT"+                    , stringRep FromRight "RL"+                    ]++-- -----------------------------------------------------------------------------++-- | Geometries of shapes are affected by the attributes 'Regular',+--   'Peripheries' and 'Orientation'.+data Shape+    = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.+    | Polygon  -- ^ Also affected by 'Sides', 'Skew' and 'Distortion'.+    | Ellipse  -- ^ Has synonym of /oval/.+    | Circle+    | PointShape -- ^ Only affected by 'Peripheries', 'Width' and+                 --   'Height'.+    | Egg+    | Triangle+    | PlainText -- ^ Has synonym of /none/.  Recommended for+                --   'HtmlLabel's.+    | DiamondShape+    | Trapezium+    | Parallelogram+    | House+    | Pentagon+    | Hexagon+    | Septagon+    | Octagon+    | DoubleCircle+    | DoubleOctagon+    | TripleOctagon+    | InvTriangle+    | InvTrapezium+    | InvHouse+    | MDiamond+    | MSquare+    | MCircle+    | Square+    | Star      -- ^ Requires Graphviz >= 2.32.0.+    | Underline -- ^ Requires Graphviz >= 2.36.0.+    | Note+    | Tab+    | Folder+    | Box3D+    | Component+    | Promoter         -- ^ Requires Graphviz >= 2.30.0.+    | CDS              -- ^ Requires Graphviz >= 2.30.0.+    | Terminator       -- ^ Requires Graphviz >= 2.30.0.+    | UTR              -- ^ Requires Graphviz >= 2.30.0.+    | PrimerSite       -- ^ Requires Graphviz >= 2.30.0.+    | RestrictionSite  -- ^ Requires Graphviz >= 2.30.0.+    | FivePovOverhang  -- ^ Requires Graphviz >= 2.30.0.+    | ThreePovOverhang -- ^ Requires Graphviz >= 2.30.0.+    | NoOverhang       -- ^ Requires Graphviz >= 2.30.0.+    | Assembly         -- ^ Requires Graphviz >= 2.30.0.+    | Signature        -- ^ Requires Graphviz >= 2.30.0.+    | Insulator        -- ^ Requires Graphviz >= 2.30.0.+    | Ribosite         -- ^ Requires Graphviz >= 2.30.0.+    | RNAStab          -- ^ Requires Graphviz >= 2.30.0.+    | ProteaseSite     -- ^ Requires Graphviz >= 2.30.0.+    | ProteinStab      -- ^ Requires Graphviz >= 2.30.0.+    | RPromoter        -- ^ Requires Graphviz >= 2.30.0.+    | RArrow           -- ^ Requires Graphviz >= 2.30.0.+    | LArrow           -- ^ Requires Graphviz >= 2.30.0.+    | LPromoter        -- ^ Requires Graphviz >= 2.30.0.+    | Record  -- ^ Must specify the record shape with a 'Label'.+    | MRecord -- ^ Must specify the record shape with a 'Label'.+    deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Shape where+  unqtDot BoxShape         = text "box"+  unqtDot Polygon          = text "polygon"+  unqtDot Ellipse          = text "ellipse"+  unqtDot Circle           = text "circle"+  unqtDot PointShape       = text "point"+  unqtDot Egg              = text "egg"+  unqtDot Triangle         = text "triangle"+  unqtDot PlainText        = text "plaintext"+  unqtDot DiamondShape     = text "diamond"+  unqtDot Trapezium        = text "trapezium"+  unqtDot Parallelogram    = text "parallelogram"+  unqtDot House            = text "house"+  unqtDot Pentagon         = text "pentagon"+  unqtDot Hexagon          = text "hexagon"+  unqtDot Septagon         = text "septagon"+  unqtDot Octagon          = text "octagon"+  unqtDot DoubleCircle     = text "doublecircle"+  unqtDot DoubleOctagon    = text "doubleoctagon"+  unqtDot TripleOctagon    = text "tripleoctagon"+  unqtDot InvTriangle      = text "invtriangle"+  unqtDot InvTrapezium     = text "invtrapezium"+  unqtDot InvHouse         = text "invhouse"+  unqtDot MDiamond         = text "Mdiamond"+  unqtDot MSquare          = text "Msquare"+  unqtDot MCircle          = text "Mcircle"+  unqtDot Square           = text "square"+  unqtDot Star             = text "star"+  unqtDot Underline        = text "underline"+  unqtDot Note             = text "note"+  unqtDot Tab              = text "tab"+  unqtDot Folder           = text "folder"+  unqtDot Box3D            = text "box3d"+  unqtDot Component        = text "component"+  unqtDot Promoter         = text "promoter"+  unqtDot CDS              = text "cds"+  unqtDot Terminator       = text "terminator"+  unqtDot UTR              = text "utr"+  unqtDot PrimerSite       = text "primersite"+  unqtDot RestrictionSite  = text "restrictionsite"+  unqtDot FivePovOverhang  = text "fivepovoverhang"+  unqtDot ThreePovOverhang = text "threepovoverhang"+  unqtDot NoOverhang       = text "nooverhang"+  unqtDot Assembly         = text "assembly"+  unqtDot Signature        = text "signature"+  unqtDot Insulator        = text "insulator"+  unqtDot Ribosite         = text "ribosite"+  unqtDot RNAStab          = text "rnastab"+  unqtDot ProteaseSite     = text "proteasesite"+  unqtDot ProteinStab      = text "proteinstab"+  unqtDot RPromoter        = text "rpromoter"+  unqtDot RArrow           = text "rarrow"+  unqtDot LArrow           = text "larrow"+  unqtDot LPromoter        = text "lpromoter"+  unqtDot Record           = text "record"+  unqtDot MRecord          = text "Mrecord"++instance ParseDot Shape where+  parseUnqt = stringValue [ ("box3d", Box3D)+                          , ("box", BoxShape)+                          , ("rectangle", BoxShape)+                          , ("rect", BoxShape)+                          , ("polygon", Polygon)+                          , ("ellipse", Ellipse)+                          , ("oval", Ellipse)+                          , ("circle", Circle)+                          , ("point", PointShape)+                          , ("egg", Egg)+                          , ("triangle", Triangle)+                          , ("plaintext", PlainText)+                          , ("none", PlainText)+                          , ("diamond", DiamondShape)+                          , ("trapezium", Trapezium)+                          , ("parallelogram", Parallelogram)+                          , ("house", House)+                          , ("pentagon", Pentagon)+                          , ("hexagon", Hexagon)+                          , ("septagon", Septagon)+                          , ("octagon", Octagon)+                          , ("doublecircle", DoubleCircle)+                          , ("doubleoctagon", DoubleOctagon)+                          , ("tripleoctagon", TripleOctagon)+                          , ("invtriangle", InvTriangle)+                          , ("invtrapezium", InvTrapezium)+                          , ("invhouse", InvHouse)+                          , ("Mdiamond", MDiamond)+                          , ("Msquare", MSquare)+                          , ("Mcircle", MCircle)+                          , ("square", Square)+                          , ("star", Star)+                          , ("underline", Underline)+                          , ("note", Note)+                          , ("tab", Tab)+                          , ("folder", Folder)+                          , ("component", Component)+                          , ("promoter", Promoter)+                          , ("cds", CDS)+                          , ("terminator", Terminator)+                          , ("utr", UTR)+                          , ("primersite", PrimerSite)+                          , ("restrictionsite", RestrictionSite)+                          , ("fivepovoverhang", FivePovOverhang)+                          , ("threepovoverhang", ThreePovOverhang)+                          , ("nooverhang", NoOverhang)+                          , ("assembly", Assembly)+                          , ("signature", Signature)+                          , ("insulator", Insulator)+                          , ("ribosite", Ribosite)+                          , ("rnastab", RNAStab)+                          , ("proteasesite", ProteaseSite)+                          , ("proteinstab", ProteinStab)+                          , ("rpromoter", RPromoter)+                          , ("rarrow", RArrow)+                          , ("larrow", LArrow)+                          , ("lpromoter", LPromoter)+                          , ("record", Record)+                          , ("Mrecord", MRecord)+                          ]++-- -----------------------------------------------------------------------------++data SmoothType = NoSmooth+                | AvgDist+                | GraphDist+                | PowerDist+                | RNG+                | Spring+                | TriangleSmooth+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot SmoothType where+  unqtDot NoSmooth       = text "none"+  unqtDot AvgDist        = text "avg_dist"+  unqtDot GraphDist      = text "graph_dist"+  unqtDot PowerDist      = text "power_dist"+  unqtDot RNG            = text "rng"+  unqtDot Spring         = text "spring"+  unqtDot TriangleSmooth = text "triangle"++instance ParseDot SmoothType where+  parseUnqt = oneOf [ stringRep NoSmooth "none"+                    , stringRep AvgDist "avg_dist"+                    , stringRep GraphDist "graph_dist"+                    , stringRep PowerDist "power_dist"+                    , stringRep RNG "rng"+                    , stringRep Spring "spring"+                    , stringRep TriangleSmooth "triangle"+                    ]++-- -----------------------------------------------------------------------------++data StartType = StartStyle STStyle+               | StartSeed Int+               | StartStyleSeed STStyle Int+               deriving (Eq, Ord, Show, Read)++instance PrintDot StartType where+  unqtDot (StartStyle ss)       = unqtDot ss+  unqtDot (StartSeed s)         = unqtDot s+  unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s++instance ParseDot StartType where+  parseUnqt = oneOf [ liftA2 StartStyleSeed parseUnqt parseUnqt+                    , StartStyle <$> parseUnqt+                    , StartSeed <$> parseUnqt+                    ]++data STStyle = RegularStyle+             | SelfStyle+             | RandomStyle+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot STStyle where+  unqtDot RegularStyle = text "regular"+  unqtDot SelfStyle    = text "self"+  unqtDot RandomStyle  = text "random"++instance ParseDot STStyle where+  parseUnqt = oneOf [ stringRep RegularStyle "regular"+                    , stringRep SelfStyle "self"+                    , stringRep RandomStyle "random"+                    ]++-- -----------------------------------------------------------------------------++-- | An individual style item.  Except for 'DD', the @['String']@+--   should be empty.+data StyleItem = SItem StyleName [Text]+               deriving (Eq, Ord, Show, Read)++instance PrintDot StyleItem where+  unqtDot (SItem nm args)+    | null args = dnm+    | otherwise = dnm <> parens args'+    where+      dnm = unqtDot nm+      args' = hcat . punctuate comma $ mapM unqtDot args++  toDot si@(SItem nm args)+    | null args = toDot nm+    | otherwise = dquotes $ unqtDot si++  unqtListToDot = hcat . punctuate comma . mapM unqtDot++  listToDot [SItem nm []] = toDot nm+  listToDot sis           = dquotes $ unqtListToDot sis++instance ParseDot StyleItem where+  parseUnqt = liftA2 SItem parseUnqt (tryParseList' parseArgs)++  parse = quotedParse (liftA2 SItem parseUnqt parseArgs)+          `onFail`+          fmap (`SItem` []) parse++  parseUnqtList = sepBy1 parseUnqt (wrapWhitespace parseComma)++  parseList = quotedParse parseUnqtList+              `onFail`+              -- Might not necessarily need to be quoted if a singleton...+              fmap return parse++parseArgs :: Parse [Text]+parseArgs = bracketSep (character '(')+                       parseComma+                       (character ')')+                       parseStyleName++data StyleName = Dashed    -- ^ Nodes and Edges+               | Dotted    -- ^ Nodes and Edges+               | Solid     -- ^ Nodes and Edges+               | Bold      -- ^ Nodes and Edges+               | Invisible -- ^ Nodes and Edges+               | Filled    -- ^ Nodes and Clusters+               | Striped   -- ^ Rectangularly-shaped Nodes and+                           --   Clusters; requires Graphviz >= 2.30.0+               | Wedged    -- ^ Elliptically-shaped Nodes only;+                           --   requires Graphviz >= 2.30.0+               | Diagonals -- ^ Nodes only+               | Rounded   -- ^ Nodes and Clusters+               | Tapered   -- ^ Edges only; requires Graphviz >=+                           --   2.29.0+               | Radial    -- ^ Nodes, Clusters and Graphs, for use+                           --   with 'GradientAngle'; requires+                           --   Graphviz >= 2.29.0+               | DD Text   -- ^ Device Dependent+               deriving (Eq, Ord, Show, Read)++instance PrintDot StyleName where+  unqtDot Dashed    = text "dashed"+  unqtDot Dotted    = text "dotted"+  unqtDot Solid     = text "solid"+  unqtDot Bold      = text "bold"+  unqtDot Invisible = text "invis"+  unqtDot Filled    = text "filled"+  unqtDot Striped   = text "striped"+  unqtDot Wedged    = text "wedged"+  unqtDot Diagonals = text "diagonals"+  unqtDot Rounded   = text "rounded"+  unqtDot Tapered   = text "tapered"+  unqtDot Radial    = text "radial"+  unqtDot (DD nm)   = unqtDot nm++  toDot (DD nm) = toDot nm+  toDot sn      = unqtDot sn++instance ParseDot StyleName where+  parseUnqt = checkDD <$> parseStyleName++  parse = quotedParse parseUnqt+          `onFail`+          fmap checkDD quotelessString++checkDD     :: Text -> StyleName+checkDD str = case T.toLower str of+                "dashed"    -> Dashed+                "dotted"    -> Dotted+                "solid"     -> Solid+                "bold"      -> Bold+                "invis"     -> Invisible+                "filled"    -> Filled+                "striped"   -> Striped+                "wedged"    -> Wedged+                "diagonals" -> Diagonals+                "rounded"   -> Rounded+                "tapered"   -> Tapered+                "radial"    -> Radial+                _           -> DD str++parseStyleName :: Parse Text+parseStyleName = liftA2 T.cons (orEscaped . noneOf $ ' ' : disallowedChars)+                               (parseEscaped True [] disallowedChars)+  where+    disallowedChars = [quoteChar, '(', ')', ',']+    -- Used because the first character has slightly stricter requirements than the rest.+    orSlash p = stringRep '\\' "\\\\" `onFail` p+    orEscaped = orQuote . orSlash++-- -----------------------------------------------------------------------------++data ViewPort = VP { wVal  :: Double+                   , hVal  :: Double+                   , zVal  :: Double+                   , focus :: Maybe FocusType+                   }+              deriving (Eq, Ord, Show, Read)++instance PrintDot ViewPort where+  unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)+               $ focus vp+    where+      vs = hcat . punctuate comma+           $ mapM (unqtDot . ($vp)) [wVal, hVal, zVal]++  toDot = dquotes . unqtDot++instance ParseDot ViewPort where+  parseUnqt = VP <$> parseUnqt+                 <*  parseComma+                 <*> parseUnqt+                 <*  parseComma+                 <*> parseUnqt+                 <*> optional (parseComma *> parseUnqt)++  parse = quotedParse parseUnqt++-- | For use with 'ViewPort'.+data FocusType = XY Point+               | NodeFocus Text+               deriving (Eq, Ord, Show, Read)++instance PrintDot FocusType where+  unqtDot (XY p)         = unqtDot p+  unqtDot (NodeFocus nm) = unqtDot nm++  toDot (XY p)         = toDot p+  toDot (NodeFocus nm) = toDot nm++instance ParseDot FocusType where+  parseUnqt = fmap XY parseUnqt+              `onFail`+              fmap NodeFocus parseUnqt++  parse = fmap XY parse+          `onFail`+          fmap NodeFocus parse++-- -----------------------------------------------------------------------------++data VerticalPlacement = VTop+                       | VCenter -- ^ Only valid for Nodes.+                       | VBottom+                       deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot VerticalPlacement where+  unqtDot VTop    = char 't'+  unqtDot VCenter = char 'c'+  unqtDot VBottom = char 'b'++instance ParseDot VerticalPlacement where+  parseUnqt = oneOf [ stringReps VTop    ["top", "t"]+                    , stringReps VCenter ["centre", "center", "c"]+                    , stringReps VBottom ["bottom", "b"]+                    ]++-- -----------------------------------------------------------------------------++-- | A list of search paths.+newtype Paths = Paths { paths :: [FilePath] }+    deriving (Eq, Ord, Show, Read)++instance PrintDot Paths where+    unqtDot = unqtDot . intercalate [searchPathSeparator] . paths++    toDot (Paths [p]) = toDot p+    toDot ps          = dquotes $ unqtDot ps++instance ParseDot Paths where+    parseUnqt = Paths . splitSearchPath <$> parseUnqt++    parse = quotedParse parseUnqt+            `onFail`+            fmap (Paths . (:[]) . T.unpack) quotelessString++-- -----------------------------------------------------------------------------++data ScaleType = UniformScale+               | NoScale+               | FillWidth+               | FillHeight+               | FillBoth+               deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ScaleType where+  unqtDot UniformScale = unqtDot True+  unqtDot NoScale      = unqtDot False+  unqtDot FillWidth    = text "width"+  unqtDot FillHeight   = text "height"+  unqtDot FillBoth     = text "both"++instance ParseDot ScaleType where+  parseUnqt = oneOf [ stringRep UniformScale "true"+                    , stringRep NoScale "false"+                    , stringRep FillWidth "width"+                    , stringRep FillHeight "height"+                    , stringRep FillBoth "both"+                    ]++-- -----------------------------------------------------------------------------++data Justification = JLeft+                   | JRight+                   | JCenter+                   deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Justification where+  unqtDot JLeft   = char 'l'+  unqtDot JRight  = char 'r'+  unqtDot JCenter = char 'c'++instance ParseDot Justification where+  parseUnqt = oneOf [ stringReps JLeft ["left", "l"]+                    , stringReps JRight ["right", "r"]+                    , stringReps JCenter ["center", "centre", "c"]+                    ]++-- -----------------------------------------------------------------------------++data Ratios = AspectRatio Double+            | FillRatio+            | CompressRatio+            | ExpandRatio+            | AutoRatio+            deriving (Eq, Ord, Show, Read)++instance PrintDot Ratios where+  unqtDot (AspectRatio r) = unqtDot r+  unqtDot FillRatio       = text "fill"+  unqtDot CompressRatio   = text "compress"+  unqtDot ExpandRatio     = text "expand"+  unqtDot AutoRatio       = text "auto"++  toDot (AspectRatio r) = toDot r+  toDot r               = unqtDot r++instance ParseDot Ratios where+  parseUnqt = parseRatio True++  parse = quotedParse parseUnqt <|> parseRatio False++parseRatio   :: Bool -> Parse Ratios+parseRatio q = oneOf [ AspectRatio <$> parseSignedFloat q+                     , stringRep FillRatio "fill"+                     , stringRep CompressRatio "compress"+                     , stringRep ExpandRatio "expand"+                     , stringRep AutoRatio "auto"+                     ]++-- -----------------------------------------------------------------------------++-- | A numeric type with an explicit separation between integers and+--   floating-point values.+data Number = Int Int+            | Dbl Double+            deriving (Eq, Ord, Show, Read)++instance PrintDot Number where+  unqtDot (Int i) = unqtDot i+  unqtDot (Dbl d) = unqtDot d++  toDot (Int i) = toDot i+  toDot (Dbl d) = toDot d++instance ParseDot Number where+  parseUnqt = parseNumber True++  parse = quotedParse parseUnqt+          <|>+          parseNumber False++parseNumber   :: Bool -> Parse Number+parseNumber q = Dbl <$> parseStrictFloat q+                <|>+                Int <$> parseUnqt++-- -----------------------------------------------------------------------------++-- | If set, normalizes coordinates such that the first point is at+--   the origin and the first edge is at the angle if specified.+data Normalized = IsNormalized -- ^ Equivalent to @'NormalizedAngle' 0@.+                | NotNormalized+                | NormalizedAngle Double -- ^ Angle of first edge when+                                         --   normalized.  Requires+                                         --   Graphviz >= 2.32.0.+                deriving (Eq, Ord, Show, Read)++instance PrintDot Normalized where+  unqtDot IsNormalized        = unqtDot True+  unqtDot NotNormalized       = unqtDot False+  unqtDot (NormalizedAngle a) = unqtDot a++  toDot (NormalizedAngle a) = toDot a+  toDot norm                = unqtDot norm++instance ParseDot Normalized where+  parseUnqt = parseNormalized True++  parse = quotedParse parseUnqt <|> parseNormalized False++parseNormalized :: Bool -> Parse Normalized+parseNormalized q = NormalizedAngle <$> parseSignedFloat q+                    <|>+                    bool NotNormalized IsNormalized <$> onlyBool++-- -----------------------------------------------------------------------------++-- | Determine how the 'Width' and 'Height' attributes specify the+--   size of nodes.+data NodeSize = GrowAsNeeded+                -- ^ Nodes will be the smallest width and height+                --   needed to contain the label and any possible+                --   image.  'Width' and 'Height' are the minimum+                --   allowed sizes.+              | SetNodeSize+                -- ^ 'Width' and 'Height' dictate the size of the node+                --   with a warning if the label cannot fit in this.+              | SetShapeSize+                -- ^ 'Width' and 'Height' dictate the size of the+                --   shape only and the label can expand out of the+                --   shape (with a warning).  Requires Graphviz >=+                --   2.38.0.+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot NodeSize where+  unqtDot GrowAsNeeded = unqtDot False+  unqtDot SetNodeSize  = unqtDot True+  unqtDot SetShapeSize = text "shape"++instance ParseDot NodeSize where+  parseUnqt = bool GrowAsNeeded SetNodeSize <$> parseUnqt+              <|>+              stringRep SetShapeSize "shape"++-- -----------------------------------------------------------------------------++{-++As of Graphviz 2.36.0 this was commented out; as such it might come+back, so leave this here in case we need it again.++data AspectType = RatioOnly Double+                | RatioPassCount Double Int+                deriving (Eq, Ord, Show, Read)++instance PrintDot AspectType where+  unqtDot (RatioOnly r)        = unqtDot r+  unqtDot (RatioPassCount r p) = commaDel r p++  toDot at@RatioOnly{}      = unqtDot at+  toDot at@RatioPassCount{} = dquotes $ unqtDot at++instance ParseDot AspectType where+  parseUnqt = fmap (uncurry RatioPassCount) commaSepUnqt+              `onFail`+              fmap RatioOnly parseUnqt+++  parse = quotedParse (uncurry RatioPassCount <$> commaSepUnqt)+          `onFail`+          fmap RatioOnly parse++-}
Data/GraphViz/Commands.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}  {- |    Module      : Data.GraphViz.Commands@@ -40,48 +40,35 @@     , runGraphvizCanvas     , runGraphvizCanvas'     , graphvizWithHandle+      -- * Testing if Graphviz is installed+    , isGraphvizInstalled+    , quitWithoutGraphviz     ) where --- Want to use the extensible-exception version-import Prelude hiding (catch)- import Data.GraphViz.Types -- This is here just for Haddock linking purposes.-import Data.GraphViz.Attributes.Complete(Attribute(Z))-import Data.GraphViz.Commands.IO(runCommand)+import Data.GraphViz.Commands.Available+import Data.GraphViz.Commands.IO        (runCommand) import Data.GraphViz.Exception -import qualified Data.ByteString as SB-import System.IO(Handle, hSetBinaryMode)-import Control.Monad(liftM)-import System.FilePath((<.>))+import           Control.Monad    (liftM, unless)+import qualified Data.ByteString  as SB+import           Data.Maybe       (isJust)+import           Data.Version     (Version (..), showVersion)+import           System.Directory (findExecutable)+import           System.Exit      (ExitCode (..), exitWith)+import           System.FilePath  ((<.>))+import           System.IO        (Handle, hPutStrLn, hSetBinaryMode, stderr)  -- ----------------------------------------------------------------------------- --- | The available Graphviz commands.  The following directions are---   based upon those in the Graphviz man page (available online at---   <http://graphviz.org/pdf/dot.1.pdf>, or if installed on your---   system @man graphviz@).  Note that any command can be used on---   both directed and undirected graphs.-data GraphvizCommand = Dot       -- ^ For hierachical graphs (ideal for-                                 --   directed graphs).-                     | Neato     -- ^ For symmetric layouts of graphs-                                 --   (ideal for undirected graphs).-                     | TwoPi     -- ^ For radial layout of graphs.-                     | Circo     -- ^ For circular layout of graphs.-                     | Fdp       -- ^ For symmetric layout of graphs.-                     | Osage     -- ^ Filter for drawing clustered graphs,-                                 --   requires Graphviz >= 2.28.0.-                     | Patchwork -- ^ Draw clustered graphs as treemaps,-                                 --   requires Graphviz >= 2.28.0.-                     deriving (Eq, Ord, Show, Read)- showCmd           :: GraphvizCommand -> String showCmd Dot       = "dot" showCmd Neato     = "neato" showCmd TwoPi     = "twopi" showCmd Circo     = "circo" showCmd Fdp       = "fdp"+showCmd Sfdp      = "sfdp" showCmd Osage     = "osage" showCmd Patchwork = "patchwork" @@ -128,9 +115,11 @@                                 --   layout performed.                     | DotOutput -- ^ Reproduces the input along with                                 --   layout information.-                    | XDot      -- ^ As with 'DotOutput', but provides-                                --   even more information on how the-                                --   graph is drawn.+                    | XDot (Maybe Version)+                      -- ^ As with 'DotOutput', but provides even more+                      --   information on how the graph is drawn.  The+                      --   optional 'Version' is the same as+                      --   specifying the @XDotVersion@ attribute.                     | Eps       -- ^ Encapsulated PostScript.                     | Fig       -- ^ FIG graphics language.                     | Gd        -- ^ Internal GD library format.@@ -163,19 +152,21 @@                                 --   usually preferred.                     | Vrml      -- ^ Virtual Reality Modeling Language                                 --   format; requires nodes to have a-                                --   'Z' attribute.+                                --   third dimension set via the @Pos@+                                --   attribute (and with a @Dim@ value+                                --   of at least @3@).                     | WBmp      -- ^ Wireless BitMap format;                                 --   monochrome format usually used                                 --   for mobile computing devices.                     | WebP      -- ^ Google's WebP format; requires                                 --   Graphviz >= 2.29.0.-                    deriving (Eq, Ord, Bounded, Enum, Show, Read)+                    deriving (Eq, Ord, Show, Read)  instance GraphvizResult GraphvizOutput where   outputCall Bmp       = "bmp"   outputCall Canon     = "canon"   outputCall DotOutput = "dot"-  outputCall XDot      = "xdot"+  outputCall (XDot mv) = "xdot" ++ maybe "" showVersion mv   outputCall Eps       = "eps"   outputCall Fig       = "fig"   outputCall Gd        = "gd"@@ -205,9 +196,9 @@ -- | A default file extension for each 'GraphvizOutput'. defaultExtension           :: GraphvizOutput -> String defaultExtension Bmp       = "bmp"-defaultExtension Canon     = "dot"-defaultExtension DotOutput = "dot"-defaultExtension XDot      = "dot"+defaultExtension Canon     = "gv"+defaultExtension DotOutput = "gv"+defaultExtension XDot{}    = "gv" defaultExtension Eps       = "eps" defaultExtension Fig       = "fig" defaultExtension Gd        = "gd"@@ -258,7 +249,7 @@                       -> GraphvizOutput -> FilePath                       -> IO FilePath runGraphvizCommand cmd gr t fp-  = mapException addExc $ graphvizWithHandle cmd gr t toFile+  = handle (throwIO . addExc) $ graphvizWithHandle cmd gr t toFile   where     addFl = (++) ("Unable to create " ++ fp ++ "\n")     toFile h = SB.hGetContents h >>= SB.writeFile fp >> return fp@@ -316,3 +307,17 @@ --   using the given canvas type. runGraphvizCanvas'   :: (PrintDotRepr dg n) => dg n -> GraphvizCanvas -> IO () runGraphvizCanvas' d = runGraphvizCanvas (commandFor d) d++-- -----------------------------------------------------------------------------++-- | Is the Graphviz suite of tools installed?  This is determined by+--   whether @dot@ is available in the @PATH@.+isGraphvizInstalled :: IO Bool+isGraphvizInstalled = liftM isJust . findExecutable $ showCmd Dot++-- | If Graphviz does not seem to be available, print the provided+--   error message and then exit fatally.+quitWithoutGraphviz     :: String -> IO ()+quitWithoutGraphviz err = do hasGraphviz <- isGraphvizInstalled+                             unless hasGraphviz+                               $ hPutStrLn stderr err >> exitWith (ExitFailure 1)
+ Data/GraphViz/Commands/Available.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK hide #-}+{- |+   Module      : Data.GraphViz.Commands.Available+   Description : Available command-line programs+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   These are the known programs that read in Dot graphs.++ -}+module Data.GraphViz.Commands.Available where++import Data.GraphViz.Parsing+import Data.GraphViz.Printing++-- -----------------------------------------------------------------------------++-- | The available Graphviz commands.  The following directions are+--   based upon those in the Graphviz man page (available online at+--   <http://graphviz.org/pdf/dot.1.pdf>, or if installed on your+--   system @man graphviz@).  Note that any command can be used on+--   both directed and undirected graphs.+--+--   When used with the 'Layout' attribute, it overrides any actual+--   command called on the dot graph.+data GraphvizCommand = Dot       -- ^ For hierachical graphs (ideal for+                                 --   directed graphs).+                     | Neato     -- ^ For symmetric layouts of graphs+                                 --   (ideal for undirected graphs).+                     | TwoPi     -- ^ For radial layout of graphs.+                     | Circo     -- ^ For circular layout of graphs.+                     | Fdp       -- ^ Spring-model approach for+                                 --   undirected graphs.+                     | Sfdp      -- ^ As with Fdp, but ideal for large+                                 --   graphs.+                     | Osage     -- ^ Filter for drawing clustered graphs,+                                 --   requires Graphviz >= 2.28.0.+                     | Patchwork -- ^ Draw clustered graphs as treemaps,+                                 --   requires Graphviz >= 2.28.0.+                     deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot GraphvizCommand where+  unqtDot Dot       = text "dot"+  unqtDot Neato     = text "neato"+  unqtDot TwoPi     = text "twopi"+  unqtDot Circo     = text "circo"+  unqtDot Fdp       = text "fdp"+  unqtDot Sfdp      = text "sfdp"+  unqtDot Osage     = text "osage"+  unqtDot Patchwork = text "patchwork"++instance ParseDot GraphvizCommand where+  parseUnqt = stringValue [ ("dot", Dot)+                          , ("neato", Neato)+                          , ("twopi", TwoPi)+                          , ("circo", Circo)+                          , ("fdp", Fdp)+                          , ("sfdp", Sfdp)+                          , ("osage", Osage)+                          , ("patchwork", Patchwork)+                          ]
Data/GraphViz/Commands/IO.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+ {- |    Module      : Data.GraphViz.Commands.IO    Description : IO-related functions for graphviz.@@ -26,35 +28,39 @@        , runCommand        ) where -import Data.GraphViz.State(initialState)-import Data.GraphViz.Types(PrintDotRepr, ParseDotRepr, printDotGraph, parseDotGraph)-import Data.GraphViz.Printing(toDot) import Data.GraphViz.Exception-import Text.PrettyPrint.Leijen.Text(displayT, renderCompact)+import Data.GraphViz.Printing       (runDotCode, toDot)+import Data.GraphViz.Types          (ParseDotRepr, PrintDotRepr, parseDotGraph,+                                     printDotGraph)+import Text.PrettyPrint.Leijen.Text (displayT, renderOneLine) -import qualified Data.Text.Lazy.Encoding as T-import Data.Text.Encoding.Error(UnicodeException)-import Data.Text.Lazy(Text)-import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as B-import Data.ByteString.Lazy(ByteString)-import Control.Monad(liftM)-import Control.Monad.Trans.State-import System.IO(Handle, IOMode(ReadMode,WriteMode)-                , withFile, stdout, stdin, hPutChar-                , hClose, hGetContents, hSetBinaryMode)-import System.Exit(ExitCode(ExitSuccess))-import System.Process(runInteractiveProcess, waitForProcess)-import Control.Exception(IOException, evaluate)-import Control.Concurrent(MVar, forkIO, newEmptyMVar, putMVar, takeMVar)+import           Control.Concurrent       (MVar, forkIO, newEmptyMVar, putMVar,+                                           takeMVar)+import           Control.Exception        (IOException, evaluate, finally)+import           Control.Monad            (liftM)+import qualified Data.ByteString          as SB+import           Data.ByteString.Lazy     (ByteString)+import qualified Data.ByteString.Lazy     as B+import           Data.Text.Encoding.Error (UnicodeException)+import           Data.Text.Lazy           (Text)+import qualified Data.Text.Lazy.Encoding  as T+import           System.Exit              (ExitCode(ExitSuccess))+import           System.FilePath          ((<.>))+import           System.IO                (Handle, IOMode(ReadMode, WriteMode),+                                           hClose, hGetContents, hPutChar,+                                           stdin, stdout, withFile)+import           System.IO.Temp           (withSystemTempFile)+import           System.Process           (runInteractiveProcess,+                                           waitForProcess) + -- -----------------------------------------------------------------------------  -- | Correctly render Graphviz output in a more machine-oriented form --   (i.e. more compact than the output of 'renderDot'). renderCompactDot :: (PrintDotRepr dg n) => dg n -> Text-renderCompactDot = displayT . renderCompact-                   . flip evalState initialState+renderCompactDot = displayT . renderOneLine+                   . runDotCode                    . toDot  -- -----------------------------------------------------------------------------@@ -95,8 +101,7 @@ hPutCompactDot :: (PrintDotRepr dg n) => Handle -> dg n -> IO () hPutCompactDot = toHandle renderCompactDot -toHandle        :: (PrintDotRepr dg n) => (dg n -> Text) -> Handle -> dg n-                   -> IO ()+toHandle        :: (dg n -> Text) -> Handle -> dg n -> IO () toHandle f h dg = do B.hPutStr h . T.encodeUtf8 $ f dg                      hPutChar h '\n' @@ -133,6 +138,10 @@ -- --   If the command was unsuccessful, then a 'GraphvizException' is --   thrown.+--+--   For performance reasons, a temporary file is used to store the+--   generated Dot code.  As such, this is only suitable for local+--   commands. runCommand :: (PrintDotRepr dg n)               => String           -- ^ Command to run               -> [String]         -- ^ Command-line arguments@@ -140,17 +149,16 @@               -> dg n               -> IO a runCommand cmd args hf dg-  = mapException notRunnable-    $ bracket-        (runInteractiveProcess cmd args Nothing Nothing)+  = handle (throwIO . notRunnable) $+    withSystemTempFile ("graphviz" <.> "gv") $ \dotFile dotHandle -> do+      finally (hPutCompactDot dotHandle dg) (hClose dotHandle)+      bracket+        (runInteractiveProcess cmd (args ++ [dotFile]) Nothing Nothing)         (\(inh,outh,errh,_) -> hClose inh >> hClose outh >> hClose errh)         $ \(inp,outp,errp,prc) -> do -          hSetBinaryMode inp True-          hSetBinaryMode errp False--          -- Make sure we close the input or it will hang!!!!!!!-          forkIO $ hPutCompactDot inp dg >> hClose inp+          -- Not using it, so close it off directly.+          hClose inp            -- Need to make sure both the output and error handles are           -- really fully consumed.@@ -181,7 +189,7 @@                     ]      -- Augmenting the hf function to let it work within the forkIO:-    hf' = mapException fErr . hf+    hf' = handle (throwIO . fErr) . hf     fErr :: IOException -> GraphvizException     fErr e = GVProgramExc $ "Error re-directing the output from "              ++ cmd ++ ": " ++ show e
Data/GraphViz/Exception.hs view
@@ -11,6 +11,7 @@          -- * Re-exported for convenience.        , mapException        , throw+       , throwIO        , handle        , bracket        ) where
+ Data/GraphViz/Internal/State.hs view
@@ -0,0 +1,134 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+   Module      : Data.GraphViz.Internal.State+   Description : Printing and parsing state.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   When printing and parsing Dot code, some items depend on values+   that are set earlier.+-}+module Data.GraphViz.Internal.State+       ( GraphvizStateM(..)+       , GraphvizState(..)+       , AttributeType(..)+       , setAttributeType+       , getAttributeType+       , initialState+       , setDirectedness+       , getDirectedness+       , setLayerSep+       , getLayerSep+       , setLayerListSep+       , getLayerListSep+       , setColorScheme+       , getColorScheme+       ) where++import Data.GraphViz.Attributes.ColorScheme++import Text.ParserCombinators.Poly.StateText (Parser, stQuery, stUpdate)++-- -----------------------------------------------------------------------------++class (Monad m) => GraphvizStateM m where+  modifyGS :: (GraphvizState -> GraphvizState) -> m ()++  getsGS :: (GraphvizState -> a) -> m a++instance GraphvizStateM (Parser GraphvizState) where+  modifyGS = stUpdate++  getsGS = stQuery++data AttributeType = GraphAttribute+                   | SubGraphAttribute+                   | ClusterAttribute+                   | NodeAttribute+                   | EdgeAttribute+                     deriving (Eq, Ord, Show, Read)++-- | Several aspects of Dot code are either global or mutable state.+data GraphvizState = GS { parseStrictly :: !Bool+                          -- ^ If 'False', allow fallbacks for+                          --   attributes that don't match known+                          --   specification when parsing.+                        , directedEdges :: !Bool+                        , layerSep      :: [Char]+                        , layerListSep  :: [Char]+                        , attributeType :: !AttributeType+                        , graphColor    :: !ColorScheme+                        , clusterColor  :: !ColorScheme+                        , nodeColor     :: !ColorScheme+                        , edgeColor     :: !ColorScheme+                        }+                   deriving (Eq, Ord, Show, Read)++initialState :: GraphvizState+initialState = GS { parseStrictly = True+                  , directedEdges = True+                  , layerSep      = defLayerSep+                  , layerListSep  = defLayerListSep+                  , attributeType = GraphAttribute+                  , graphColor    = X11+                  , clusterColor  = X11+                  , nodeColor     = X11+                  , edgeColor     = X11+                  }++setDirectedness   :: (GraphvizStateM m) => Bool -> m ()+setDirectedness d = modifyGS (\ gs -> gs { directedEdges = d } )++getDirectedness :: (GraphvizStateM m) => m Bool+getDirectedness = getsGS directedEdges++setAttributeType    :: (GraphvizStateM m) => AttributeType -> m ()+setAttributeType tp = modifyGS $ \ gs -> gs { attributeType = tp }++getAttributeType :: (GraphvizStateM m) => m AttributeType+getAttributeType = getsGS attributeType++setLayerSep     :: (GraphvizStateM m) => [Char] -> m ()+setLayerSep sep = modifyGS (\ gs -> gs { layerSep = sep } )++getLayerSep :: (GraphvizStateM m) => m [Char]+getLayerSep = getsGS layerSep++setLayerListSep     :: (GraphvizStateM m) => [Char] -> m ()+setLayerListSep sep = modifyGS (\ gs -> gs { layerListSep = sep } )++getLayerListSep :: (GraphvizStateM m) => m [Char]+getLayerListSep = getsGS layerListSep++setColorScheme    :: (GraphvizStateM m) => ColorScheme -> m ()+setColorScheme cs = do tp <- getsGS attributeType+                       modifyGS $ \gs -> case tp of+                                           GraphAttribute    -> gs { graphColor   = cs }+                                            -- subgraphs don't have specified scheme+                                           SubGraphAttribute -> gs { graphColor   = cs }+                                           ClusterAttribute  -> gs { clusterColor = cs }+                                           NodeAttribute     -> gs { nodeColor    = cs }+                                           EdgeAttribute     -> gs { edgeColor    = cs }++getColorScheme :: (GraphvizStateM m) => m ColorScheme+getColorScheme = do tp <- getsGS attributeType+                    getsGS $ case tp of+                               GraphAttribute    -> graphColor+                                -- subgraphs don't have specified scheme+                               SubGraphAttribute -> graphColor+                               ClusterAttribute  -> clusterColor+                               NodeAttribute     -> nodeColor+                               EdgeAttribute     -> edgeColor++-- | The default separators for+--   'Data.GraphViz.Attributes.Complete.LayerSep'.+defLayerSep :: [Char]+defLayerSep = [' ', ':', '\t']++-- | The default separators for+--   'Data.GraphViz.Attributes.Complete.LayerListSep'.+defLayerListSep :: [Char]+defLayerListSep = [',']
+ Data/GraphViz/Internal/Util.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE CPP, OverloadedStrings, PatternGuards #-}+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Internal.Util+   Description : Internal utility functions+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines internal utility functions.+-}+module Data.GraphViz.Internal.Util where++import Data.Char (isAsciiLower, isAsciiUpper, isDigit, ord)++import           Control.Monad       (liftM2)+import           Data.Function       (on)+import           Data.List           (groupBy, sortBy)+import           Data.Maybe          (isJust)+import           Data.Set            (Set)+import qualified Data.Set            as Set+import           Data.Text.Lazy      (Text)+import qualified Data.Text.Lazy      as T+import qualified Data.Text.Lazy.Read as T++#if MIN_VERSION_base(4,8,0)+import Data.Version (Version, makeVersion)+#else+import Data.Version (Version(..))+#endif++-- -----------------------------------------------------------------------------++isIDString :: Text -> Bool+isIDString = maybe False (\(f,os) -> frstIDString f && T.all restIDString os)+             . T.uncons++-- | First character of a non-quoted 'String' must match this.+frstIDString   :: Char -> Bool+frstIDString c = any ($c) [ isAsciiUpper+                          , isAsciiLower+                          , (==) '_'+                          , (\ x -> ord x >= 128)+                          ]++-- | The rest of a non-quoted 'String' must match this.+restIDString   :: Char -> Bool+restIDString c = frstIDString c || isDigit c++-- | Determine if this String represents a number.  Boolean parameter+--   determines if exponents are considered part of numbers for this.+isNumString     :: Bool -> Text -> Bool+isNumString _      ""  = False+isNumString _      "-" = False+isNumString allowE str = case T.uncons $ T.toLower str of+                           Just ('-',str') -> go str'+                           _               -> go str+  where+    -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all+    -- possible cases+    go s = uncurry go' $ T.span isDigit s+    go' ds nds+      | T.null nds = True+      | T.null ds && nds == "." = False+      | T.null ds+      , Just ('.',nds') <- T.uncons nds+      , Just (d,nds'') <- T.uncons nds' = isDigit d && checkEs' nds''+      | Just ('.',nds') <- T.uncons nds = checkEs $ T.dropWhile isDigit nds'+      | T.null ds = False+      | otherwise = checkEs nds+    checkEs' s = case T.break ('e' ==) s of+                   ("", _) -> False+                   (ds,es) -> T.all isDigit ds && checkEs es+    checkEs str' = case T.uncons str' of+                     Nothing       -> True+                     Just ('e',ds) -> allowE && isIntString ds+                     _             -> False++{-+-- | This assumes that 'isNumString' is 'True'.+toDouble     :: Text -> Double+toDouble str = case T.uncons $ T.toLower str of+                 Just ('-', str') -> toD $ '-' `T.cons` adj str'+                 _                -> toD $ adj str+  where+    adj s = T.cons '0'+            $ case T.span ('.' ==) s of+                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'+                (ds, ds') | Just ('.',es) <- T.uncons ds'+                          , Just ('e',es') <- T.uncons es+                            -> ds `T.snoc` '.' `T.snoc` '0'+                                   `T.snoc` 'e' `T.snoc` '0' `T.append` es'+                _         -> s+    toD = either (const $ error "Not a Double") fst . T.signed T.double+-}+-- | This assumes that 'isNumString' is 'True'.+toDouble     :: Text -> Double+toDouble str = case T.uncons $ T.toLower str of+                 Just ('-', str') -> toD $ '-' `T.cons` adj str'+                 _                -> toD $ adj str+  where+    adj s = T.cons '0'+            $ case T.span ('.' ==) s of+                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'+                (ds, ds') | Just ('.',es) <- T.uncons ds'+                          , Just ('e',_) <- T.uncons es+                            -> ds `T.snoc` '.' `T.snoc` '0' `T.append` es+                _              -> s+    toD = read . T.unpack++isIntString :: Text -> Bool+isIntString = isJust . stringToInt++-- | Determine if this String represents an integer.+stringToInt     :: Text -> Maybe Int+stringToInt str = case T.signed T.decimal str of+                       Right (n, "") -> Just n+                       _             -> Nothing++-- | Graphviz requires double quotes to be explicitly escaped.+escapeQuotes           :: String -> String+escapeQuotes []        = []+escapeQuotes ('"':str) = '\\':'"': escapeQuotes str+escapeQuotes (c:str)   = c : escapeQuotes str++-- | Remove explicit escaping of double quotes.+descapeQuotes                :: String -> String+descapeQuotes []             = []+descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str+descapeQuotes (c:str)        = c : descapeQuotes str++isKeyword :: Text -> Bool+isKeyword = (`Set.member` keywords) . T.toLower++-- | The following are Dot keywords and are not valid as labels, etc. unquoted.+keywords :: Set Text+keywords = Set.fromList [ "node"+                        , "edge"+                        , "graph"+                        , "digraph"+                        , "subgraph"+                        , "strict"+                        ]++createVersion :: [Int] -> Version+#if MIN_VERSION_base(4,8,0)+createVersion = makeVersion+#else+createVersion bs = Version { versionBranch = bs, versionTags = []}+#endif++-- -----------------------------------------------------------------------------++uniq :: (Ord a) => [a] -> [a]+uniq = uniqBy id++uniqBy   :: (Ord b) => (a -> b) -> [a] -> [a]+uniqBy f = map head . groupSortBy f++groupSortBy   :: (Ord b) => (a -> b) -> [a] -> [[a]]+groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)++groupSortCollectBy     :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]+groupSortCollectBy f g = map (liftM2 (,) (f . head) (map g)) . groupSortBy f++-- | Fold over 'Bool's; first param is for 'False', second for 'True'.+bool       :: a -> a -> Bool -> a+bool f t b = if b+             then t+             else f++isSingle     :: [a] -> Bool+isSingle [_] = True+isSingle _   = False
Data/GraphViz/Parsing.hs view
@@ -30,9 +30,12 @@     , parseIt'     , runParser     , runParser'+    , runParserWith+    , parseLiberally     , checkValidParse+    , checkValidParseWithRest       -- * Convenience parsing combinators.-    , bracket+    , ignoreSep     , onlyBool     , quotelessString     , stringBlock@@ -46,6 +49,7 @@     , strings     , character     , parseStrictFloat+    , parseSignedFloat     , noneOf     , whitespace1     , whitespace@@ -62,12 +66,6 @@     , tryParseList     , tryParseList'     , consumeLine-    , parseField-    , parseFields-    , parseFieldBool-    , parseFieldsBool-    , parseFieldDef-    , parseFieldsDef     , commaSep     , commaSepUnqt     , commaSep'@@ -80,31 +78,33 @@     , parseColorScheme     ) where -import Data.GraphViz.Util-import Data.GraphViz.State+import Data.GraphViz.Exception      (GraphvizException(NotDotCode), throw)+import Data.GraphViz.Internal.State+import Data.GraphViz.Internal.Util+ -- To avoid orphan instances and cyclic imports import Data.GraphViz.Attributes.ColorScheme-import Data.GraphViz.Exception(GraphvizException(NotDotCode), throw) -import Text.ParserCombinators.Poly.StateText hiding (bracket, empty, indent, runParser)+import           Text.ParserCombinators.Poly.StateText hiding (empty, indent,+                                                        runParser) import qualified Text.ParserCombinators.Poly.StateText as P-import Data.Char( isDigit-                , isSpace-                , isLower-                , toLower-                , toUpper-                )-import Data.List(groupBy, sortBy)-import Data.Function(on)-import Data.Maybe(fromMaybe, isNothing, listToMaybe)-import Data.Ratio((%))-import qualified Data.Set as Set-import qualified Data.Text.Lazy as T++import           Control.Arrow       (first, second)+import           Control.Monad       (when)+import           Data.Char           (isDigit, isLower, isSpace, toLower,+                                      toUpper)+import           Data.Function       (on)+import           Data.List           (groupBy, sortBy)+import           Data.Maybe          (fromMaybe, isJust, isNothing, listToMaybe,+                                      maybeToList)+import           Data.Ratio          ((%))+import qualified Data.Set            as Set+import qualified Data.Text           as ST+import           Data.Text.Lazy      (Text)+import qualified Data.Text.Lazy      as T import qualified Data.Text.Lazy.Read as T-import Data.Text.Lazy(Text)-import Data.Word(Word8, Word16)-import Control.Arrow(first, second)-import Control.Monad(liftM, liftM2, when)+import           Data.Version        (Version(..))+import           Data.Word           (Word16, Word8)  -- ----------------------------------------------------------------------------- -- Based off code from Text.Parse in the polyparse library@@ -112,17 +112,24 @@ -- | A @ReadS@-like type alias. type Parse a = Parser GraphvizState a -runParser     :: Parse a -> Text -> (Either String a, Text)-runParser p t = let (r,_,t') = P.runParser p initialState t-                in (r,t')+runParser :: Parse a -> Text -> (Either String a, Text)+runParser = runParserWith id +parseLiberally    :: GraphvizState -> GraphvizState+parseLiberally gs = gs { parseStrictly = False }++runParserWith     :: (GraphvizState -> GraphvizState) -> Parse a -> Text+                     -> (Either String a, Text)+runParserWith f p t = let (r,_,t') = P.runParser p (f initialState) t+                      in (r,t')+ -- | A variant of 'runParser' where it is assumed that the provided --   parsing function consumes all of the 'Text' input (with the --   exception of whitespace at the end). runParser'   :: Parse a -> Text -> a-runParser' p = checkValidParse . fst . runParser p'+runParser' p = checkValidParseWithRest . runParser p'   where-    p' = p `discard` (whitespace >> eof)+    p' = p `discard` (whitespace *> eof)  class ParseDot a where   parseUnqt :: Parse a@@ -136,14 +143,14 @@                                `onFail`                                whitespace1                              )-                             (whitespace >> character ']')+                             (whitespace *> character ']')                              parseUnqt    parseList :: Parse [a]   parseList = quotedParse parseUnqtList  -- | Parse the required value, returning also the rest of the input---   'String' that hasn't been parsed (for debugging purposes).+--   'Text' that hasn't been parsed (for debugging purposes). parseIt :: (ParseDot a) => Text -> (a, Text) parseIt = first checkValidParse . runParser parse @@ -153,13 +160,22 @@ checkValidParse (Left err) = throw (NotDotCode err) checkValidParse (Right a)  = a +-- | If unable to parse /Dot/ code properly, 'throw' a+--   'GraphvizException', with the error containing the remaining+--   unparsed code..+checkValidParseWithRest :: (Either String a, Text) -> a+checkValidParseWithRest (Left err, rst) = throw (NotDotCode err')+  where+    err' = err ++ "\n\nRemaining input:\n\t" ++ show rst+checkValidParseWithRest (Right a,_)     = a+ -- | Parse the required value with the assumption that it will parse---   all of the input 'String'.+--   all of the input 'Text'. parseIt' :: (ParseDot a) => Text -> a parseIt' = runParser' parse  instance ParseDot Int where-  parseUnqt = parseInt'+  parseUnqt = parseSignedInt  instance ParseDot Integer where   parseUnqt = parseSigned parseInt@@ -171,18 +187,21 @@   parseUnqt = parseInt  instance ParseDot Double where-  parseUnqt = parseFloat'+  parseUnqt = parseSignedFloat True +  parse = quotedParse parseUnqt+          <|> parseSignedFloat False+   parseUnqtList = sepBy1 parseUnqt (character ':')    parseList = quotedParse parseUnqtList               `onFail`-              liftM return parse+              fmap (:[]) parse  instance ParseDot Bool where   parseUnqt = onlyBool               `onFail`-              liftM (zero /=) parseInt'+              fmap (zero /=) parseSignedInt     where       zero :: Int       zero = 0@@ -201,10 +220,24 @@           `onFail`           quotedParse parseUnqt -  parseUnqtList = liftM T.unpack parseUnqt+  parseUnqtList = T.unpack <$> parseUnqt -  parseList = liftM T.unpack parse+  parseList = T.unpack <$> parse +-- | Ignores 'versionTags' and assumes 'not . null . versionBranch'+--   (usually you want 'length . versionBranch == 2') and that all+--   such values are non-negative.+instance ParseDot Version where+  parseUnqt = createVersion <$> sepBy1 (parseIntCheck False) (character '.')++  parse = quotedParse parseUnqt+          <|>+          (createVersion .) . (. maybeToList) . (:)+             <$> (parseIntCheck False) <*> optional (character '.' *> parseInt)+             -- Leave the last one to check for possible decimals+             -- afterwards as there should be at most two version+             -- numbers here.+ instance ParseDot Text where   -- Too many problems with using this within other parsers where   -- using numString or stringBlock will cause a parse failure.  As@@ -217,97 +250,100 @@           -- above.           quotedParse quotedString +instance ParseDot ST.Text where+  parseUnqt = T.toStrict <$> parseUnqt++  parse = T.toStrict <$> parse+ instance (ParseDot a) => ParseDot [a] where   parseUnqt = parseUnqtList    parse = parseList --- | Parse a 'String' that doesn't need to be quoted.+-- | Parse a 'Text' that doesn't need to be quoted. quotelessString :: Parse Text-quotelessString = numString `onFail` stringBlock+quotelessString = numString False `onFail` stringBlock -numString :: Parse Text-numString = liftM tShow parseStrictFloat-            `onFail`-            liftM tShow parseInt'+numString :: Bool -> Parse Text+numString q = fmap tShow (parseStrictFloat q)+              `onFail`+              fmap tShow parseSignedInt   where     tShow :: (Show a) => a -> Text     tShow = T.pack . show  stringBlock :: Parse Text-stringBlock = do frst <- satisfy frstIDString-                 rest <- manySatisfy restIDString-                 return $ frst `T.cons` rest+stringBlock = liftA2 T.cons (satisfy frstIDString) (manySatisfy restIDString)  -- | Used when quotes are explicitly required; quotedString :: Parse Text quotedString = parseEscaped True [] []  parseSigned :: (Num a) => Parse a -> Parse a-parseSigned p = (character '-' >> liftM negate p)+parseSigned p = (character '-' *> fmap negate p)                 `onFail`                 p  parseInt :: (Integral a) => Parse a-parseInt = do cs <- many1Satisfy isDigit-              case T.decimal cs of-                Right (n,"")  -> return n-                Right (_,txt) -> fail $ "Trailing digits not parsed as Integral: " ++ T.unpack txt-                Left err      -> fail $ "Could not read Integral: " ++ err-           `adjustErr` ("Expected one or more digits\n\t"++)+parseInt = parseIntCheck True -parseInt' :: Parse Int-parseInt' = parseSigned parseInt+-- | Flag indicates whether to check whether the number is actually a+--   floating-point value.+parseIntCheck    :: (Integral a) => Bool -> Parse a+parseIntCheck ch = do cs <- many1Satisfy isDigit+                            `adjustErr` ("Expected one or more digits\n\t"++)+                      case T.decimal cs of+                        Right (n,"")  -> bool return checkInt ch n+                        -- This case should never actually happen...+                        Right (_,txt) -> fail $ "Trailing digits not parsed as Integral: " ++ T.unpack txt+                        Left err      -> fail $ "Could not read Integral: " ++ err+  where+    checkInt n = do c <- optional $ oneOf [ character '.', character 'e' ]+                    if isJust c+                      then fail "This number is actually Floating, not Integral!"+                      else return n +parseSignedInt :: Parse Int+parseSignedInt = parseSigned parseInt+ -- | Parse a floating point number that actually contains decimals.-parseStrictFloat :: Parse Double-parseStrictFloat = parseSigned parseFloat+--   Bool flag indicates whether values that need to be quoted are+--   parsed.+parseStrictFloat :: Bool -> Parse Double+parseStrictFloat = parseSigned . parseFloat -parseFloat :: (RealFrac a) => Parse a-parseFloat = do ds   <- manySatisfy isDigit-                frac <- optional-                        $ do character '.'-                             manySatisfy isDigit-                when (T.null ds && noDec frac)-                  (fail "No actual digits in floating point number!")-                expn  <- optional parseExp-                when (isNothing frac && isNothing expn)-                  (fail "This is an integer, not a floating point number!")-                let frac' = fromMaybe "" frac-                    expn' = fromMaybe 0 expn-                ( return . fromRational . (* (10^^(expn' - fromIntegral (T.length frac'))))-                  . (%1) . runParser' parseInt) (ds `T.append` frac')-             `onFail`-             fail "Expected a floating point number"+-- | Bool flag indicates whether to allow parsing exponentiated term,+-- as this is only allowed when quoted.+parseFloat :: (RealFrac a) => Bool -> Parse a+parseFloat q = do ds   <- manySatisfy isDigit+                  frac <- optional $ character '.' *> manySatisfy isDigit+                  when (T.null ds && noDec frac)+                    (fail "No actual digits in floating point number!")+                  expn  <- bool (pure Nothing) (optional parseExp) q+                  when (isNothing frac && isNothing expn)+                    (fail "This is an integer, not a floating point number!")+                  let frac' = fromMaybe "" frac+                      expn' = fromMaybe 0 expn+                  ( return . fromRational . (* (10^^(expn' - fromIntegral (T.length frac'))))+                    . (%1) . runParser' parseInt) (ds `T.append` frac')+               `onFail`+               fail "Expected a floating point number"   where-    parseExp = do character 'e'-                  ((character '+' >> parseInt)+    parseExp = character 'e'+               *> ((character '+' *> parseInt)                    `onFail`-                   parseInt')+                   parseSignedInt)     noDec = maybe True T.null -parseFloat' :: Parse Double-parseFloat' = parseSigned ( parseFloat-                            `onFail`-                            liftM fI parseInt-                          )+-- Bool indicates whether we can parse values that need quotes.+parseSignedFloat :: Bool -> Parse Double+parseSignedFloat q = parseSigned ( parseFloat q <|> fmap fI parseInt )   where     fI :: Integer -> Double     fI = fromIntegral  -- ----------------------------------------------------------------------------- --- | Parse a bracketed item, discarding the brackets.------   The definition of @bracket@ defined in Polyparse uses---   'adjustErrBad' and thus doesn't allow backtracking and trying the---   next possible parser.  This is a version of @bracket@ that does.-bracket               :: Parse bra -> Parse ket -> Parse a -> Parse a-bracket open close pa = do open `adjustErr` ("Missing opening bracket:\n\t"++)-                           pa `discard`-                             (close-                              `adjustErr` ("Missing closing bracket:\n\t"++))- parseAndSpace   :: Parse a -> Parse a parseAndSpace p = p `discard` whitespace @@ -318,7 +354,7 @@ stringRep v = stringReps v . return  stringReps      :: a -> [String] -> Parse a-stringReps v ss = oneOf (map string ss) >> return v+stringReps v ss = oneOf (map string ss) *> return v  stringParse :: [(String, Parse a)] -> Parse a stringParse = toPM . sortBy (flip compare `on` fst)@@ -326,8 +362,8 @@     toPM = oneOf . map mkPM . groupBy ((==) `on` (listToMaybe . fst))      mkPM [("",p)] = p-    mkPM [(str,p)] = string str >> p-    mkPM kv = character (head . fst $ head kv) >> toPM (map (first tail) kv)+    mkPM [(str,p)] = string str *> p+    mkPM kv = character (head . fst $ head kv) *> toPM (map (first tail) kv)  stringValue :: [(String, a)] -> Parse a stringValue = stringParse . map (second return)@@ -335,6 +371,8 @@ strings :: [String] -> Parse () strings = oneOf . map string +-- | Assumes that any letter is ASCII for case-insensitive+--   comparisons. character   :: Char -> Parse Char character c = satisfy parseC               `adjustErr`@@ -350,13 +388,13 @@  -- | Parses at least one whitespace character. whitespace1 :: Parse ()-whitespace1 = many1Satisfy isSpace >> return ()+whitespace1 = many1Satisfy isSpace *> return ()  -- | Parses zero or more whitespace characters. whitespace :: Parse ()-whitespace = manySatisfy isSpace >> return ()+whitespace = manySatisfy isSpace *> return () --- | Parse and discard optional whitespace.+-- | Parse and discard optional surrounding whitespace. wrapWhitespace :: Parse a -> Parse a wrapWhitespace = bracket whitespace whitespace @@ -371,8 +409,8 @@ quotedParse :: Parse a -> Parse a quotedParse = bracket parseQuote parseQuote -parseQuote :: Parse Char-parseQuote = character quoteChar+parseQuote :: Parse ()+parseQuote = character quoteChar *> return ()  orQuote   :: Parse Char -> Parse Char orQuote p = stringRep quoteChar "\\\""@@ -382,13 +420,12 @@ quoteChar :: Char quoteChar = '"' --- | Parse a 'String' where the provided 'Char's (as well as @\"@ and+-- | Parse a 'Text' where the provided 'Char's (as well as @\"@ and --   @\\@) are escaped and the second list of 'Char's are those that --   are not permitted.  Note: does not parse surrounding quotes.  The---   'Bool' value indicates whether empty 'String's are allowed or---   not.+--   'Bool' value indicates whether empty 'Text's are allowed or not. parseEscaped             :: Bool -> [Char] -> [Char] -> Parse Text-parseEscaped empt cs bnd = liftM T.pack . lots $ qPrs `onFail` oth+parseEscaped empt cs bnd = fmap T.pack . lots $ qPrs `onFail` oth   where     lots = if empt then many else many1     cs' = quoteChar : slash : cs@@ -396,9 +433,10 @@     bndSet = Set.fromList bnd `Set.union` csSet     slash = '\\'     -- Have to allow standard slashes-    qPrs = do character slash-              mE <- optional $ oneOf (map character cs')-              return $ fromMaybe slash mE+    qPrs = fromMaybe slash+           <$> (character slash+                *> optional (oneOf $ map character cs')+               )     oth = satisfy (`Set.notMember` bndSet)  -- | Parses a newline.@@ -409,7 +447,7 @@ --   non-whitespace is reached.  The whitespace on that line is --   not consumed. newline' :: Parse ()-newline' = many (whitespace >> newline) >> return ()+newline' = many (whitespace *> newline) *> return ()  -- | Parses and returns all characters up till the end of the line, --   but does not touch the newline characters.@@ -417,34 +455,11 @@ consumeLine = manySatisfy (`notElem` ['\n','\r'])  parseEq :: Parse ()-parseEq = wrapWhitespace (character '=') >> return ()--parseField       :: (ParseDot a) => (a -> b) -> String -> [(String, Parse b)]-parseField c fld = [(fld, parseEq >> liftM c parse)]--parseFields   :: (ParseDot a) => (a -> b) -> [String] -> [(String, Parse b)]-parseFields c = concatMap (parseField c)--parseFieldBool :: (Bool -> b) -> String -> [(String, Parse b)]-parseFieldBool = flip parseFieldDef True--parseFieldsBool   :: (Bool -> b) -> [String] -> [(String, Parse b)]-parseFieldsBool c = concatMap (parseFieldBool c)---- | For 'Bool'-like data structures where the presence of the field---   name without a value implies a default value.-parseFieldDef         :: (ParseDot a) => (a -> b) -> a -> String -> [(String, Parse b)]-parseFieldDef c d fld = [(fld, p)]-  where-    p = (parseEq >> liftM c parse)-        `onFail`-        do nxt <- optional $ satisfy restIDString-           bool (fail "Not actually the field you were after")-                (return $ c d)-                (isNothing nxt)+parseEq = wrapWhitespace (character '=') *> return () -parseFieldsDef     :: (ParseDot a) => (a -> b) -> a -> [String] -> [(String, Parse b)]-parseFieldsDef c d = concatMap (parseFieldDef c d)+-- | The opposite of 'bracket'.+ignoreSep :: (a -> b -> c) -> Parse a -> Parse sep -> Parse b -> Parse c+ignoreSep f pa sep pb = f <$> pa <* sep <*> pb  commaSep :: (ParseDot a, ParseDot b) => Parse (a, b) commaSep = commaSep' parse parse@@ -453,19 +468,19 @@ commaSepUnqt = commaSep' parseUnqt parseUnqt  commaSep'       :: Parse a -> Parse b -> Parse (a,b)-commaSep' pa pb = do a <- pa-                     wrapWhitespace parseComma-                     b <- pb-                     return (a,b)+commaSep' pa pb = ignoreSep (,) pa (wrapWhitespace parseComma) pb  parseComma :: Parse ()-parseComma = character ',' >> return ()+parseComma = character ',' *> return () +-- | Try to parse a list of the specified type; returns an empty list+--   if parsing fails. tryParseList :: (ParseDot a) => Parse [a] tryParseList = tryParseList' parse +-- | Return an empty list if parsing a list fails. tryParseList' :: Parse [a] -> Parse [a]-tryParseList' = liftM (fromMaybe []) . optional+tryParseList' = fmap (fromMaybe []) . optional  parseAngled :: Parse a -> Parse a parseAngled = bracket (character '<') (character '>')@@ -482,13 +497,13 @@ parseColorScheme     :: Bool -> Parse ColorScheme parseColorScheme scs = do cs <- oneOf [ stringRep X11 "X11"                                       , stringRep SVG "svg"-                                      , liftM Brewer parseUnqt+                                      , Brewer <$> parseUnqt                                       ]                           when scs $ setColorScheme cs                           return cs  instance ParseDot BrewerScheme where-  parseUnqt = liftM2 BScheme parseUnqt parseUnqt+  parseUnqt = liftA2 BScheme parseUnqt parseUnqt  instance ParseDot BrewerName where   -- The order is different from above to make sure longer names are
Data/GraphViz/PreProcessing.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {- |    Module      : Data.GraphViz.PreProcessing    Description : Pre-process imported Dot code.@@ -9,28 +11,30 @@    parseable by this library.  This module defines the 'preProcess'    function to remove these components, which include: -     * Comments (both @\/* ... *\/@ style and @\/\/ ... @ style);+     * Comments (both @\/\* ... *\/@ style and @\/\/ ... @ style);       * Pre-processor lines (lines starting with a @#@);       * Split lines (by inserting a @\\@ the rest of that \"line\" is        continued on the next line). -     * 'Text's concatenated together using @\"...\" + \"...\"@; these-       are concatenated into one big 'Text'.+     * Strings concatenated together using @\"...\" + \"...\"@; these+       are concatenated into one big string. -} module Data.GraphViz.PreProcessing(preProcess) where +import Data.GraphViz.Exception (GraphvizException (NotDotCode), throw) import Data.GraphViz.Parsing-import Data.GraphViz.Exception(GraphvizException(NotDotCode), throw) -import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)+import           Data.Text.Lazy         (Text)+import qualified Data.Text.Lazy         as T+import           Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as B-import Data.Text.Lazy.Builder(Builder)-import Data.Monoid(Monoid(..), mconcat)-import Control.Monad(liftM) +#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid (Monoid (..), mconcat)+#endif+ -- ----------------------------------------------------------------------------- -- Filtering out unwanted Dot items such as comments @@ -46,7 +50,7 @@ --   lines only over a single line.  Should parse the /entire/ input --   'Text'. parseOutUnwanted :: Parse Builder-parseOutUnwanted = liftM mconcat (many getNext)+parseOutUnwanted = mconcat <$> many getNext   where     getNext = parseOK               `onFail`@@ -56,10 +60,11 @@               `onFail`               parseUnwanted               `onFail`-              liftM B.singleton next-    parseOK = liftM B.fromLazyText-              $ many1Satisfy (`notElem` ['\n', '\r', '\\', '/', '"', '<'])+              fmap B.singleton next +    parseOK = B.fromLazyText+              <$> many1Satisfy (`notElem` ['\n', '\r', '\\', '/', '"', '<'])+ -- | Parses an unwanted part of the Dot code (comments and --   pre-processor lines; also un-splits lines). parseUnwanted :: (Monoid m) => Parse m@@ -74,65 +79,58 @@ --   previous line, but will leave the one from the pre-processor line --   there (so in the end it just removes the line). parsePreProcessor :: (Monoid m) => Parse m-parsePreProcessor = do newline-                       character '#'-                       consumeLine-                       return mempty+parsePreProcessor = newline *> character '#' *> consumeLine *> pure mempty  -- | Parse @//@-style comments. parseLineComment :: (Monoid m) => Parse m-parseLineComment = do string "//"-                      -- Note: do /not/ consume the newlines, as they're-                      -- needed in case the next line is a pre-processor-                      -- line.-                      consumeLine-                      return mempty+parseLineComment = string "//"+                   -- Note: do /not/ consume the newlines, as they're+                   -- needed in case the next line is a pre-processor+                   -- line.+                   *> consumeLine+                   *> pure mempty  -- | Parse @/* ... */@-style comments. parseMultiLineComment :: (Monoid m) => Parse m-parseMultiLineComment = bracket start end (many inner)-                        >> return mempty+parseMultiLineComment = bracket start end (many inner) *> pure mempty   where     start = string "/*"     end = string "*/"-    inner = (many1Satisfy ('*' /=) >> return ())+    inner = (many1Satisfy ('*' /=) *> pure ())             `onFail`-            do character '*'-               satisfy ('/' /=)-               inner+            (character '*' *> satisfy ('/' /=) *> inner)  parseConcatStrings :: Parse Builder-parseConcatStrings = liftM (wrapQuotes . mconcat)-                     $ sepBy1 parseString parseConcat+parseConcatStrings = wrapQuotes . mconcat <$> sepBy1 parseString parseConcat   where     qParse = bracket (character '"') (commit $ character '"')-    parseString = qParse (liftM mconcat $ many parseInner)-    parseInner = (string "\\\"" >> return (B.fromLazyText $ T.pack "\\\""))+    parseString = qParse (mconcat <$> many parseInner)+    parseInner = (string "\\\"" *> pure (B.fromLazyText $ T.pack "\\\""))                  `onFail`                  -- Need to parse an explicit `\', in case it ends the                  -- string (and thus the next step would get parsed by the                  -- previous option).-                 (string "\\\\" >> return (B.fromLazyText $ T.pack "\\\\"))+                 (string "\\\\" *> pure (B.fromLazyText $ T.pack "\\\\"))                  `onFail`                  parseSplitLine -- in case there's a split mid-quote                  `onFail`-                 liftM B.singleton (satisfy (quoteChar /=))-    parseConcat = parseSep >> character '+' >> parseSep+                 fmap B.singleton (satisfy (quoteChar /=))+    parseConcat = parseSep *> character '+' *> parseSep     parseSep = many $ whitespace1 `onFail` parseUnwanted     wrapQuotes str = qc `mappend` str `mappend` qc     qc = B.singleton '"'  -- | Lines can be split with a @\\@ at the end of the line. parseSplitLine :: (Monoid m) => Parse m-parseSplitLine = character '\\' >> newline >> return mempty+parseSplitLine = character '\\' *> newline *> pure mempty  parseHTML :: Parse Builder-parseHTML = liftM (addAngled . mconcat)+parseHTML = fmap (addAngled . mconcat)             . parseAngled $ many inner   where     inner = parseHTML             `onFail`-            (liftM B.fromLazyText $ many1Satisfy (\c -> c /= open && c /= close))+            (B.fromLazyText <$> many1Satisfy (\c -> c /= open && c /= close))     addAngled str = B.singleton open `mappend` str `mappend` B.singleton close     open = '<'     close = '>'
Data/GraphViz/Printing.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving,+             OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  {- |    Module      : Data.GraphViz.Printing@@ -47,7 +49,9 @@ module Data.GraphViz.Printing     ( module Text.PrettyPrint.Leijen.Text.Monadic     , DotCode-    , renderDot -- Exported for Data.GraphViz.Types.printSGID+    , DotCodeM+    , runDotCode+    , renderDot -- Exported for Data.GraphViz.Types.Internal.Common.printSGID     , PrintDot(..)     , unqtText     , dotText@@ -63,44 +67,87 @@     , printColorScheme     ) where -import Data.GraphViz.Util-import Data.GraphViz.State+import Data.GraphViz.Internal.State+import Data.GraphViz.Internal.Util -- To avoid orphan instances and cyclic imports import Data.GraphViz.Attributes.ColorScheme  -- Only implicitly import and re-export combinators.-import Text.PrettyPrint.Leijen.Text.Monadic hiding ( SimpleDoc(..)-                                                   , renderPretty-                                                   , renderCompact-                                                   , displayT-                                                   , displayIO-                                                   , putDoc-                                                   , hPutDoc-                                                   , Pretty(..)-                                                   , bool-                                                   , string)+import qualified Data.Text                            as ST+import           Data.Text.Lazy                       (Text)+import qualified Data.Text.Lazy                       as T+import           Text.PrettyPrint.Leijen.Text.Monadic hiding (Pretty(..),+                                                       SimpleDoc(..), bool,+                                                       displayIO, displayT,+                                                       hPutDoc, putDoc,+                                                       renderCompact,+                                                       renderPretty, string,+                                                       width, (<$>)) import qualified Text.PrettyPrint.Leijen.Text.Monadic as PP-import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text) -import Data.Char(toLower)-import qualified Data.Set as Set-import Data.Word(Word8, Word16)-import Control.Monad(ap, when)-import Control.Monad.Trans.State+import           Control.Monad       (ap, when)+import           Control.Monad.State (MonadState, State, evalState, gets,+                                      modify)+import           Data.Char           (toLower)+import qualified Data.Set            as Set+import           Data.String         (IsString(..))+import           Data.Version        (Version(..))+import           Data.Word           (Word64, Word32, Word16, Word8) +#if !(MIN_VERSION_base (4,11,0))++#if !(MIN_VERSION_base (4,8,0))+import Control.Applicative (Applicative)+import Data.Monoid         (Monoid(..))+#endif++#if MIN_VERSION_base (4,9,0) && !MIN_VERSION_base (4,13,0)+import Data.Semigroup (Semigroup(..))+#else+import Data.Monoid ((<>))+#endif++#endif+ -- -----------------------------------------------------------------------------  -- | A type alias to indicate what is being produced.-type DotCode = State GraphvizState Doc+newtype DotCodeM a = DotCodeM { getDotCode :: State GraphvizState a }+  deriving (Functor, Applicative, Monad, MonadState GraphvizState) +type DotCode = DotCodeM Doc++runDotCode :: DotCode -> Doc+runDotCode = (`evalState` initialState) . getDotCode+ instance Show DotCode where   showsPrec d = showsPrec d . renderDot +instance IsString DotCode where+  fromString = PP.string . fromString++#if MIN_VERSION_base (4,9,0)+instance Semigroup DotCode where+  (<>) = beside++instance Monoid DotCode where+  mempty  = empty+  mappend = (<>)+#else+instance Monoid DotCode where+  mempty  = empty+  mappend = beside+#endif++instance GraphvizStateM DotCodeM where+  modifyGS = modify++  getsGS = gets+ -- | Correctly render Graphviz output. renderDot :: DotCode -> Text renderDot = PP.displayT . PP.renderPretty 0.4 80-            . flip evalState initialState+            . runDotCode  -- | A class used to correctly print parts of the Graphviz Dot language. --   Minimal implementation is 'unqtDot'.@@ -144,6 +191,12 @@ instance PrintDot Word16 where   unqtDot = int . fromIntegral +instance PrintDot Word32 where+  unqtDot = unqtDot . toInteger++instance PrintDot Word64 where+  unqtDot = unqtDot . toInteger+ instance PrintDot Double where   -- If it's an "integral" double, then print as an integer.  This   -- seems to match how Graphviz apps use Dot.@@ -177,11 +230,24 @@    listToDot = toDot . T.pack +-- | Ignores 'versionTags' and assumes 'not . null . versionBranch'+--   (usually you want 'length . versionBranch == 2').+instance PrintDot Version where+  unqtDot = hcat . punctuate dot . mapM int . versionBranch++  toDot v = bool id dquotes (not . null . drop 2 . versionBranch $ v)+            $ unqtDot v+ instance PrintDot Text where   unqtDot = unqtString    toDot = qtString +instance PrintDot ST.Text where+  unqtDot = unqtDot . T.fromStrict++  toDot = qtString . T.fromStrict+ -- | For use with @OverloadedStrings@ to avoid ambiguous type variable errors. unqtText :: Text -> DotCode unqtText = unqtDot@@ -198,11 +264,11 @@  needsQuotes :: Text -> Bool needsQuotes str-  | T.null str      = True-  | isKeyword str   = True-  | isIDString str  = False-  | isNumString str = False-  | otherwise       = True+  | T.null str            = True+  | isKeyword str         = True+  | isIDString str        = False+  | isNumString False str = False+  | otherwise             = True  addQuotes :: Text -> DotCode -> DotCode addQuotes = bool id dquotes . needsQuotes
− Data/GraphViz/State.hs 
@@ -1,118 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}--{- |-   Module      : Data.GraphViz.State-   Description : Printing and parsing state.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   When printing and parsing Dot code, some items depend on values-   that are set earlier.--}-module Data.GraphViz.State-       ( GraphvizStateM(..)-       , GraphvizState(..)-       , AttributeType(..)-       , setAttributeType-       , getAttributeType-       , initialState-       , setDirectedness-       , getDirectedness-       , setLayerSep-       , getLayerSep-       , setColorScheme-       , getColorScheme-       ) where--import Data.GraphViz.Attributes.ColorScheme--import Control.Monad.Trans.State(State, modify, gets)-import Text.ParserCombinators.Poly.StateText(Parser, stUpdate, stQuery)---- -------------------------------------------------------------------------------class (Monad m) => GraphvizStateM m where-  modifyGS :: (GraphvizState -> GraphvizState) -> m ()--  getsGS :: (GraphvizState -> a) -> m a--instance GraphvizStateM (State GraphvizState) where-  modifyGS = modify--  getsGS = gets--instance GraphvizStateM (Parser GraphvizState) where-  modifyGS = stUpdate--  getsGS = stQuery--data AttributeType = GraphAttribute-                   | SubGraphAttribute-                   | ClusterAttribute-                   | NodeAttribute-                   | EdgeAttribute-                     deriving (Eq, Ord, Show, Read)---- | Several aspects of Dot code are either global or mutable state.-data GraphvizState = GS { directedEdges :: !Bool-                        , layerSep      :: [Char]-                        , attributeType :: !AttributeType-                        , graphColor    :: !ColorScheme-                        , clusterColor  :: !ColorScheme-                        , nodeColor     :: !ColorScheme-                        , edgeColor     :: !ColorScheme-                        }-                   deriving (Eq, Ord, Show, Read)--initialState :: GraphvizState-initialState = GS { directedEdges = True-                  , layerSep      = defLayerSep-                  , attributeType = GraphAttribute-                  , graphColor    = X11-                  , clusterColor  = X11-                  , nodeColor     = X11-                  , edgeColor     = X11-                  }--setDirectedness   :: (GraphvizStateM m) => Bool -> m ()-setDirectedness d = modifyGS (\ gs -> gs { directedEdges = d } )--getDirectedness :: (GraphvizStateM m) => m Bool-getDirectedness = getsGS directedEdges--setAttributeType    :: (GraphvizStateM m) => AttributeType -> m ()-setAttributeType tp = modifyGS $ \ gs -> gs { attributeType = tp }--getAttributeType :: (GraphvizStateM m) => m AttributeType-getAttributeType = getsGS attributeType--setLayerSep     :: (GraphvizStateM m) => [Char] -> m ()-setLayerSep sep = modifyGS (\ gs -> gs { layerSep = sep } )--getLayerSep :: (GraphvizStateM m) => m [Char]-getLayerSep = getsGS layerSep--setColorScheme    :: (GraphvizStateM m) => ColorScheme -> m ()-setColorScheme cs = do tp <- getsGS attributeType-                       modifyGS $ \gs -> case tp of-                                           GraphAttribute    -> gs { graphColor   = cs }-                                            -- subgraphs don't have specified scheme-                                           SubGraphAttribute -> gs { graphColor   = cs }-                                           ClusterAttribute  -> gs { clusterColor = cs }-                                           NodeAttribute     -> gs { nodeColor    = cs }-                                           EdgeAttribute     -> gs { edgeColor    = cs }--getColorScheme :: (GraphvizStateM m) => m ColorScheme-getColorScheme = do tp <- getsGS attributeType-                    getsGS $ case tp of-                               GraphAttribute    -> graphColor-                                -- subgraphs don't have specified scheme-                               SubGraphAttribute -> graphColor-                               ClusterAttribute  -> clusterColor-                               NodeAttribute     -> nodeColor-                               EdgeAttribute     -> edgeColor---- | The default separators for 'LayerSep'.-defLayerSep :: [Char]-defLayerSep = [' ', ':', '\t']
Data/GraphViz/Types.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,+             TypeSynonymInstances #-}  {- |    Module      : Data.GraphViz.Types@@ -35,30 +36,30 @@     > digraph G {    >-   > 	subgraph cluster_0 {-   > 		style=filled;-   > 		color=lightgrey;-   > 		node [style=filled,color=white];-   > 		a0 -> a1 -> a2 -> a3;-   > 		label = "process #1";-   > 	}+   >   subgraph cluster_0 {+   >     style=filled;+   >     color=lightgrey;+   >     node [style=filled,color=white];+   >     a0 -> a1 -> a2 -> a3;+   >     label = "process #1";+   >   }    >-   > 	subgraph cluster_1 {-   > 		node [style=filled];-   > 		b0 -> b1 -> b2 -> b3;-   > 		label = "process #2";-   > 		color=blue-   > 	}-   > 	start -> a0;-   > 	start -> b0;-   > 	a1 -> b3;-   > 	b2 -> a3;-   > 	a3 -> a0;-   > 	a3 -> end;-   > 	b3 -> end;+   >   subgraph cluster_1 {+   >     node [style=filled];+   >     b0 -> b1 -> b2 -> b3;+   >     label = "process #2";+   >     color=blue+   >   }+   >   start -> a0;+   >   start -> b0;+   >   a1 -> b3;+   >   b2 -> a3;+   >   a3 -> a0;+   >   a3 -> end;+   >   b3 -> end;    >-   > 	start [shape=Mdiamond];-   > 	end [shape=Msquare];+   >   start [shape=Mdiamond];+   >   end [shape=Msquare];    > }      Each representation is suited for different things:@@ -94,6 +95,7 @@        , PPDotRepr          -- * Common sub-types        , GraphID(..)+       , Number (..)        , ToGraphID(..)        , textGraphID        , GlobalAttributes(..)@@ -103,30 +105,41 @@        , ClusterLookup        , NodeLookup        , Path+       , graphStructureInformationClean+       , nodeInformationClean+       , edgeInformationClean          -- * Obtaining the @DotNode@s and @DotEdges@.        , graphNodes        , graphEdges          -- * Printing and parsing a @DotRepr@.        , printDotGraph        , parseDotGraph+       , parseDotGraphLiberally          -- * Limitations and documentation          -- $limitations        ) where -import Data.GraphViz.Types.Canonical( DotGraph(..), DotStatements(..)-                                    , DotSubGraph(..))-import Data.GraphViz.Types.Common( GraphID(..), GlobalAttributes(..)-                                 , DotNode(..), DotEdge(..), numericValue)+import Data.GraphViz.Attributes.Complete   (rmUnwantedAttributes,+                                            usedByClusters, usedByEdges,+                                            usedByGraphs, usedByNodes)+import Data.GraphViz.Internal.State        (GraphvizState)+import Data.GraphViz.Internal.Util         (bool)+import Data.GraphViz.Parsing               (ParseDot(..), adjustErr,+                                            checkValidParseWithRest, parse,+                                            parseLiberally, runParserWith)+import Data.GraphViz.PreProcessing         (preProcess)+import Data.GraphViz.Printing              (PrintDot(..), printIt)+import Data.GraphViz.Types.Canonical       (DotGraph(..), DotStatements(..),+                                            DotSubGraph(..))+import Data.GraphViz.Types.Internal.Common (DotEdge(..), DotNode(..),+                                            GlobalAttributes(..), GraphID(..),+                                            Number(..), numericValue, withGlob) import Data.GraphViz.Types.State-import Data.GraphViz.Util(bool)-import Data.GraphViz.Parsing(ParseDot(..), runParser, checkValidParse, parse, adjustErr)-import Data.GraphViz.PreProcessing(preProcess)-import Data.GraphViz.Printing(PrintDot(..), printIt) -import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)-import Control.Arrow(first)-import Control.Monad.Trans.State(get, put, modify, execState, evalState)+import           Control.Arrow       (second, (***))+import           Control.Monad.State (evalState, execState, get, modify, put)+import           Data.Text.Lazy      (Text)+import qualified Data.Text.Lazy      as T  -- ----------------------------------------------------------------------------- @@ -142,6 +155,9 @@ class (Ord n) => DotRepr dg n where   -- | Convert from a graph in canonical form.  This is especially   --   useful when using the functions from "Data.GraphViz.Algorithms".+  --+  --   See @FromGeneralisedDot@ in "Data.GraphViz.Types.Generalised"+  --   for a semi-inverse of this function.   fromCanonical :: DotGraph n -> dg n    -- | Return the ID of the graph.@@ -165,7 +181,7 @@   -- | Change the node values.  This function is assumed to be   --   /injective/, otherwise the resulting graph will not be   --   identical to the original (modulo labels).-  mapDotGraph :: (Ord n', DotRepr dg n') => (n -> n') -> dg n -> dg n'+  mapDotGraph :: (DotRepr dg n') => (n -> n') -> dg n -> dg n'    -- | Return information on all the clusters contained within this   --   'DotRepr', as well as the top-level 'GraphAttrs' for the@@ -187,6 +203,36 @@   --   from 'graphStructureInformation').   unAnonymise :: dg n -> dg n +-- | A variant of 'graphStructureInformation' with default attributes+--   removed and only attributes usable by graph/cluster kept (where+--   applicable).+graphStructureInformationClean :: (DotRepr dg n) => dg n+                                  -> (GlobalAttributes, ClusterLookup)+graphStructureInformationClean = (globOnly *** fmap (second clustOnly))+                                 . graphStructureInformation+  where+    globOnly = withGlob $ filter usedByGraphs . rmUnwantedAttributes++    clustOnly = withGlob $ filter usedByClusters . rmUnwantedAttributes+++-- | A variant of 'nodeInformation' with default attributes removed+--   and only attributes used by nodes kept.+nodeInformationClean :: (DotRepr dg n) => Bool -> dg n -> NodeLookup n+nodeInformationClean = (fmap (second nodeOnly) .) . nodeInformation+  where+    nodeOnly = filter usedByNodes . rmUnwantedAttributes++-- | A variant of 'edgeInformation' with default attributes removed+--   and only attributes used by edges kept.+edgeInformationClean :: (DotRepr dg n) => Bool -> dg n -> [DotEdge n]+edgeInformationClean = (map rmEdgeAs .) . edgeInformation+  where+    rmEdgeAs de = de { edgeAttributes = edgeOnly $ edgeAttributes de }++    edgeOnly = filter usedByEdges . rmUnwantedAttributes++ -- | This class exists just to make type signatures nicer; all --   instances of 'DotRepr' should also be an instance of --   'PrintDotRepr'.@@ -225,9 +271,23 @@ -- --   Also removes any comments, etc. before parsing. parseDotGraph :: (ParseDotRepr dg n) => Text -> dg n-parseDotGraph = fst . prs . preProcess+parseDotGraph = parseDotGraphWith id++-- | As with 'parseDotGraph', but if an 'Attribute' cannot be parsed+--   strictly according to the known rules, let it fall back to being+--   parsed as an 'UnknownAttribute'.  This is especially useful for+--   when using a version of Graphviz that is either newer (especially+--   for the XDot attributes) or older (when some attributes have+--   changed) but you'd still prefer it to parse rather than throwing+--   an error.+parseDotGraphLiberally :: (ParseDotRepr dg n) => Text -> dg n+parseDotGraphLiberally = parseDotGraphWith parseLiberally++parseDotGraphWith :: (ParseDotRepr dg n) => (GraphvizState -> GraphvizState)+                     -> Text -> dg n+parseDotGraphWith f = prs . preProcess   where-    prs = first checkValidParse . runParser parse'+    prs = checkValidParseWithRest . runParserWith f parse'      parse' = parse `adjustErr`              ("Unable to parse the Dot graph; usually this is because of either:\n\@@ -307,7 +367,7 @@     sgRe sg = do sgid' <- case subGraphID sg of                             Nothing -> do n <- get                                           put $ succ n-                                          return . Just $ Int n+                                          return . Just . Num $ Int n                             sgid    -> return sgid                  stmts' <- stRe $ subGraphStmts sg                  return $ sg { subGraphID    = sgid'@@ -316,7 +376,7 @@  maxSGInt    :: DotGraph n -> Int maxSGInt dg = execState (stInt $ graphStatements dg)-              . flip check 0+              . (`check` 0)               $ graphID dg   where     check = maybe id max . (numericValue =<<)@@ -350,14 +410,14 @@   toGraphID = toGraphID . T.singleton  instance ToGraphID Int where-  toGraphID = Int+  toGraphID = Num . Int  -- | This instance loses precision by going via 'Int'. instance ToGraphID Integer where-  toGraphID = Int . fromInteger+  toGraphID = Num . Int . fromInteger  instance ToGraphID Double where-  toGraphID = Dbl+  toGraphID = Num . Dbl  -- -----------------------------------------------------------------------------
Data/GraphViz/Types/Canonical.hs view
@@ -32,11 +32,11 @@    >          , graphID = Just (Str "G")    >          , graphStatements = DotStmts { attrStmts = []    >                                       , subGraphs = [ DotSG { isCluster = True-   >                                                             , subGraphID = Just (Int 0)+   >                                                             , subGraphID = Just (Num (Int 0))    >                                                             , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [ style filled    >                                                                                                                   , color LightGray    >                                                                                                                   , textLabel "process #1"]-   >                                                                                                      , NodeAttrs [style filled, color White]]}+   >                                                                                                      , NodeAttrs [style filled, color White]]    >                                                                                        , subGraphs = []    >                                                                                        , nodeStmts = [ DotNode "a0" []    >                                                                                                      , DotNode "a1" []@@ -47,7 +47,7 @@    >                                                                                                      , DotEdge "a2" "a3" []    >                                                                                                      , DotEdge "a3" "a0" []]}}    >                                                     , DotSG { isCluster = True-   >                                                             , subGraphID = Just (Int 1)+   >                                                             , subGraphID = Just (Num (Int 1))    >                                                             , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [textLabel "process #2", color Blue]    >                                                                                                      , NodeAttrs [style filled]]    >                                                                                        , subGraphs = []@@ -84,14 +84,13 @@        , DotEdge(..)        ) where -import Data.GraphViz.Types.Common+import Data.GraphViz.Internal.State        (AttributeType (..))+import Data.GraphViz.Internal.Util         (bool) import Data.GraphViz.Parsing import Data.GraphViz.Printing-import Data.GraphViz.State(AttributeType(..))-import Data.GraphViz.Util(bool)+import Data.GraphViz.Types.Internal.Common -import Control.Arrow((&&&))-import Control.Monad(liftM)+import Control.Arrow ((&&&))  -- ----------------------------------------------------------------------------- @@ -182,8 +181,8 @@   parseUnqt = parseSubGraph DotSG parseUnqt               `onFail`               -- Take "anonymous" DotSubGraphs into account.-              liftM (DotSG False Nothing)-                    (parseBracesBased SubGraphAttribute parseUnqt)+              fmap (DotSG False Nothing)+                   (parseBracesBased SubGraphAttribute parseUnqt)    parse = parseUnqt -- Don't want the option of quoting           `adjustErr`
− Data/GraphViz/Types/Common.hs 
@@ -1,522 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK hide #-}--{- |-   Module      : Data.GraphViz.Types.Common-   Description : Common internal functions for dealing with overall types.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module provides common functions used by both-   "Data.GraphViz.Types" as well as "Data.GraphViz.Types.Generalised".--}-module Data.GraphViz.Types.Common where--import Data.GraphViz.Parsing-import Data.GraphViz.Printing-import Data.GraphViz.State-import Data.GraphViz.Util-import Data.GraphViz.Attributes.Complete( Attributes, Attribute(HeadPort, TailPort)-                                        , usedByGraphs, usedByClusters-                                        , usedByNodes)-import Data.GraphViz.Attributes.Internal(PortPos, parseEdgeBasedPP)--import Data.Maybe(isJust)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.Read as T-import Data.Text.Lazy(Text)-import Control.Monad(liftM, liftM2, when)---- -------------------------------------------------------------------------------- This is re-exported by Data.GraphViz.Types---- | A polymorphic type that covers all possible ID values allowed by---   Dot syntax.  Note that whilst the 'ParseDot' and 'PrintDot'---   instances for 'String' will properly take care of the special---   cases for numbers, they are treated differently here.-data GraphID = Str Text-             | Int Int-             | Dbl Double-             deriving (Eq, Ord, Show, Read)--instance PrintDot GraphID where-  unqtDot (Str str) = unqtDot str-  unqtDot (Int i)   = unqtDot i-  unqtDot (Dbl d)   = unqtDot d--  toDot (Str str) = toDot str-  toDot gID       = unqtDot gID--instance ParseDot GraphID where-  parseUnqt = liftM stringNum parseUnqt--  parse = liftM stringNum parse-          `adjustErr`-          ("Not a valid GraphID\n\t"++)--stringNum     :: Text -> GraphID-stringNum str = maybe checkDbl Int $ stringToInt str-  where-    checkDbl = if isNumString str-               then Dbl $ toDouble str-               else Str str--numericValue           :: GraphID -> Maybe Int-numericValue (Str str) = either (const Nothing) (Just . round . fst)-                         $ T.signed T.double str-numericValue (Int n)   = Just n-numericValue (Dbl x)   = Just $ round x---- --------------------------------------------------------------------------------- Re-exported by Data.GraphViz.Types.*---- | Represents a list of top-level list of 'Attribute's for the---   entire graph/sub-graph.  Note that 'GraphAttrs' also applies to---   'DotSubGraph's.------   Note that Dot allows a single 'Attribute' to be listed on a line;---   if this is the case then when parsing, the type of 'Attribute' it---   is determined and that type of 'GlobalAttribute' is created.-data GlobalAttributes = GraphAttrs { attrs :: Attributes }-                      | NodeAttrs  { attrs :: Attributes }-                      | EdgeAttrs  { attrs :: Attributes }-                      deriving (Eq, Ord, Show, Read)--instance PrintDot GlobalAttributes where-  unqtDot = printAttrBased True printGlobAttrType globAttrType attrs--  unqtListToDot = printAttrBasedList True printGlobAttrType globAttrType attrs--  listToDot = unqtListToDot---- GraphAttrs, NodeAttrs and EdgeAttrs respectively-partitionGlobal :: [GlobalAttributes] -> (Attributes, Attributes, Attributes)-partitionGlobal = foldr select ([], [], [])-  where-    select globA ~(gs,ns,es) = case globA of-                                 GraphAttrs as -> (as ++ gs, ns, es)-                                 NodeAttrs  as -> (gs, as ++ ns, es)-                                 EdgeAttrs  as -> (gs, ns, as ++ es)--printGlobAttrType              :: GlobalAttributes -> DotCode-printGlobAttrType GraphAttrs{} = text "graph"-printGlobAttrType NodeAttrs{}  = text "node"-printGlobAttrType EdgeAttrs{}  = text "edge"--instance ParseDot GlobalAttributes where-  -- Not using parseAttrBased here because we want to force usage of-  -- Attributes.-  parseUnqt = do gat <- parseGlobAttrType--                 -- Determine if we need to set the attribute type.-                 let mtp = globAttrType $ gat [] -- Only need the constructor-                 oldTp <- getAttributeType-                 maybe (return ()) setAttributeType mtp--                 as <- whitespace >> parse--                 -- Safe to set back even if not changed.-                 setAttributeType oldTp-                 return $ gat as-              `onFail`-              liftM determineType parse--  parse = parseUnqt -- Don't want the option of quoting-          `adjustErr`-          ("Not a valid listing of global attributes\n\t"++)--  -- Have to do this manually because of the special case-  parseUnqtList = parseStatements parseUnqt--  parseList = parseUnqtList---- Cheat: rather than determine whether it's a graph, cluster or--- sub-graph just don't set it.-globAttrType :: GlobalAttributes -> Maybe AttributeType-globAttrType NodeAttrs{} = Just NodeAttribute-globAttrType EdgeAttrs{} = Just EdgeAttribute-globAttrType _           = Nothing--parseGlobAttrType :: Parse (Attributes -> GlobalAttributes)-parseGlobAttrType = oneOf [ stringRep GraphAttrs "graph"-                          , stringRep NodeAttrs "node"-                          , stringRep EdgeAttrs "edge"-                          ]--determineType :: Attribute -> GlobalAttributes-determineType attr-  | usedByGraphs attr   = GraphAttrs attr'-  | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case-  | usedByNodes attr    = NodeAttrs attr'-  | otherwise           = EdgeAttrs attr' -- Must be for edges.-  where-    attr' = [attr]---- --------------------------------------------------------------------------------- | A node in 'DotGraph'.-data DotNode n = DotNode { nodeID :: n-                         , nodeAttributes :: Attributes-                         }-               deriving (Eq, Ord, Show, Read)--instance (PrintDot n) => PrintDot (DotNode n) where-  unqtDot = printAttrBased False printNodeID-                           (const $ Just NodeAttribute) nodeAttributes--  unqtListToDot = printAttrBasedList False printNodeID-                                     (const $ Just NodeAttribute) nodeAttributes--  listToDot = unqtListToDot--printNodeID :: (PrintDot n) => DotNode n -> DotCode-printNodeID = toDot . nodeID--instance (ParseDot n) => ParseDot (DotNode n) where-  parseUnqt = parseAttrBased NodeAttribute False parseNodeID--  parse = parseUnqt -- Don't want the option of quoting--  parseUnqtList = parseAttrBasedList NodeAttribute False parseNodeID--  parseList = parseUnqtList--parseNodeID :: (ParseDot n) => Parse (Attributes -> DotNode n)-parseNodeID = liftM DotNode parseAndCheck-  where-    parseAndCheck = do n <- parse-                       me <- optional parseUnwanted-                       maybe (return n) (const notANode) me-    notANode = fail "This appears to be an edge, not a node"-    parseUnwanted = oneOf [ parseEdgeType >> return ()-                          , character ':' >> return () -- PortPos value-                          ]--instance Functor DotNode where-  fmap f n = n { nodeID = f $ nodeID n }---- --------------------------------------------------------------------------------- This is re-exported in Data.GraphViz.Types; defined here so that--- Generalised can access and use parseEdgeLine (needed for "a -> b ->--- c"-style edge statements).---- | An edge in 'DotGraph'.-data DotEdge n = DotEdge { fromNode       :: n-                         , toNode         :: n-                         , edgeAttributes :: Attributes-                         }-               deriving (Eq, Ord, Show, Read)--instance (PrintDot n) => PrintDot (DotEdge n) where-  unqtDot = printAttrBased False printEdgeID-                           (const $ Just EdgeAttribute) edgeAttributes--  unqtListToDot = printAttrBasedList False printEdgeID-                                     (const $ Just EdgeAttribute) edgeAttributes--  listToDot = unqtListToDot--printEdgeID   :: (PrintDot n) => DotEdge n -> DotCode-printEdgeID e = do isDir <- getDirectedness-                   toDot (fromNode e)-                     <+> bool undirEdge' dirEdge' isDir-                     <+> toDot (toNode e)---instance (ParseDot n) => ParseDot (DotEdge n) where-  parseUnqt = parseAttrBased EdgeAttribute True parseEdgeID--  parse = parseUnqt -- Don't want the option of quoting--  -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.-  parseUnqtList = liftM concat-                  $ parseStatements parseEdgeLine--  parseList = parseUnqtList--parseEdgeID :: (ParseDot n) => Parse (Attributes -> DotEdge n)-parseEdgeID = do eFrom <- parseEdgeNode-                 -- Parse both edge types just to be more liberal-                 parseEdgeType-                 eTo <- parseEdgeNode-                 return $ mkEdge eFrom eTo--type EdgeNode n = (n, Maybe PortPos)---- | Takes into account edge statements containing something like---   @a -> \{b c\}@.-parseEdgeNodes :: (ParseDot n) => Parse [EdgeNode n]-parseEdgeNodes = parseBraced ( wrapWhitespace-                               -- Should really use sepBy1, but this will do.-                               $ parseStatements parseEdgeNode-                             )-                 `onFail`-                 liftM return parseEdgeNode--parseEdgeNode :: (ParseDot n) => Parse (EdgeNode n)-parseEdgeNode = liftM2 (,) parse-                           (optional $ character ':' >> parseEdgeBasedPP)--mkEdge :: EdgeNode n -> EdgeNode n -> Attributes -> DotEdge n-mkEdge (eFrom, mFP) (eTo, mTP) = DotEdge eFrom eTo-                                 . addPortPos TailPort mFP-                                 . addPortPos HeadPort mTP--mkEdges :: [EdgeNode n] -> [EdgeNode n]-           -> Attributes -> [DotEdge n]-mkEdges fs ts as = liftM2 (\f t -> mkEdge f t as) fs ts--addPortPos   :: (PortPos -> Attribute) -> Maybe PortPos-                -> Attributes -> Attributes-addPortPos c = maybe id ((:) . c)--parseEdgeType :: Parse Bool-parseEdgeType = wrapWhitespace $ stringRep True dirEdge-                                 `onFail`-                                 stringRep False undirEdge--parseEdgeLine :: (ParseDot n) => Parse [DotEdge n]-parseEdgeLine = do n1 <- parseEdgeNodes-                   ens <- many1 $ do parseEdgeType-                                     parseEdgeNodes-                   let ens' = n1 : ens-                       efs = zipWith mkEdges ens' (tail ens')-                       ef = return $ \ as -> concatMap ($as) efs-                   parseAttrBased EdgeAttribute True ef--instance Functor DotEdge where-  fmap f e = e { fromNode = f $ fromNode e-               , toNode   = f $ toNode e-               }--dirEdge :: String-dirEdge = "->"--dirEdge' :: DotCode-dirEdge' = text $ T.pack dirEdge--undirEdge :: String-undirEdge = "--"--undirEdge' :: DotCode-undirEdge' = text $ T.pack undirEdge---- -------------------------------------------------------------------------------- Labels--dirGraph :: String-dirGraph = "digraph"--dirGraph' :: DotCode-dirGraph' = text $ T.pack dirGraph--undirGraph :: String-undirGraph = "graph"--undirGraph' :: DotCode-undirGraph' = text $ T.pack undirGraph--strGraph :: String-strGraph = "strict"--strGraph' :: DotCode-strGraph' = text $ T.pack strGraph--sGraph :: String-sGraph = "subgraph"--sGraph' :: DotCode-sGraph' = text $ T.pack sGraph--clust :: String-clust = "cluster"--clust' :: DotCode-clust' = text $ T.pack clust---- -------------------------------------------------------------------------------printGraphID                 :: (a -> Bool) -> (a -> Bool)-                                -> (a -> Maybe GraphID)-                                -> a -> DotCode-printGraphID str isDir mID g = do setDirectedness isDir'-                                  bool empty strGraph' (str g)-                                    <+> bool undirGraph' dirGraph' isDir'-                                    <+> maybe empty toDot (mID g)-  where-    isDir' = isDir g--parseGraphID   :: (Bool -> Bool -> Maybe GraphID -> a) -> Parse a-parseGraphID f = do whitespace-                    str <- liftM isJust-                           $ optional (parseAndSpace $ string strGraph)-                    dir <- parseAndSpace ( stringRep True dirGraph-                                           `onFail`-                                           stringRep False undirGraph-                                         )-                    setDirectedness dir-                    gID <- optional $ parseAndSpace parse-                    return $ f str dir gID--printStmtBased              :: (a -> DotCode) -> (a -> AttributeType)-                               -> (a -> stmts) -> (stmts -> DotCode)-                               -> a -> DotCode-printStmtBased f ftp r dr a = do gs <- getsGS id-                                 setAttributeType $ ftp a-                                 dc <- printBracesBased (f a) (dr $ r a)-                                 modifyGS (const gs)-                                 return dc--printStmtBasedList            :: (a -> DotCode) -> (a -> AttributeType)-                                 -> (a -> stmts) -> (stmts -> DotCode)-                                 -> [a] -> DotCode-printStmtBasedList f ftp r dr = vcat . mapM (printStmtBased f ftp r dr)---- Can't use the 'braces' combinator here because we want the closing--- brace lined up with the h value, which due to indentation might not--- be the case with braces.-printBracesBased     :: DotCode -> DotCode -> DotCode-printBracesBased h i = vcat $ sequence [ h <+> lbrace-                                       , ind i-                                       , rbrace-                                       ]-  where-    ind = indent 4---- | This /must/ only be used for sub-graphs, etc.-parseBracesBased      :: AttributeType -> Parse a -> Parse a-parseBracesBased tp p = do gs <- getsGS id-                           setAttributeType tp-                           a <- whitespace >> parseBraced (wrapWhitespace p)-                           modifyGS (const gs)-                           return a-                        `adjustErr`-                        ("Not a valid value wrapped in braces.\n\t"++)--printSubGraphID     :: (a -> (Bool, Maybe GraphID)) -> a -> DotCode-printSubGraphID f a = sGraph'-                      <+> maybe cl dtID mID-  where-    (isCl, mID) = f a-    cl = bool empty clust' isCl-    dtID = printSGID isCl---- | Print the actual ID for a 'DotSubGraph'.-printSGID          :: Bool -> GraphID -> DotCode-printSGID isCl sID = bool noClust addClust isCl-  where-    noClust = toDot sID-    -- Have to manually render it as we need the un-quoted form.-    addClust = toDot . T.append (T.pack clust) . T.cons '_'-               . renderDot $ mkDot sID-    mkDot (Str str) = text str -- Quotes will be escaped later-    mkDot gid       = unqtDot gid--parseSubGraph         :: (Bool -> Maybe GraphID -> stmt -> c) -> Parse stmt -> Parse c-parseSubGraph pid pst = do (isC, fID) <- parseSubGraphID pid-                           let tp = bool SubGraphAttribute ClusterAttribute isC-                           liftM fID $ parseBracesBased tp pst--parseSubGraphID   :: (Bool -> Maybe GraphID -> c) -> Parse (Bool,c)-parseSubGraphID f = do string sGraph-                       whitespace1-                       (isC,mid) <- parseSGID-                       return (isC, f isC mid)--parseSGID :: Parse (Bool, Maybe GraphID)-parseSGID = oneOf [ liftM getClustFrom $ parseAndSpace parse-                  , return (False, Nothing)-                  ]-  where-    -- If it's a String value, check to see if it's actually a-    -- cluster_Blah value; thus need to manually re-parse it.-    getClustFrom (Str str) = runParser' pStr str-    getClustFrom gid       = (False, Just gid)--    checkCl = stringRep True clust-    pStr = do isCl <- checkCl-                      `onFail`-                      return False-              when isCl $ optional (character '_') >> return ()-              sID <- optional pID-              let sID' = if sID == emptyID-                         then Nothing-                         else sID-              return (isCl, sID')--    emptyID = Just $ Str ""--    -- For Strings, there are no more quotes to unescape, so consume-    -- what you can.-    pID = liftM stringNum $ manySatisfy (const True)--{- This is a much nicer definition, but unfortunately it doesn't work.-   The problem is that Graphviz decides that a subgraph is a cluster-   if the ID starts with "cluster" (no quotes); thus, we _have_ to do-   the double layer of parsing to get it to work :@--            do isCl <- stringRep True clust-                       `onFail`-                       return False-               sID <- optional $ do when isCl-                                      $ optional (character '_') >> return ()-                                    parseUnqt-               when (isCl || isJust sID) $ whitespace1 >> return ()-               return (isCl, sID)--}---- The Bool is True for global, False for local.-printAttrBased                    :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)-                                     -> (a -> Attributes) -> a -> DotCode-printAttrBased prEmp ff ftp fas a = do oldType <- getAttributeType-                                       maybe (return ()) setAttributeType mtp-                                       oldCS <- getColorScheme-                                       (dc <> semi) <* setAttributeType oldType-                                                    <* when prEmp (setColorScheme oldCS)-  where-    mtp = ftp a-    f = ff a-    dc = case fas a of-           [] | not prEmp -> f-           as -> f <+> toDot as---- The Bool is True for global, False for local.-printAttrBasedList                    :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)-                                         -> (a -> Attributes) -> [a] -> DotCode-printAttrBasedList prEmp ff ftp fas = vcat . mapM (printAttrBased prEmp ff ftp fas)---- The Bool is True for global, False for local.-parseAttrBased         :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse a-parseAttrBased tp lc p = do oldType <- getAttributeType-                            setAttributeType tp-                            oldCS <- getColorScheme-                            f <- p-                            atts <- tryParseList' (whitespace >> parse)-                            when lc $ setColorScheme oldCS-                            when (tp /= oldType) $ setAttributeType oldType-                            return $ f atts-                         `adjustErr`-                         ("Not a valid attribute-based structure\n\t"++)---- The Bool is True for global, False for local.-parseAttrBasedList       :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse [a]-parseAttrBasedList tp lc = parseStatements . parseAttrBased tp lc---- | Parse the separator (and any other whitespace1 present) between statements.-statementEnd :: Parse ()-statementEnd = parseSplit >> newline'-  where-    parseSplit = (whitespace >> oneOf [ character ';' >> return ()-                                       , newline-                                       ]-                 )-                 `onFail`-                 whitespace1--parseStatements   :: Parse a -> Parse [a]-parseStatements p = sepBy (whitespace >> p) statementEnd-                    `discard`-                    optional statementEnd
Data/GraphViz/Types/Generalised.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  {- |    Module      : Data.GraphViz.Types.Generalised.@@ -49,6 +49,7 @@  -} module Data.GraphViz.Types.Generalised        ( DotGraph(..)+       , FromGeneralisedDot (..)          -- * Sub-components of a @DotGraph@.        , DotStatements        , DotStatement(..)@@ -60,22 +61,22 @@        , DotEdge(..)        ) where -import Data.GraphViz.Types-import qualified Data.GraphViz.Types.Canonical as C-import Data.GraphViz.Types.Common-import Data.GraphViz.Types.State-import Data.GraphViz.Parsing-import Data.GraphViz.Printing-import Data.GraphViz.State(AttributeType(..))-import Data.GraphViz.Util(bool)+import           Data.GraphViz.Algorithms            (canonicalise)+import           Data.GraphViz.Internal.State        (AttributeType(..))+import           Data.GraphViz.Internal.Util         (bool)+import           Data.GraphViz.Parsing+import           Data.GraphViz.Printing+import           Data.GraphViz.Types+import qualified Data.GraphViz.Types.Canonical       as C+import           Data.GraphViz.Types.Internal.Common+import           Data.GraphViz.Types.State -import qualified Data.Sequence as Seq-import Data.Sequence(Seq, (><))-import qualified Data.Foldable as F-import qualified Data.Traversable as T-import Control.Arrow((&&&))-import Control.Monad(liftM)-import Control.Monad.Trans.State(get, put, modify, execState, evalState)+import           Control.Arrow       ((&&&))+import           Control.Monad.State (evalState, execState, get, modify, put)+import qualified Data.Foldable       as F+import           Data.Sequence       (Seq, (><))+import qualified Data.Sequence       as Seq+import qualified Data.Traversable    as T  -- ----------------------------------------------------------------------------- @@ -131,6 +132,8 @@               <*> parseBracesBased GraphAttribute parseGStmts    parse = parseUnqt -- Don't want the option of quoting+          `adjustErr`+          ("Not a valid generalised DotGraph\n\t"++)  -- | Assumed to be an injective mapping function. instance Functor DotGraph where@@ -148,13 +151,31 @@  -- ----------------------------------------------------------------------------- +-- | This class is useful for being able to parse in a dot graph as a+--   generalised one, and then convert it to your preferred+--   representation.+--+--   This can be seen as a semi-inverse of 'fromCanonical'.+class (DotRepr dg n) => FromGeneralisedDot dg n where+  fromGeneralised :: DotGraph n -> dg n++instance (Ord n) => FromGeneralisedDot C.DotGraph n where+  fromGeneralised = canonicalise++instance (Ord n) => FromGeneralisedDot DotGraph n where+  fromGeneralised = id++-- -----------------------------------------------------------------------------+ type DotStatements n = Seq (DotStatement n)  printGStmts :: (PrintDot n) => DotStatements n -> DotCode printGStmts = toDot . F.toList  parseGStmts :: (ParseDot n) => Parse (DotStatements n)-parseGStmts = liftM Seq.fromList parse+parseGStmts = (Seq.fromList <$> parse)+              `adjustErr`+              ("Not a valid generalised DotStatements\n\t"++)  statementStructure :: DotStatements n -> GraphState () statementStructure = F.mapM_ stmtStructure@@ -191,24 +212,24 @@   listToDot = unqtListToDot  instance (ParseDot n) => ParseDot (DotStatement n) where-  parseUnqt = oneOf [ liftM GA parseUnqt-                    , liftM SG parseUnqt-                    , liftM DN parseUnqt-                    , liftM DE parseUnqt+  parseUnqt = oneOf [ GA <$> parseUnqt+                    , SG <$> parseUnqt+                    , DN <$> parseUnqt+                    , DE <$> parseUnqt                     ]    parse = parseUnqt -- Don't want the option of quoting           `adjustErr`-          (++ "Not a valid statement")+          ("Not a valid statement\n\t"++) -  parseUnqtList = liftM concat . wrapWhitespace+  parseUnqtList = fmap concat . wrapWhitespace                   $ parseStatements p     where       -- Have to do something special here because of "a -> b -> c"       -- syntax for edges.-      p = liftM (map DE) parseEdgeLine+      p = fmap (map DE) parseEdgeLine           `onFail`-          liftM return parse+          fmap (:[]) parse    parseList = parseUnqtList @@ -262,14 +283,14 @@   parseUnqt = parseSubGraph DotSG parseGStmts               `onFail`               -- Take anonymous DotSubGraphs into account-              liftM (DotSG False Nothing)-                    (parseBracesBased SubGraphAttribute parseGStmts)+              fmap (DotSG False Nothing)+                   (parseBracesBased SubGraphAttribute parseGStmts)    parse = parseUnqt -- Don't want the option of quoting           `adjustErr`-          (++ "\n\nNot a valid Sub Graph")+          ("Not a valid Sub Graph\n\t"++) -  parseUnqtList = sepBy (whitespace >> parseUnqt) newline'+  parseUnqtList = sepBy (whitespace *> parseUnqt) newline'    parseList = parseUnqtList @@ -298,12 +319,12 @@     newStmts = evalState (stsRe $ graphStatements dg) startN      stsRe = T.mapM stRe-    stRe (SG sg) = liftM SG $ sgRe sg-    stRe stmt    = return stmt+    stRe (SG sg) = SG <$> sgRe sg+    stRe stmt    = pure stmt     sgRe sg = do sgid' <- case subGraphID sg of                             Nothing -> do n <- get                                           put $ succ n-                                          return . Just $ Int n+                                          return . Just . Num $ Int n                             sgid    -> return sgid                  stmts' <- stsRe $ subGraphStmts sg                  return $ sg { subGraphID    = sgid'@@ -312,7 +333,7 @@  maxSGInt    :: DotGraph n -> Int maxSGInt dg = execState (stsInt $ graphStatements dg)-              . flip check 0+              . (`check` 0)               $ graphID dg   where     check = maybe id max . (numericValue =<<)
Data/GraphViz/Types/Graph.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}  {- |    Module      : Data.GraphViz.Types.Graph@@ -96,29 +96,37 @@        , removeEmptyClusters        ) where -import Data.GraphViz.Types-import qualified Data.GraphViz.Types.Canonical as C-import qualified Data.GraphViz.Types.Generalised as G-import Data.GraphViz.Types.Common(partitionGlobal)-import qualified Data.GraphViz.Types.State as St-import Data.GraphViz.Attributes.Same-import Data.GraphViz.Attributes.Complete(Attributes)-import Data.GraphViz.Util(groupSortBy, groupSortCollectBy)-import Data.GraphViz.Algorithms(CanonicaliseOptions(..), canonicaliseOptions)-import Data.GraphViz.Algorithms.Clustering+import           Data.GraphViz.Algorithms            (CanonicaliseOptions(..),+                                                      canonicaliseOptions)+import           Data.GraphViz.Algorithms.Clustering+import           Data.GraphViz.Attributes.Complete   (Attributes)+import           Data.GraphViz.Attributes.Same+import           Data.GraphViz.Internal.Util         (groupSortBy,+                                                      groupSortCollectBy)+import           Data.GraphViz.Types+import qualified Data.GraphViz.Types.Canonical       as C+import qualified Data.GraphViz.Types.Generalised     as G+import           Data.GraphViz.Types.Internal.Common (partitionGlobal)+import qualified Data.GraphViz.Types.State           as St -import Data.List(foldl', delete, unfoldr)-import qualified Data.Foldable as F-import Data.Maybe(mapMaybe, fromMaybe)-import qualified Data.Map as M-import Data.Map(Map)-import qualified Data.Set as S-import qualified Data.Sequence as Seq-import Control.Arrow((***))-import Control.Monad(liftM, liftM2)-import Text.Read(Lexeme(Ident), lexP, parens, readPrec)-import Text.ParserCombinators.ReadPrec(prec)+import           Control.Applicative             (liftA2, (<|>))+import           Control.Arrow                   ((***))+import qualified Data.Foldable                   as F+import           Data.List                       (delete, foldl', unfoldr)+import           Data.Map                        (Map)+import qualified Data.Map                        as M+import           Data.Maybe                      (fromMaybe, mapMaybe,+                                                  maybeToList)+import qualified Data.Sequence                   as Seq+import qualified Data.Set                        as S+import           Text.ParserCombinators.ReadPrec (prec)+import           Text.Read                       (Lexeme(Ident), lexP, parens,+                                                  readPrec) +#if !(MIN_VERSION_base (4,8,0))+import Control.Applicative ((<$>), (<*>))+#endif+ -- -----------------------------------------------------------------------------  -- | A Dot graph that allows graph operations on it.@@ -133,7 +141,7 @@  -- | It should be safe to substitute 'unsafeFromCanonical' for --   'fromCanonical' in the output of this.-instance (Ord n, Show n) => Show (DotGraph n) where+instance (Show n) => Show (DotGraph n) where   showsPrec d dg = showParen (d > 10) $                    showString "fromCanonical " . shows (toCanonical dg) @@ -182,7 +190,7 @@                deriving (Eq, Ord, Show, Read)  adjacent :: Context n -> [DotEdge n]-adjacent c = mapU (flip DotEdge n) (predecessors c)+adjacent c = mapU (`DotEdge` n) (predecessors c)              ++ mapU (DotEdge n) (successors c)   where     n = node c@@ -216,14 +224,16 @@ (Cntxt n mc as ps ss) & dg = withValues merge dg'   where     ps' = toMap ps-    ps'' = M.delete n ps'+    ps'' = fromMap (M.delete n ps')     ss' = toMap ss-    ss'' = M.delete n ss'+    ss'' = fromMap (M.delete n ss')      dg' = addNode n mc as dg -    merge = addSucc n ps'' . addPred n ss''+    merge = addSuccRev n ps'' . addPredRev n ss''+            -- Add reverse edges             . M.adjust (\ni -> ni { _predecessors = ps', _successors = ss' }) n+            -- Add actual edges  infixr 5 & @@ -233,26 +243,26 @@ composeList :: (Ord n) => [Context n] -> DotGraph n composeList = foldr (&) emptyGraph -addSucc :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n-addSucc = addPS niSucc+addSuccRev :: (Ord n) => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n+addSuccRev = addEdgeLinks niSkip niSucc -addPred :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n-addPred = addPS niPred+addPredRev :: (Ord n) => n -> [(n, Attributes)] -> NodeMap n -> NodeMap n+addPredRev = addEdgeLinks niSkip niPred -addPS :: (Ord n) => ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)-         -> n -> EdgeMap n -> NodeMap n -> NodeMap n-addPS fni t fas nm = t `seq` foldl' addSucc' nm fas'+addEdgeLinks :: (Ord n) => UpdateEdgeMap n -> UpdateEdgeMap n+                -> n -> [(n, Attributes)] -> NodeMap n -> NodeMap n+addEdgeLinks fwd rev f tas = updRev . updFwd   where-    fas' = fromMap fas+    updFwd = M.adjust addFwd f -    addSucc' nm' (f,as) = f `seq` M.alter (addS as) f nm'+    addFwd ni = foldl' (\ni' (t,as) -> fwd (M.insertWith (++) t [as]) ni') ni tas -    addS as = Just-              . maybe (error "Node not in the graph!")-                      (fni (M.insertWith (++) t [as]))+    updRev nm = foldl' (\nm' (t,as) -> M.adjust (addRev as) t nm') nm tas --- | Add a node to the current graph.  Throws an error if the node---   already exists in the graph.+    addRev as = rev (M.insertWith (++) f [as])++-- | Add a node to the current graph. Merges attributes and edges if+--   the node already exists in the graph. -- --   If the specified cluster does not yet exist in the graph, then it --   will be added (as a sub-graph of the overall graph and no@@ -264,13 +274,17 @@            -> Attributes            -> DotGraph n            -> DotGraph n-addNode n mc as dg-  | n `M.member` ns = error "Node already exists in the graph"-  | otherwise       = addEmptyCluster mc-                      $ dg { values   = ns' }+addNode n mc as dg = addEmptyCluster mc $ dg { values = ns' }   where     ns = values dg-    ns' = M.insert n (NI mc as M.empty M.empty) ns+    ns' = M.insertWith mergeLogic n (NI mc as M.empty M.empty) ns+    mergeLogic (NI newClust newAttrs newPreds newSuccs) (NI oldClust oldAttrs oldPreds oldSuccs) =+        NI resClust resAttrs resPreds resSuccs+      where+        resClust = newClust <|> oldClust+        resAttrs = unSame $ S.union (toSAttr newAttrs) (toSAttr oldAttrs)+        resPreds = M.unionWith (++) newPreds oldPreds+        resSuccs = M.unionWith (++) newSuccs oldSuccs  -- | A variant of 'addNode' that takes in a DotNode (not in a --   cluster).@@ -283,9 +297,7 @@ addEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n addEdge f t as = withValues merge   where-    -- Add the edge assuming it's directed; let the getter functions-    -- be smart regarding directedness.-    merge = addPred t (M.singleton f [as]) . addSucc f (M.singleton t [as])+    merge = addEdgeLinks niSucc niPred f [(t,as)]  -- | A variant of 'addEdge' that takes a 'DotEdge' value. addDotEdge                  :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n@@ -312,7 +324,7 @@  -- Used to make sure that the parent cluster exists addEmptyCluster :: Maybe GraphID -> DotGraph n -> DotGraph n-addEmptyCluster = maybe id (withClusters . flip dontReplace defCI)+addEmptyCluster = maybe id (withClusters . (`dontReplace` defCI))   where     dontReplace = M.insertWith (const id)     defCI = CI Nothing emptyGA@@ -335,12 +347,12 @@  -- | Create a graph with no clusters. mkGraph :: (Ord n) => [DotNode n] -> [DotEdge n] -> DotGraph n-mkGraph ns es = flip (foldl' (flip addDotEdge)) es+mkGraph ns es = flip (foldl' $ flip addDotEdge) es                 $ foldl' (flip addDotNode) emptyGraph ns  -- | Convert this DotGraph into canonical form.  All edges are found --   in the outer graph rather than in clusters.-toCanonical :: (Ord n) => DotGraph n -> C.DotGraph n+toCanonical :: DotGraph n -> C.DotGraph n toCanonical dg = C.DotGraph { C.strictGraph     = strictGraph dg                             , C.directedGraph   = directedGraph dg                             , C.graphID         = graphID dg@@ -361,7 +373,7 @@     lns = map (\ (n,ni) -> (n,(_inCluster ni, _attributes ni)))           . M.assocs $ values dg -    (cs,ns) = clustersToNodes pathOf id clustAs snd lns+    (cs,ns) = clustersToNodes pathOf (const True) id clustAs snd lns      pathOf (n,(c,as)) = pathFrom c (n,as)     pathFrom c ln = F.foldr C (N ln) . fromMaybe Seq.empty $ (`M.lookup`pM) =<< c@@ -445,7 +457,7 @@ -- | Delete the specified cluster, and makes any clusters or nodes --   within it be in its root cluster (or the overall graph if --   required).-deleteCluster      :: (Ord n) => GraphID -> DotGraph n -> DotGraph n+deleteCluster      :: GraphID -> DotGraph n -> DotGraph n deleteCluster c dg = withValues (M.map adjNode)                      . withClusters (M.map adjCluster . M.delete c)                      $ dg@@ -461,7 +473,7 @@     adjCluster ci = ci { parentCluster = adjParent $ parentCluster ci }  -- | Remove clusters with no sub-clusters and no nodes within them.-removeEmptyClusters :: (Ord n) => DotGraph n -> DotGraph n+removeEmptyClusters :: DotGraph n -> DotGraph n removeEmptyClusters dg = dg { clusters = cM' }   where     cM = clusters dg@@ -471,7 +483,7 @@     invNs = usedClustsIn . M.map _inCluster $ values dg      usedClustsIn = M.fromAscList-                   . map (liftM2 (,) (fst . head) (map snd))+                   . map ((,) <$> fst . head <*> map snd)                    . groupSortBy fst                    . mapMaybe (uncurry (fmap . flip (,)))                    . M.assocs@@ -489,7 +501,7 @@  -- | Determine if this graph has nodes or clusters. isEmptyGraph :: DotGraph n -> Bool-isEmptyGraph = liftM2 (&&) isEmpty (not . hasClusters)+isEmptyGraph = liftA2 (&&) isEmpty (not . hasClusters)  graphAttributes :: DotGraph n -> [GlobalAttributes] graphAttributes = fromGlobAttrs . graphAttrs@@ -506,7 +518,7 @@ --   equivalent to 'adjacentTo'. predecessorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n] predecessorsOf dg t-  | directedGraph dg = emToDE (flip DotEdge t)+  | directedGraph dg = emToDE (`DotEdge` t)                        . _predecessors $ values dg M.! t   | otherwise        = adjacentTo dg t @@ -524,10 +536,9 @@   where     ni = values dg M.! n     sucs = emToDE (DotEdge n) $ _successors ni-    preds = emToDE (flip DotEdge n) $ n `M.delete` _predecessors ni+    preds = emToDE (`DotEdge` n) $ n `M.delete` _predecessors ni -emToDE :: (Ord n) => (n -> Attributes -> DotEdge n)-          -> EdgeMap n -> [DotEdge n]+emToDE :: (n -> Attributes -> DotEdge n) -> EdgeMap n -> [DotEdge n] emToDE f = map (uncurry f) . fromMap  -- | Which cluster (or the root graph) is this cluster in?@@ -565,20 +576,23 @@    unAnonymise = id -- No anonymous clusters! +instance (Ord n) => G.FromGeneralisedDot DotGraph n where+  fromGeneralised = fromDotRepr+ instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n  -- | Uses the PrintDot instance for canonical 'C.DotGraph's.-instance (Ord n, PrintDot n) => PrintDot (DotGraph n) where+instance (PrintDot n) => PrintDot (DotGraph n) where   unqtDot = unqtDot . toCanonical  -- | Uses the ParseDot instance for generalised 'G.DotGraph's. instance (Ord n, ParseDot n) => ParseDot (DotGraph n) where-  parseUnqt = liftM fromGDot $ parseUnqt+  parseUnqt = fromGDot <$> parseUnqt     where       -- fromGDot :: G.DotGraph n -> DotGraph n-      fromGDot = fromDotRepr . flip asTypeOf (undefined :: G.DotGraph n)+      fromGDot = fromDotRepr . (`asTypeOf` (undefined :: G.DotGraph n))    parse = parseUnqt -- Don't want the option of quoting @@ -657,10 +671,10 @@                  -> Map n (EdgeMap n) toEdgeMap f t = M.map eM . M.fromList . groupSortCollectBy f t'   where-    t' = liftM2 (,) t edgeAttributes+    t' = liftA2 (,) t edgeAttributes     eM = M.fromList . groupSortCollectBy fst snd -mapNs :: (Ord n, Ord n') => (n -> n') -> DotGraph n -> DotGraph n'+mapNs :: (Ord n') => (n -> n') -> DotGraph n -> DotGraph n' mapNs f (DG st d as mid cs vs) = DG st d as mid cs                                  $ mapNM vs   where@@ -677,7 +691,7 @@      cl = M.mapWithKey addPath $ M.mapKeysMonotonic Just cgs -    addPath c as = ( maybe [] (:[]) $ c `M.lookup` pM+    addPath c as = ( maybeToList $ c `M.lookup` pM                    , as                    ) @@ -685,8 +699,7 @@                 (p' Seq.:> _) -> p'                 _             -> Seq.empty -getNodeInfo             :: (Ord n) => Bool -> DotGraph n-                           -> NodeLookup n+getNodeInfo             :: Bool -> DotGraph n -> NodeLookup n getNodeInfo withGlob dg = M.map toLookup ns   where     (gGlob, aM) = globAttrMap nodeAs dg@@ -699,11 +712,11 @@         as = _attributes ni         mp = _inCluster ni         pth = fromMaybe Seq.empty $ mp `M.lookup` pM-        pAs = fromMaybe gGlob $ flip M.lookup aM =<< mp+        pAs = fromMaybe gGlob $ (`M.lookup` aM) =<< mp         as' | withGlob  = unSame $ toSAttr as `S.union` pAs             | otherwise = as -getEdgeInfo             :: (Ord n) => Bool -> DotGraph n -> [DotEdge n]+getEdgeInfo             :: Bool -> DotGraph n -> [DotEdge n] getEdgeInfo withGlob dg = concatMap (uncurry mkDotEdges) es   where     gGlob = edgeAs $ graphAttrs dg@@ -732,7 +745,7 @@       where         as = af $ clusterAttrs ci         p = parentCluster ci-        pAs = fromMaybe gGlob $ flip M.lookup aM =<< p+        pAs = fromMaybe gGlob $ (`M.lookup` aM) =<< p  clusterPath :: DotGraph n -> Map (Maybe GraphID) St.Path clusterPath = M.mapKeysMonotonic Just . M.map (fmap Just) . clusterPath'@@ -747,12 +760,11 @@     pathOf c ci = pPth Seq.|> c       where         mp = parentCluster ci-        pPth = fromMaybe Seq.empty $ flip M.lookup pM =<< mp+        pPth = fromMaybe Seq.empty $ (`M.lookup` pM) =<< mp  -- ----------------------------------------------------------------------------- -withValues      :: (Ord n) => (NodeMap n -> NodeMap n)-                   -> DotGraph n -> DotGraph n+withValues      :: (NodeMap n -> NodeMap n) -> DotGraph n -> DotGraph n withValues f dg = dg { values = f $ values dg }  withClusters      :: (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)@@ -771,11 +783,16 @@                               , EdgeAttrs  $ unSame ea                               ] -niSucc      :: (Ord n) => (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n+type UpdateEdgeMap n = (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n++niSucc      :: UpdateEdgeMap n niSucc f ni = ni { _successors = f $ _successors ni } -niPred      :: (Ord n) => (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n+niPred      :: UpdateEdgeMap n niPred f ni = ni { _predecessors = f $ _predecessors ni }++niSkip      :: UpdateEdgeMap n+niSkip _ ni = ni  toMap :: (Ord n) => [(n, Attributes)] -> EdgeMap n toMap = M.fromAscList . groupSortCollectBy fst snd
+ Data/GraphViz/Types/Internal/Common.hs view
@@ -0,0 +1,551 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Types.Internal.Common+   Description : Common internal functions for dealing with overall types.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module provides common functions used by both+   "Data.GraphViz.Types" as well as "Data.GraphViz.Types.Generalised".+-}+module Data.GraphViz.Types.Internal.Common+       ( GraphID (..)+       , Number (..)+       , numericValue+       , GlobalAttributes (..)+       , partitionGlobal+       , unPartitionGlobal+       , withGlob+       , DotNode (..)+       , DotEdge (..)+       , parseEdgeLine+       , printGraphID+       , parseGraphID+       , printStmtBased+       , printStmtBasedList+       , printSubGraphID+       , parseSubGraph+       , parseBracesBased+       , parseStatements+       ) where++import Data.GraphViz.Attributes.Complete (Attribute(HeadPort, TailPort),+                                          Attributes, Number(..),+                                          usedByClusters, usedByGraphs,+                                          usedByNodes)+import Data.GraphViz.Attributes.Internal (PortPos, parseEdgeBasedPP)+import Data.GraphViz.Internal.State+import Data.GraphViz.Internal.Util+import Data.GraphViz.Parsing+import Data.GraphViz.Printing++import           Control.Monad       (unless, when)+import           Data.Maybe          (isJust)+import           Data.Text.Lazy      (Text)+import qualified Data.Text.Lazy      as T+import qualified Data.Text.Lazy.Read as T++#if !MIN_VERSION_base (4,13,0)+import Data.Monoid ((<>))+#endif++-- -----------------------------------------------------------------------------+-- This is re-exported by Data.GraphViz.Types++-- | A polymorphic type that covers all possible ID values allowed by+--   Dot syntax.  Note that whilst the 'ParseDot' and 'PrintDot'+--   instances for 'String' will properly take care of the special+--   cases for numbers, they are treated differently here.+data GraphID = Str Text+             | Num Number+             deriving (Eq, Ord, Show, Read)++instance PrintDot GraphID where+  unqtDot (Str str) = unqtDot str+  unqtDot (Num n)   = unqtDot n++  toDot (Str str) = toDot str+  toDot (Num n)   = toDot n++instance ParseDot GraphID where+  parseUnqt = stringNum <$> parseUnqt++  parse = stringNum <$> parse+          `adjustErr`+          ("Not a valid GraphID\n\t"++)++stringNum     :: Text -> GraphID+stringNum str = maybe checkDbl (Num . Int) $ stringToInt str+  where+    checkDbl = if isNumString True str+               then Num . Dbl $ toDouble str+               else Str str++numericValue           :: GraphID -> Maybe Int+numericValue (Str str) = either (const Nothing) (Just . round . fst)+                         $ T.signed T.double str+numericValue (Num n)   = case n of+                           Int i -> Just i+                           Dbl d -> Just $ round d++-- -----------------------------------------------------------------------------++-- Re-exported by Data.GraphViz.Types.*++-- | Represents a list of top-level list of 'Attribute's for the+--   entire graph/sub-graph.  Note that 'GraphAttrs' also applies to+--   'DotSubGraph's.+--+--   Note that Dot allows a single 'Attribute' to be listed on a line;+--   if this is the case then when parsing, the type of 'Attribute' it+--   is determined and that type of 'GlobalAttribute' is created.+data GlobalAttributes = GraphAttrs { attrs :: Attributes }+                      | NodeAttrs  { attrs :: Attributes }+                      | EdgeAttrs  { attrs :: Attributes }+                      deriving (Eq, Ord, Show, Read)++instance PrintDot GlobalAttributes where+  unqtDot = printAttrBased True printGlobAttrType globAttrType attrs++  unqtListToDot = printAttrBasedList True printGlobAttrType globAttrType attrs++  listToDot = unqtListToDot++-- GraphAttrs, NodeAttrs and EdgeAttrs respectively+partitionGlobal :: [GlobalAttributes] -> (Attributes, Attributes, Attributes)+partitionGlobal = foldr select ([], [], [])+  where+    select globA ~(gs,ns,es) = case globA of+                                 GraphAttrs as -> (as ++ gs, ns, es)+                                 NodeAttrs  as -> (gs, as ++ ns, es)+                                 EdgeAttrs  as -> (gs, ns, as ++ es)++unPartitionGlobal :: (Attributes, Attributes, Attributes) -> [GlobalAttributes]+unPartitionGlobal (gas,nas,eas) = [ GraphAttrs gas+                                  , NodeAttrs  nas+                                  , EdgeAttrs  eas+                                  ]++printGlobAttrType              :: GlobalAttributes -> DotCode+printGlobAttrType GraphAttrs{} = text "graph"+printGlobAttrType NodeAttrs{}  = text "node"+printGlobAttrType EdgeAttrs{}  = text "edge"++instance ParseDot GlobalAttributes where+  -- Not using parseAttrBased here because we want to force usage of+  -- Attributes.+  parseUnqt = do gat <- parseGlobAttrType++                 -- Determine if we need to set the attribute type.+                 let mtp = globAttrType $ gat [] -- Only need the constructor+                 oldTp <- getAttributeType+                 maybe (return ()) setAttributeType mtp++                 as <- whitespace *> parse++                 -- Safe to set back even if not changed.+                 setAttributeType oldTp+                 return $ gat as+              `onFail`+              fmap determineType parse++  parse = parseUnqt -- Don't want the option of quoting+          `adjustErr`+          ("Not a valid listing of global attributes\n\t"++)++  -- Have to do this manually because of the special case+  parseUnqtList = parseStatements parseUnqt++  parseList = parseUnqtList++-- Cheat: rather than determine whether it's a graph, cluster or+-- sub-graph just don't set it.+globAttrType :: GlobalAttributes -> Maybe AttributeType+globAttrType NodeAttrs{} = Just NodeAttribute+globAttrType EdgeAttrs{} = Just EdgeAttribute+globAttrType _           = Nothing++parseGlobAttrType :: Parse (Attributes -> GlobalAttributes)+parseGlobAttrType = oneOf [ stringRep GraphAttrs "graph"+                          , stringRep NodeAttrs "node"+                          , stringRep EdgeAttrs "edge"+                          ]++determineType :: Attribute -> GlobalAttributes+determineType attr+  | usedByGraphs attr   = GraphAttrs attr'+  | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case+  | usedByNodes attr    = NodeAttrs attr'+  | otherwise           = EdgeAttrs attr' -- Must be for edges.+  where+    attr' = [attr]++withGlob :: (Attributes -> Attributes) -> GlobalAttributes -> GlobalAttributes+withGlob f (GraphAttrs as) = GraphAttrs $ f as+withGlob f (NodeAttrs  as) = NodeAttrs  $ f as+withGlob f (EdgeAttrs  as) = EdgeAttrs  $ f as++-- -----------------------------------------------------------------------------++-- | A node in 'DotGraph'.+data DotNode n = DotNode { nodeID         :: n+                         , nodeAttributes :: Attributes+                         }+               deriving (Eq, Ord, Show, Read)++instance (PrintDot n) => PrintDot (DotNode n) where+  unqtDot = printAttrBased False printNodeID+                           (const $ Just NodeAttribute) nodeAttributes++  unqtListToDot = printAttrBasedList False printNodeID+                                     (const $ Just NodeAttribute) nodeAttributes++  listToDot = unqtListToDot++printNodeID :: (PrintDot n) => DotNode n -> DotCode+printNodeID = toDot . nodeID++instance (ParseDot n) => ParseDot (DotNode n) where+  parseUnqt = parseAttrBased NodeAttribute False parseNodeID++  parse = parseUnqt -- Don't want the option of quoting++  parseUnqtList = parseAttrBasedList NodeAttribute False parseNodeID++  parseList = parseUnqtList++parseNodeID :: (ParseDot n) => Parse (Attributes -> DotNode n)+parseNodeID = DotNode <$> parseAndCheck+  where+    parseAndCheck = do n <- parse+                       me <- optional parseUnwanted+                       maybe (return n) (const notANode) me+    notANode = fail "This appears to be an edge, not a node"+    parseUnwanted = oneOf [ parseEdgeType *> return ()+                          , character ':' *> return () -- PortPos value+                          ]++instance Functor DotNode where+  fmap f n = n { nodeID = f $ nodeID n }++-- -----------------------------------------------------------------------------++-- This is re-exported in Data.GraphViz.Types; defined here so that+-- Generalised can access and use parseEdgeLine (needed for "a -> b ->+-- c"-style edge statements).++-- | An edge in 'DotGraph'.+data DotEdge n = DotEdge { fromNode       :: n+                         , toNode         :: n+                         , edgeAttributes :: Attributes+                         }+               deriving (Eq, Ord, Show, Read)++instance (PrintDot n) => PrintDot (DotEdge n) where+  unqtDot = printAttrBased False printEdgeID+                           (const $ Just EdgeAttribute) edgeAttributes++  unqtListToDot = printAttrBasedList False printEdgeID+                                     (const $ Just EdgeAttribute) edgeAttributes++  listToDot = unqtListToDot++printEdgeID   :: (PrintDot n) => DotEdge n -> DotCode+printEdgeID e = do isDir <- getDirectedness+                   toDot (fromNode e)+                     <+> bool undirEdge' dirEdge' isDir+                     <+> toDot (toNode e)+++instance (ParseDot n) => ParseDot (DotEdge n) where+  parseUnqt = parseAttrBased EdgeAttribute False parseEdgeID++  parse = parseUnqt -- Don't want the option of quoting++  -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.+  parseUnqtList = concat <$> parseStatements parseEdgeLine++  parseList = parseUnqtList++parseEdgeID :: (ParseDot n) => Parse (Attributes -> DotEdge n)+parseEdgeID = ignoreSep mkEdge parseEdgeNode parseEdgeType parseEdgeNode+              `adjustErr`+              ("Parsed beginning of DotEdge but could not parse Attributes:\n\t"++)+              -- Parse both edge types just to be more liberal++type EdgeNode n = (n, Maybe PortPos)++-- | Takes into account edge statements containing something like+--   @a -> \{b c\}@.+parseEdgeNodes :: (ParseDot n) => Parse [EdgeNode n]+parseEdgeNodes = oneOf [ parseBraced (wrapWhitespace+                                      -- Should really use sepBy1, but this will do.+                                      $ parseStatements parseEdgeNode)+                       , sepBy1 parseEdgeNode (wrapWhitespace parseComma)+                       , (: []) <$> parseEdgeNode+                       ]++parseEdgeNode :: (ParseDot n) => Parse (EdgeNode n)+parseEdgeNode = liftA2 (,) parse+                           (optional $ character ':' *> parseEdgeBasedPP)++mkEdge :: EdgeNode n -> EdgeNode n -> Attributes -> DotEdge n+mkEdge (eFrom, mFP) (eTo, mTP) = DotEdge eFrom eTo+                                 . addPortPos TailPort mFP+                                 . addPortPos HeadPort mTP++mkEdges :: [EdgeNode n] -> [EdgeNode n]+           -> Attributes -> [DotEdge n]+mkEdges fs ts as = liftA2 (\f t -> mkEdge f t as) fs ts++addPortPos   :: (PortPos -> Attribute) -> Maybe PortPos+                -> Attributes -> Attributes+addPortPos c = maybe id ((:) . c)++parseEdgeType :: Parse Bool+parseEdgeType = wrapWhitespace $ stringRep True dirEdge+                                 `onFail`+                                 stringRep False undirEdge++parseEdgeLine :: (ParseDot n) => Parse [DotEdge n]+parseEdgeLine = do n1 <- parseEdgeNodes+                   ens <- many1 $ parseEdgeType *> parseEdgeNodes+                   let ens' = n1 : ens+                       efs = zipWith mkEdges ens' (tail ens')+                       ef = return $ \ as -> concatMap ($as) efs+                   parseAttrBased EdgeAttribute False ef++instance Functor DotEdge where+  fmap f e = e { fromNode = f $ fromNode e+               , toNode   = f $ toNode e+               }++dirEdge :: String+dirEdge = "->"++dirEdge' :: DotCode+dirEdge' = text $ T.pack dirEdge++undirEdge :: String+undirEdge = "--"++undirEdge' :: DotCode+undirEdge' = text $ T.pack undirEdge++-- -----------------------------------------------------------------------------+-- Labels++dirGraph :: String+dirGraph = "digraph"++dirGraph' :: DotCode+dirGraph' = text $ T.pack dirGraph++undirGraph :: String+undirGraph = "graph"++undirGraph' :: DotCode+undirGraph' = text $ T.pack undirGraph++strGraph :: String+strGraph = "strict"++strGraph' :: DotCode+strGraph' = text $ T.pack strGraph++sGraph :: String+sGraph = "subgraph"++sGraph' :: DotCode+sGraph' = text $ T.pack sGraph++clust :: String+clust = "cluster"++clust' :: DotCode+clust' = text $ T.pack clust++-- -----------------------------------------------------------------------------++printGraphID                 :: (a -> Bool) -> (a -> Bool)+                                -> (a -> Maybe GraphID)+                                -> a -> DotCode+printGraphID str isDir mID g = do setDirectedness isDir'+                                  bool empty strGraph' (str g)+                                    <+> bool undirGraph' dirGraph' isDir'+                                    <+> maybe empty toDot (mID g)+  where+    isDir' = isDir g++parseGraphID   :: (Bool -> Bool -> Maybe GraphID -> a) -> Parse a+parseGraphID f = do whitespace+                    str <- isJust <$> optional (parseAndSpace $ string strGraph)+                    dir <- parseAndSpace ( stringRep True dirGraph+                                           `onFail`+                                           stringRep False undirGraph+                                         )+                    setDirectedness dir+                    gID <- optional $ parseAndSpace parse+                    return $ f str dir gID++printStmtBased              :: (a -> DotCode) -> (a -> AttributeType)+                               -> (a -> stmts) -> (stmts -> DotCode)+                               -> a -> DotCode+printStmtBased f ftp r dr a = do gs <- getsGS id+                                 setAttributeType $ ftp a+                                 dc <- printBracesBased (f a) (dr $ r a)+                                 modifyGS (const gs)+                                 return dc++printStmtBasedList            :: (a -> DotCode) -> (a -> AttributeType)+                                 -> (a -> stmts) -> (stmts -> DotCode)+                                 -> [a] -> DotCode+printStmtBasedList f ftp r dr = vcat . mapM (printStmtBased f ftp r dr)++-- Can't use the 'braces' combinator here because we want the closing+-- brace lined up with the h value, which due to indentation might not+-- be the case with braces.+printBracesBased     :: DotCode -> DotCode -> DotCode+printBracesBased h i = vcat $ sequence [ h <+> lbrace+                                       , ind i+                                       , rbrace+                                       ]+  where+    ind = indent 4++-- | This /must/ only be used for sub-graphs, etc.+parseBracesBased      :: AttributeType -> Parse a -> Parse a+parseBracesBased tp p = do gs <- getsGS id+                           setAttributeType tp+                           a <- whitespace *> parseBraced (wrapWhitespace p)+                           modifyGS (const gs)+                           return a+                        `adjustErr`+                        ("Not a valid value wrapped in braces.\n\t"++)++printSubGraphID     :: (a -> (Bool, Maybe GraphID)) -> a -> DotCode+printSubGraphID f a = sGraph'+                      <+> maybe cl dtID mID+  where+    (isCl, mID) = f a+    cl = bool empty clust' isCl+    dtID = printSGID isCl++-- | Print the actual ID for a 'DotSubGraph'.+printSGID          :: Bool -> GraphID -> DotCode+printSGID isCl sID = bool noClust addClust isCl+  where+    noClust = toDot sID+    -- Have to manually render it as we need the un-quoted form.+    addClust = toDot . T.append (T.pack clust) . T.cons '_'+               . renderDot $ mkDot sID+    mkDot (Str str) = text str -- Quotes will be escaped later+    mkDot gid       = unqtDot gid++parseSubGraph         :: (Bool -> Maybe GraphID -> stmt -> c) -> Parse stmt -> Parse c+parseSubGraph pid pst = do (isC, fID) <- parseSubGraphID pid+                           let tp = bool SubGraphAttribute ClusterAttribute isC+                           fID <$> parseBracesBased tp pst++parseSubGraphID   :: (Bool -> Maybe GraphID -> c) -> Parse (Bool,c)+parseSubGraphID f = appl <$> (string sGraph *> whitespace1 *> parseSGID)+  where+    appl (isC, mid) = (isC, f isC mid)++parseSGID :: Parse (Bool, Maybe GraphID)+parseSGID = oneOf [ getClustFrom <$> parseAndSpace parse+                  , return (False, Nothing)+                  ]+  where+    -- If it's a String value, check to see if it's actually a+    -- cluster_Blah value; thus need to manually re-parse it.+    getClustFrom (Str str) = runParser' pStr str+    getClustFrom gid       = (False, Just gid)++    checkCl = stringRep True clust+    pStr = do isCl <- checkCl+                      `onFail`+                      return False+              when isCl $ optional (character '_') *> return ()+              sID <- optional pID+              let sID' = if sID == emptyID+                         then Nothing+                         else sID+              return (isCl, sID')++    emptyID = Just $ Str ""++    -- For Strings, there are no more quotes to unescape, so consume+    -- what you can.+    pID = stringNum <$> manySatisfy (const True)++{- This is a much nicer definition, but unfortunately it doesn't work.+   The problem is that Graphviz decides that a subgraph is a cluster+   if the ID starts with "cluster" (no quotes); thus, we _have_ to do+   the double layer of parsing to get it to work :@++            do isCl <- stringRep True clust+                       `onFail`+                       return False+               sID <- optional $ do when isCl+                                      $ optional (character '_') *> return ()+                                    parseUnqt+               when (isCl || isJust sID) $ whitespace1 *> return ()+               return (isCl, sID)+-}++-- The Bool is True for global, False for local.+printAttrBased                    :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)+                                     -> (a -> Attributes) -> a -> DotCode+printAttrBased prEmp ff ftp fas a = do oldType <- getAttributeType+                                       maybe (return ()) setAttributeType mtp+                                       oldCS <- getColorScheme+                                       (dc <> semi) <* unless prEmp (setColorScheme oldCS)+                                                    <* setAttributeType oldType+  where+    mtp = ftp a+    f = ff a+    dc = case fas a of+           [] | not prEmp -> f+           as -> f <+> toDot as++-- The Bool is True for global, False for local.+printAttrBasedList                    :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)+                                         -> (a -> Attributes) -> [a] -> DotCode+printAttrBasedList prEmp ff ftp fas = vcat . mapM (printAttrBased prEmp ff ftp fas)++-- The Bool is True for global, False for local.+parseAttrBased         :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse a+parseAttrBased tp lc p = do oldType <- getAttributeType+                            setAttributeType tp+                            oldCS <- getColorScheme+                            f <- p+                            atts <- tryParseList' (whitespace *> parse)+                            unless lc $ setColorScheme oldCS+                            when (tp /= oldType) $ setAttributeType oldType+                            return $ f atts+                         `adjustErr`+                         ("Not a valid attribute-based structure\n\t"++)++-- The Bool is True for global, False for local.+parseAttrBasedList       :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse [a]+parseAttrBasedList tp lc = parseStatements . parseAttrBased tp lc++-- | Parse the separator (and any other whitespace1 present) between statements.+statementEnd :: Parse ()+statementEnd = parseSplit *> newline'+  where+    parseSplit = (whitespace *> oneOf [ character ';' *> return ()+                                      , newline+                                      ]+                 )+                 `onFail`+                 whitespace1++parseStatements   :: Parse a -> Parse [a]+parseStatements p = sepBy (whitespace *> p) statementEnd+                    `discard`+                    optional statementEnd
Data/GraphViz/Types/Monadic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}  {- |    Module      : Data.GraphViz.Types.Monadic@@ -64,25 +64,38 @@        , nodeAttrs        , edgeAttrs          -- * Adding items to the graph.-         -- ** Clusters+         -- ** Subgraphs and clusters+       , subgraph+       , anonSubgraph        , cluster          -- ** Nodes        , node        , node'          -- ** Edges+         -- $edges        , edge        , (-->)        , (<->)        ) where -import Data.GraphViz.Attributes(Attributes)-import Data.GraphViz.Types.Common+import Data.GraphViz.Attributes        (Attributes) import Data.GraphViz.Types.Generalised -import qualified Data.DList as DL-import Data.DList(DList)+import           Data.DList    (DList)+import qualified Data.DList    as DL import qualified Data.Sequence as Seq +#if !(MIN_VERSION_base (4,8,0))+import Control.Applicative (Applicative(..))+import Data.Monoid         (Monoid(..))+#endif++#if MIN_VERSION_base (4,9,0) && !MIN_VERSION_base (4,13,0)+import Data.Semigroup (Semigroup(..))+#endif++import Control.Monad.Fix (MonadFix (mfix))+ -- ----------------------------------------------------------------------------- -- The Dot monad. @@ -97,14 +110,35 @@ execDot :: DotM n a -> DotStmts n execDot = snd . runDot +instance Functor (DotM n) where+  fmap f (DotM (a,stmts)) = DotM (f a, stmts)++instance Applicative (DotM n) where+  pure = DotM . flip (,) DL.empty++  (DotM (f,stmts1)) <*> (DotM (a,stmts2)) = DotM (f a, stmts1 `DL.append` stmts2)+ instance Monad (DotM n) where-  return a = DotM (a, DL.empty)+  return = pure    dt >>= f = DotM              $ let ~(a,stmts)  = runDot dt                    ~(b,stmts') = runDot $ f a                in (b, stmts `DL.append` stmts') +instance MonadFix (DotM n) where+  mfix m = let (a,n) = runDot $ m a+           in  DotM (a,n)++#if MIN_VERSION_base (4,9,0)+instance Semigroup a => Semigroup (DotM n a) where+  DotM x1 <> DotM x2 = DotM (x1 <> x2)+#endif++instance Monoid a => Monoid (DotM n a) where+  mappend (DotM x1) (DotM x2) = DotM (mappend x1 x2)+  mempty = DotM mempty+ tell :: DotStmts n -> Dot n tell = DotM . (,) () @@ -149,21 +183,21 @@ convertStatements = Seq.fromList . map convertStatement . DL.toList  data DotStmt n = MA GlobalAttributes-               | MC (Cluster n)+               | MS (Subgraph n)                | MN (DotNode n)                | ME (DotEdge n)  convertStatement          :: DotStmt n -> DotStatement n convertStatement (MA gas) = GA gas-convertStatement (MC cl)  = SG . DotSG True (Just $ clID cl)-                                 . execStmts $ clStmts cl+convertStatement (MS sg)  = SG . DotSG (sgIsClust sg) (sgID sg)+                                 . execStmts $ sgStmts sg convertStatement (MN dn)  = DN dn convertStatement (ME de)  = DE de  -- ----------------------------------------------------------------------------- -- Global Attributes --- | Add graph/sub-graph/cluster attributes.+-- | Add graph\/sub-graph\/cluster attributes. graphAttrs :: Attributes -> Dot n graphAttrs = tellStmt . MA . GraphAttrs @@ -176,15 +210,32 @@ edgeAttrs = tellStmt . MA . EdgeAttrs  -- -------------------------------------------------------------------------------- Clusters+-- Subgraphs (including Clusters) -data Cluster n = Cl { clID    :: GraphID-                    , clStmts :: Dot n-                    }+data Subgraph n = Sg { sgIsClust :: Bool+                     , sgID      :: Maybe GraphID+                     , sgStmts   :: Dot n+                     } +-- | Add a named subgraph to the graph.+subgraph :: GraphID -> DotM n a -> Dot n+subgraph = nonClust . Just++-- | Add an anonymous subgraph to the graph.+--+--   It is highly recommended you use 'subgraph' instead.+anonSubgraph :: DotM n a -> Dot n+anonSubgraph = nonClust Nothing++nonClust :: Maybe GraphID -> DotM n a -> Dot n+nonClust = createSubGraph False++createSubGraph :: Bool -> Maybe GraphID -> DotM n a -> Dot n+createSubGraph isCl mid = tellStmt . MS . Sg isCl mid . (>> return ())+ -- | Add a named cluster to the graph.-cluster     :: GraphID -> DotM n a -> Dot n-cluster cid = tellStmt . MC . Cl cid . (>> return ())+cluster :: GraphID -> DotM n a -> Dot n+cluster = createSubGraph True . Just  -- ----------------------------------------------------------------------------- -- Nodes@@ -195,11 +246,28 @@  -- | Add a node with no attributes to the graph. node' :: n -> Dot n-node' = flip node []+node' = (`node` [])  -- ----------------------------------------------------------------------------- -- Edges +{- $edges++   If you wish to use something analogous to Dot's ability to write+   multiple edges with in-line subgraphs such as:++   > {a b c} -> {d e f}++   Then you can use '-->' and '<->' in combination with monadic+   traversal functions such as @traverse_@, @for_@, @mapM_@, @forM_@+   and @zipWithM_@; for example:++   > ("a" -->) `traverse_` ["d", "e", "f"]+   > ["a", "b", "c"] `for_` (--> "d")+   > zipWithM_ (-->) ["a", "b", "c"] ["d", "e", "f"]++ -}+ -- | Add an edge to the graph. edge     :: n -> n -> Attributes -> Dot n edge f t = tellStmt . ME . DotEdge f t@@ -217,4 +285,3 @@ infixr 9 <->  -- ------------------------------------------------------------------------------
Data/GraphViz/Types/State.hs view
@@ -34,22 +34,22 @@        , addEdge        ) where -import Data.GraphViz.Types.Common-import Data.GraphViz.Attributes.Complete( Attributes-                                        , usedByClusters, usedByGraphs)+import Data.GraphViz.Attributes.Complete   (Attributes, usedByClusters,+                                            usedByGraphs) import Data.GraphViz.Attributes.Same+import Data.GraphViz.Types.Internal.Common -import Data.Function(on)-import qualified Data.DList as DList-import Data.DList(DList)-import qualified Data.Map as Map-import Data.Map(Map)-import qualified Data.Set as Set-import qualified Data.Sequence as Seq-import Data.Sequence(Seq, (|>), ViewL(..))-import Control.Arrow((&&&), (***))-import Control.Monad(when)-import Control.Monad.Trans.State+import           Control.Arrow       ((&&&), (***))+import           Control.Monad       (when)+import           Control.Monad.State (State, execState, gets, modify)+import           Data.DList          (DList)+import qualified Data.DList          as DList+import           Data.Function       (on)+import           Data.Map            (Map)+import qualified Data.Map            as Map+import           Data.Sequence       (Seq, ViewL(..), (|>))+import qualified Data.Sequence       as Seq+import qualified Data.Set            as Set  -- ----------------------------------------------------------------------------- @@ -121,7 +121,7 @@  getGraphInfo :: GraphState a -> (GlobalAttributes, ClusterLookup) getGraphInfo = ((graphGlobal . globalAttrs) &&& (convert . value))-               . flip execState initState+               . (`execState` initState)   where     convert = Map.map ((uniq . DList.toList) *** toGlobal)     toGlobal = GraphAttrs . filter usedByClusters . unSame@@ -160,19 +160,19 @@  type NodeLookup' n = Map n NodeInfo -data NodeInfo = NI { atts :: SAttrs-                   , gAtts :: SAttrs -- from globals+data NodeInfo = NI { atts     :: SAttrs+                   , gAtts    :: SAttrs -- from globals                    , location :: Path                    }               deriving (Eq, Ord, Show, Read)  type NodeState n a = GVState (NodeLookup' n) a -toDotNodes :: (Ord n) => NodeLookup n -> [DotNode n]+toDotNodes :: NodeLookup n -> [DotNode n] toDotNodes = map (\(n,(_,as)) -> DotNode n as) . Map.assocs -getNodeLookup       :: (Ord n) => Bool -> NodeState n a -> NodeLookup n-getNodeLookup addGs = Map.map combine . value . flip execState initState+getNodeLookup       :: Bool -> NodeState n a -> NodeLookup n+getNodeLookup addGs = Map.map combine . value . (`execState` initState)   where     initState = SV Set.empty addGs Seq.empty Map.empty     combine ni = (location ni, unSame $ atts ni `Set.union` gAtts ni)@@ -230,7 +230,7 @@ type EdgeState n a = GVState (DList (DotEdge n)) a  getDotEdges       :: Bool -> EdgeState n a -> [DotEdge n]-getDotEdges addGs = DList.toList . value . flip execState initState+getDotEdges addGs = DList.toList . value . (`execState` initState)   where     initState = SV Set.empty addGs Seq.empty DList.empty @@ -242,4 +242,4 @@ addEdge de@DotEdge{edgeAttributes = as}   = do gas <- getGlobals        let de' = de { edgeAttributes = unSame $ unionWith gas as }-       modifyValue $ flip DList.snoc de'+       modifyValue $ (`DList.snoc` de')
− Data/GraphViz/Util.hs 
@@ -1,165 +0,0 @@-{-# LANGUAGE OverloadedStrings, PatternGuards #-}-{-# OPTIONS_HADDOCK hide #-}--{- |-   Module      : Data.GraphViz.Util-   Description : Internal utility functions-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines internal utility functions.--}-module Data.GraphViz.Util where--import Data.Char( isAsciiUpper-                , isAsciiLower-                , isDigit-                , ord-                )--import Data.List(groupBy, sortBy)-import Data.Maybe(isJust)-import Data.Function(on)-import qualified Data.Set as Set-import Data.Set(Set)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.Read as T-import Data.Text.Lazy(Text)-import Control.Monad(liftM2)---- -------------------------------------------------------------------------------isIDString :: Text -> Bool-isIDString = maybe False (\(f,os) -> frstIDString f && T.all restIDString os)-             . T.uncons---- | First character of a non-quoted 'String' must match this.-frstIDString   :: Char -> Bool-frstIDString c = any ($c) [ isAsciiUpper-                          , isAsciiLower-                          , (==) '_'-                          , (\ x -> ord x >= 128)-                          ]---- | The rest of a non-quoted 'String' must match this.-restIDString   :: Char -> Bool-restIDString c = frstIDString c || isDigit c---- | Determine if this String represents a number.-isNumString     :: Text -> Bool-isNumString ""  = False-isNumString "-" = False-isNumString str = case T.uncons $ T.toLower str of-                    Just ('-',str') -> go str'-                    _               -> go str-  where-    -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all-    -- possible cases-    go s = uncurry go' $ T.span isDigit s-    go' ds nds-      | T.null nds = True-      | T.null ds && nds == "." = False-      | T.null ds-      , Just ('.',nds') <- T.uncons nds-      , Just (d,nds'') <- T.uncons nds' = isDigit d && checkEs' nds''-      | Just ('.',nds') <- T.uncons nds = checkEs $ T.dropWhile isDigit nds'-      | T.null ds = False-      | otherwise = checkEs nds-    checkEs' s = case T.break ('e' ==) s of-                   ("", _) -> False-                   (ds,es) -> T.all isDigit ds && checkEs es-    checkEs str' = case T.uncons str' of-                     Nothing       -> True-                     Just ('e',ds) -> isIntString ds-                     _             -> False--{---- | This assumes that 'isNumString' is 'True'.-toDouble     :: Text -> Double-toDouble str = case T.uncons $ T.toLower str of-                 Just ('-', str') -> toD $ '-' `T.cons` adj str'-                 _                -> toD $ adj str-  where-    adj s = T.cons '0'-            $ case T.span ('.' ==) s of-                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'-                (ds, ds') | Just ('.',es) <- T.uncons ds'-                          , Just ('e',es') <- T.uncons es-                            -> ds `T.snoc` '.' `T.snoc` '0'-                                   `T.snoc` 'e' `T.snoc` '0' `T.append` es'-                _         -> s-    toD = either (const $ error "Not a Double") fst . T.signed T.double--}--- | This assumes that 'isNumString' is 'True'.-toDouble     :: Text -> Double-toDouble str = case T.uncons $ T.toLower str of-                 Just ('-', str') -> toD $ '-' `T.cons` adj str'-                 _                -> toD $ adj str-  where-    adj s = T.cons '0'-            $ case T.span ('.' ==) s of-                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'-                (ds, ds') | Just ('.',es) <- T.uncons ds'-                          , Just ('e',_) <- T.uncons es-                            -> ds `T.snoc` '.' `T.snoc` '0' `T.append` es-                _              -> s-    toD = read . T.unpack--isIntString :: Text -> Bool-isIntString = isJust . stringToInt---- | Determine if this String represents an integer.-stringToInt     :: Text -> Maybe Int-stringToInt str = case T.signed T.decimal str of-                       Right (n, "") -> Just n-                       _             -> Nothing---- | Graphviz requires double quotes to be explicitly escaped.-escapeQuotes           :: String -> String-escapeQuotes []        = []-escapeQuotes ('"':str) = '\\':'"': escapeQuotes str-escapeQuotes (c:str)   = c : escapeQuotes str---- | Remove explicit escaping of double quotes.-descapeQuotes                :: String -> String-descapeQuotes []             = []-descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str-descapeQuotes (c:str)        = c : descapeQuotes str--isKeyword :: Text -> Bool-isKeyword = flip Set.member keywords . T.toLower---- | The following are Dot keywords and are not valid as labels, etc. unquoted.-keywords :: Set Text-keywords = Set.fromList [ "node"-                        , "edge"-                        , "graph"-                        , "digraph"-                        , "subgraph"-                        , "strict"-                        ]---- -------------------------------------------------------------------------------uniq :: (Ord a) => [a] -> [a]-uniq = uniqBy id--uniqBy   :: (Ord b) => (a -> b) -> [a] -> [a]-uniqBy f = map head . groupSortBy f--groupSortBy   :: (Ord b) => (a -> b) -> [a] -> [[a]]-groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)--groupSortCollectBy     :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]-groupSortCollectBy f g = map (liftM2 (,) (f . head) (map g)) . groupSortBy f---- | Fold over 'Bool's; first param is for 'False', second for 'True'.-bool       :: a -> a -> Bool -> a-bool f t b = if b-             then t-             else f--isSingle     :: [a] -> Bool-isSingle [_] = True-isSingle _   = False
− FAQ 
@@ -1,644 +0,0 @@-% FAQ-% Ivan Lazar Miljenovic--Fortuitously Anticipated Queries (FAQ)-======================================--Note that to distinguish it from [Graphviz], the library shall be-henceforth referred to as _graphviz_.--Graphviz vs _graphviz_-------------------------### What is the difference between Graphviz and _graphviz_? ###--[Graphviz] is an open source library and collection of utility-programs using that library to visualise [graphs] (which are specified-using the [Dot] language).--_graphviz_ is a library for the purely functional programming language-[Haskell] that provides "bindings" to Graphviz's programs.  It does so-by allowing programmers to specify the layout of the graph and then-converts that to Dot code before calling the appropriate program to-perform the visualisation.--[Graphviz]: http://www.graphviz.org/-[graphs]: http://en.wikipedia.org/wiki/Graph_theory-[Dot]: http://www.graphviz.org/doc/info/lang.html-[Haskell]: http://haskell.org/--### Why should I use graphviz over one of the other Haskell Graphviz libraries? ###--Various Haskell libraries have support for Graphviz to one extent or-another; however _graphviz_ has the most comprehensive support-available out of all of them:--* There are [four different representations] of Dot graphs:--       1. Canonical, which matches the layout of `dot -Tcanon`.-       2. Generalised, which allows statements to be in any order.-       3. A graph-based one that allows manipulation of the Dot graph.-       4. A monadic interface for embedding graphs in Haskell.--    There are also conversion functions between them.-- [four different representations]: #whats-the-difference-between-the-different-dotgraph-types--* The ability to parse and generate most aspects of Dot [syntax] and-  [attributes].  This includes taking into account escaping and-  quoting rules where applicable.--  [syntax]: http://graphviz.org/doc/info/lang.html-  [attributes]: http://graphviz.org/doc/info/attrs.html--* The ability to use a custom node type for Dot graphs.--* Support for the all five layout algorithm programs and all specified-  [output formats] as well as the ability to use custom programs, etc.--  [output formats]: http://www.graphviz.org/doc/info/output.html--* Functions to convert [FGL] graphs and other graph-like structures-  (albeit not as nicely) to and from the internal Dot representations.-  In future, this will be expanded to a much larger range of-  graph-like values once a suitable abstraction is available.--  [FGL]: http://web.engr.oregonstate.edu/~erwig/fgl/haskell/--* The ability to augment Dot and FGL graphs with positioning-  information by round-trip passing through Graphviz.--* Pure Haskell implementations of `dot -Tcanon` and `tred`.--* _graphviz_ is continually being worked upon and expanded to better-  suit/match the requirements of Graphviz, to improve performance and-  to make it easier for the programmer to use.--### Is the API of _graphviz_ stable? ###--For the most part, yes: the only items that are likely to change in-the future are those with bugs/errors or if a radically better way of-doing things is found.  For most uses, however, the API should not-change for the foreseeable future.--Note that _graphviz_'s version numbers follow the-[package versioning policy]; this means that you can immediately tell-when the API has had a backwards-incompatible change by comparing the-first two elements of the version.  However, these changes won't-always affect most users.--[package versioning policy]: http://www.haskell.org/haskellwiki/Package_versioning_policy--### What aspects of Dot syntax and attributes are covered? ###--It's easier to state which aspects of Dot [syntax] and [attributes]-_aren't_ covered:--#### Overall syntax items not covered ####--* Cannot specify a sub-graph as an end point in an edge;--* Comments, pre-processor lines and split lines are (currently) not-  supported within HTML-like labels.--* _graphviz_ only uses UTF-8 encoding for printing and parsing-  (whereas Graphviz allows Latin1 encoding with the `charset`-  attribute).--* Graphviz is more liberal in accepting "invalid" values-  (e.g. accepting a floating-point value when only integer values are-  meant to be accepted); _graphviz_ is more strict in this aspect (and-  will indeed throw an exception if it cannot parse something-  properly).--* No extensions (e.g. postscript-specific attributes) are available.--#### Attribute and value items not covered ####--* The global `orientation` attribute is not defined; however its-  behaviour is duplicated by the `rotate` attribute.--* The deprecated `overlap` algorithms have not been defined.--* `pointf` and `point` values have been combined into one datatype; as-  such, when constructing values such as `Rect` care should be taken-  about which parts of a `Point` are allowed.--* Only polygon-based `shape`s are available.--* The `charset` attribute is not available as _graphviz_ assumes that-  all Dot graphs will be in UTF-8 for simplicity; if Latin1-encoded-  graphs need to be parsed then you shall need to do all I/O for them-  by hand.--* `colorscheme` attributes _are_ parsed, but the behaviour is not-  quite the same: consider the following minimal Dot graph:--    ~~~~~ {.dot}-    digraph {-        a [ style=filled, fillcolor=gray, colorscheme=svg ]-    }-    ~~~~~--    Despite the fact that the color is specified before the colorscheme,-    Graphviz will use that colorscheme to parse the color (as an SVG-    gray differs from the X11 gray); _graphviz_, however, will use the-    default colorscheme of `x11` to parse the color, and **then** set-    the colorscheme to be `svg` (despite it not being used after it is-    set).--#### Available items of note ####--There are a few items of note that are available that are worthy of-special note (as they may not be immediately obvious from the-generated documentation):--* _graphviz_ is able to parse (but not print) the following special-  aspects of specifying edges in Dot code:--    - The `node:port` method of specifying of head/tail `portPos`-      values.--    - Stating multiple edges with common interior nodes (e.g. `a -> b-      -> c`).--    - Stating edges with a grouping of nodes (e.g. `a -> {b c}`).--* Sub-graphs are specified as being clusters when the subgraph name-  starts with either `"cluster"` or `"cluster_"`; note that this-  prefix is removed when determining the subraph's name for the-  internal datatypes.--* Anonymous subgraphs (where not even the `subgraph` keyword is-  specified) are also parseable.--* HTML-like and record labels are available, and feature proper-  escaping/unescaping when printing/parsing.--* Other syntactic issues are taken care of for you automatically (such-  as escaping/unescaping quotation marks).  Even newlines are-  automatically escaped (but not unescaped) for you, defaulting to-  centered lines.--Getting _graphviz_ and more documentation--------------------------------------------### Where can I obtain _graphviz_? ###--The best place to get _graphviz_ is from its [HackageDB] page.--[HackageDB]: http://hackage.haskell.org/package/graphviz--### Where can I find the API documentation for _graphviz_? ###--Also on its [HackageDB] page.--### Is it safe to install and use _graphviz_ from its darcs repository? ###--No; unlike other projects I make no guarantees as to the stability of-the live version of _graphviz_.  Whilst the [darcs] [repository] is-_usually_ stable, it's often in a state of flux and at times patches-that break the repository are recorded (when it's simpler/cleaner to-break one patch into several smaller patches).--[darcs]: http://darcs.net/-[repository]: http://code.haskell.org/graphviz/--### How is _graphviz_ licensed? ###--_graphviz_ is licensed under a [3-Clause BSD License] (note that the-ColorBrewer Color Schemes found in `Data.GraphViz.Attributes.Colors.Brewer`-are covered under-[their own license](http://graphviz.org/doc/info/colors.html#brewer_license)).--[3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php--Simplistically, this means that you can do whatever you want with-_graphviz_ as long as you cite both myself and [Matthew Sackman] (the-original author) as being the authors of _graphviz_.  However, I would-appreciate at least an [email] letting me know how _graphviz_ is being-used.--[Matthew Sackman]: http://www.wellquite.org/-[email]: mailto:Ivan.Miljenovic+graphviz@gmail.com--### Where can I find more information on _graphviz_? ###--From its [home page].--[home page]: http://projects.haskell.org/graphviz/--### Are there any tutorials on how to use _graphviz_? ###--A basic tutorial on-[how to visualise graph-like data](http://ivanmiljenovic.wordpress.com/2011/10/16/graphviz-in-vacuum/)-is available; more will come if people ask for it.--### What other packages use _graphviz_? ###--This is a list of all known packages that use _graphviz_: if you know-of any others please let me know and I'll add it to the list.--* [Graphalyze](http://hackage.haskell.org/package/Graphalyze)-* [SourceGraph](http://hackage.haskell.org/package/SourceGraph)--### What is the history of _graphviz_? ###--_graphviz_ was originally written by [Matthew Sackman] (if you want-his reasons for doing so, you'll have to ask him yourself) with the-first known release being on 10 July, 2008.  In 2008 I (Ivan-Miljenovic) needed a library that provided bindings to Graphviz with-clustering support; at the time _graphviz_ was the most fully featured-and closest to what I wanted, so I submitted a patch that provided-support for both clustering and undirected graphs.--In April 2009, Matthew wanted to step down from maintaining _graphviz_-and asked if I wanted to take over.  Since then the library has been-almost completely re-written with greatly improved coverage of the Dot-language and extra features.  However, the original outline of the-library still remains.--Using _graphviz_-------------------### Can I start using _graphviz_ without knowing anything about Graphviz? ###--You can, but if you want to start doing anything more advanced then-you should be reading Graphviz's documentation as well as-_graphviz_'s.  This is because the layout and design of _graphviz_ is-heavily based upon the Dot language and the various [attributes] that-Graphviz supports.--### Can I just use _graphviz_ without reading its documentation? ###--You should _at least_ read the various messages about possible-ambiguities, etc. at the top of each module and for the attributes you-use before you use _graphviz_.--### Do I need to have Graphviz installed to use _graphviz_? ###--Technically, no if you're only dealing with the Dot language aspects.-However, usage of the functions in the `Commands` module, or the-augmentation of pretty-printing functions in the GraphViz module _do_-require Graphviz to be installed.--### Why didn't you use FFI to bind to the Graphviz library? ###--Because I just kept working where [Matthew Sackman] left off and it-was already using Graphviz's tools rather than the actual library.-However, most other language bindings (for Python, Perl, etc.) seem to-do the same: generate Dot code and pass that to the relevant tool.--This, however, does provide a fortunate side effect where the ability-to print and parse Dot code means that _graphviz_ can be used for more-than just visualising graphs created solely in Haskell: it can also-import pre-defined graphs, or else generate Dot code for use with-other tools.--### What's the difference between the different DotGraph types? ###--_graphviz_ has four different "implementations" of Dot code:--**Canonical:**--:   matches the output of `dot -Tcanon`.  Recommended for use when-    converting existing data into Dot (especially with the-    `graphElemsToDot` function in `Data.GraphViz`).--**Generalised:**--:   most closely matches the layout of actual Dot code, as such this is-    preferred when parsing in arbitrary Dot graphs.  Also useful in-    cases where you want to use the common Graphviz "hack" of specifying-    global attributes that don't apply to sub-graphs _after_ the-    sub-graphs in question.--**Graph:**--:   provides common graph operations on Dot graphs, based upon those-    found in the [FGL].--**Monadic:**--:   a nicer way of defining relatively static Dot graphs to embed within-    Haskell code, etc.  Loosely based (with permission!) upon Andy-    Gill's [dotgen] library.--[dotgen]: http://hackage.haskell.org/package/dotgen--### What's the best way to parse Dot code? ###--In both cases below, you should use the `parseDotGraph` function to-parse the Dot code: this is because it will strip out comments and-pre-processor lines and join together split lines (if any of these-remain the parser will fail).  Also, if you are not sure what the type-of the nodes are, use either String or else the `GraphID` type as it-explicitly caters for both Strings and numbers (whereas just assuming-it being a String will result in numbers being stored internally as a-String).--If you can, first run `dot -Tcanon` on the Dot code and parse it as a-`DotGraph` value.  This is because `DotGraph` types are easier to deal-with.--If, however, this isn't possible (e.g. it uses an image that isn't in-the current working directory) then use the `GDotGraph` type.--### There are too many attributes!!! Which ones should I use? ###--The `Data.GraphViz.Attributes` module contains a cut-down list of-recommended and commonly used attributes.--The entire list of attributes can be found in-`Data.GraphViz.Attributes.Complete`.  In particular, the following-attributes are **not** recommended for use:--* `Color` for anything except edge colours or gradients for nodes,-  clusters and graphs when using Graphviz >= 2.29.0 (and if you must,-  the border colour for a node).--* `ColorScheme`: just stick with X11 colours.--* `Comment`: pretty useless.  Enough said.--### Can I use any attribute wherever I want? ###--No: attributes are all defined in one big datatype for the sake of-simplicity, but not all attributes are valid in all places.  Read the-documentation (either for Graphviz or _graphviz_) to determine which is-suitable where.--### How can I use _graphviz_ to visualise non-FGL graphs? ###--The `graphElemsToDot` function allows you to visualise any graph for-which you can specify a list of labelled nodes and a list of labelled-edges.--### How can I use/process multiple graphs like Graphviz does? ###--At one stage, _graphviz_ supported dealing with lists of `DotGraph`s;-however, it was found to be faster to deal with each graph-individually rather than try to get Graphviz to deal with them all in-one go.  In future, once the problem causing this has been tracked-down and fixed this feature will be returned.--### How can I use custom datatypes for node IDs? ###--The important thing here is to ensure that your custom datatype has-defined instances of `PrintDot` and `ParseDot`.  Probably the easiest-way of doing this is to have functions that convert between your type-and `String` and let graphviz determine how to print and parse those.-Here is an example of a more difficult type that should be printed-like `"1: Foo"`:--~~~~~~~~~~~~~~~~~~~~ {.haskell}-data MyType = MyType String Int--instance PrintDot MyType where-  unqtDot (MyType s i) = unqtDot i <> colon <+> unqtDot s--  -- We have a space in there, so we need quotes.-  toDot = doubleQuotes . unqtDot--instance ParseDot MyType where-  parseUnqt = do i <- parseUnqt-                 character ':'-                 whitespace1-                 s <- parseUnqt-                 return $ MyType s i--  -- Has at least one space, so it will be quoted.-  parse = quotedParse parseUnqt-~~~~~~~~~~~~~~~~~~~~--Things to note from this example:--* Whilst `PrintDot` and `ParseDot` have default definitions for-  `toDot` and `parse`, they assume the datatype doesn't need quotes;-  as such if the value will-  [need quoting](http://www.graphviz.org/doc/info/lang.html), then you-  should do so explicitly.--* It is better to use the `PrintDot` instances for common types such-  as `Int` and `String` rather than using the pretty-printers inbuilt-  conversion functions (`int`, `text`, etc.) to ensure that-  quotations, etc. are dealt with correctly.--* Be as liberal as you can when parsing, especially with whitespace:-  when printing only one space is used, yet when parsing we use the-  `whitespace1` parsing combinator that will parse all whitespace-  characters (but it must consume _at least_ one; there is a variant-  that does not need to parse any).--### When parsing Dot code, do I have to worry about the case? ###--Not at all: _graphviz_'s parser is case-insensitive; however, the-correct case is checked first so there is a slight degradation in-performance when the wrong case is used.--### How do I set portPos values for nodes in edges? ###--Graphviz allows you to specify edges such as `from:a -> to:b` where-the nodes "from" and "to" are defined with either `RecordLabel` or-`Html.Label` labels and have different sections; the edge is then drawn-from the "a" section of the "from" node to the "b" section of the "to"-node.--Whilst _graphviz_ can parse this, you can't define this yourself;-instead, do it the manual way:--~~~~~~~~~~~~~~~~~~~~ {.haskell}-DotEdge "from" "to" True [ TailPort (LabelledPort (PN "a") Nothing)-                         , HeadPort (LabelledPort (PN "b") Nothing)-                         ]-~~~~~~~~~~~~~~~~~~~~--I realise that doing this manually isn't as convenient, but I am open-to suggestions on how this can be improved.--Note where `TailPort` and `HeadPort` are used; the next question-explains this.--### Is there anything else I should know? ###--A few other things of note that you should know about:--* For an edge `a -> b`, Graphviz terms "a" to be the _tail_ node and-  "b" to be the _head_ node.--* When creating `GraphID` values for the graphs and sub-graphs, you-  should ensure that they won't clash with any of the `nodeID` values-  when printed to avoid possible problems.--* It is a good idea to have unique IDs for sub-graphs to ensure that-  global attributes are applied only to items in that sub-graph and so-  that clusters aren't combined (it took me a _long_ time to find out-  that this was the case).--* You should specify an ID for the overall graph when outputting to a-  format such as SVG as it becomes the title of that image.--* Graphviz allows a node to be "defined" twice with different-  attributes; in practice they are combined into one node.  Running-  Dot code through `dot -Tcanon` before parsing removes this problem.--* Several attributes are defined with taking a list of items; all of-  these assume that the provided lists are non-empty (sub-values are a-  different story).--* If a particular Dot graph is not parseable, the parser throws an-  error rather than failing gracefully.--Design Decisions-------------------### Why does _graphviz_ use Polyparse rather than Parsec? ###--Short answer: because _graphviz_ was already using [Polyparse] when I-started working on it (and I hadn't done any parsing before so I had-no preference either way).--[Polyparse]: http://www.cs.york.ac.uk/fp/polyparse/--Longer answer: Polyparse has several advantages I feel over [Parsec]:--* Simpler types.-* Avoids the whole "but Parsec-3 is slower than Parsec-2" debate (with-  its associated baggage/problems).-* Few inbuilt combinators: since there is no inbuilt `character`-  parsing combinator, there are no problems with _graphviz_ using its-  own case-less one.-* [Easier backtracking](http://www.cs.york.ac.uk/fp/polyparse/#how)--[Parsec]: http://hackage.haskell.org/package/parsec--### Why do you have four different representations of Dot graphs? ###--_graphviz_ has [four different representations] of Dot graphs.  Apart-from the reasons given before, the canonical implementation was the-original representation, whereas the generalised one was only-introduced in the 2999.8.0.0 release and the other two in the-2999.12.0.0 release.--Note, however, that I was thinking of adding something like the-generalised implementation back around the time of the-[2999.0.0.0 release](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064436.html),-yet-[people didn't like the idea](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064442.html).--The graph-based implementation was added solely so I could write as-(un-yet finished) tutorial, and thought others might find it useful.-The monadic implementation came about as an attempt to encourage more-people to use _graphviz_ rather than other libraries such as [dotgen],-and I thought a nicer way of writing Dot graphs might help (the-initial plans involved complicated type-hackery to try and almost make-it a DSL for actual Dot code; however it ended up being too-complicated and unwieldy).--### Why are only FGL graphs supported? ###--Love them or hate them, [FGL] currently provides the best graph-datatype and library available for Haskell at this time.  As such, if-any one graph type had to be chosen to have conversion functions-written for it then FGL is the best option.  Furthermore, I needed FGL-graph support (which is the much more important reason!).--### Why are the version numbers so high? ###--To make sure the latest release has the highest version number:-Matthew Sackman originally made releases with date-based versioning,-but when I switched to using the [package versioning policy] I had to-change this.  I could have started with 2010.x.y.z or so, but at the-time I had initial hopes of introducing compatibility with other-graphs (not just [FGL] ones) soon and wanted to make that the-3000.0.0.0 release; however that has not yet come to pass.--### Why do you use the American spelling of colour in _graphviz_? ###--Because that's how Graphviz spells it, and I was following upstream to-avoid confusion.--Bugs, Feature Requests and Development-----------------------------------------### Do you have any future plans for _graphviz_? ###--Yes, I do!  See the TODO file for more information.--### Does _graphviz_ have a test suite? ###--Yes, there is: to get it, you have to build it with the `test` flag-enabled; for example:--~~~~~~~~~~~~~~~~~~~~ {.bash}-cabal install graphviz --flags=test-~~~~~~~~~~~~~~~~~~~~--Then run the `graphviz-testsuite` executable.  This test suite uses-[QuickCheck] to ensure that _graphviz_ can parse the Dot code it-generates (as well as a few other things).  Note that it isn't-perfect: there are no guarantees that the Dot graphs that are-generated are indeed valid, and those more extensive tests are not yet-available.--[QuickCheck]: http://hackage.haskell.org/package/QuickCheck--Furthermore, you can do more controlled testing to try and track down-the source of a bug as the above flag will also expose several-testing modules which give you access to the various tests used as-well as the `Arbitrary` instances for use with [QuickCheck].--For proper testing of real-life Dot code, there is also the-`TestParsing.hs` script that comes in the _graphviz_ tarball (but is-not installed).  Once you have _graphviz_ installed you can just run-this script, passing it any files containing Dot graphs you wish to-test.  It will attempt to parse each Dot graph as a `GDotGraph`, and-then test to see if the canonicalised form is parseable as a-`DotGraph`.--### I've found a bug! ###--Oh-oh... please [email] me the specifics of what you were doing-(including the Dot file in question if it's a parsing problem) and-I'll get right on it.--### I have a feature request. ###--Is it in the TODO?  If not, [email] me and I'll consider implementing-it (depending on time and how well I think it will fit in the overall-library).--### I want to help out with developing _graphviz_. ###--Great!  Whether you have a specific feature in mind or want to help-clear the TODO list, please [email] me to check with what you're doing-(who knows, I could already be implementing that very feature).--Once we've discussed what you're going to do, first get yourself a-copy of the darcs repository:--~~~~~~~~~~~~~~~~~~~~ {.bash}-darcs get --lazy http://code.haskell.org/graphviz-~~~~~~~~~~~~~~~~~~~~--Once you've made your changes, make sure you build and run the-testsuite (and ensure it passes!).  Then record the patch[es] and-`darcs send` them.  I'll then review them and if I'm happy with them,-I'll apply them.--### What is the purpose of the AttributeGenerator.hs file? ###--Graphviz has a large number of attributes.  Rather than try to edit-everything manually each time I want to change how I use the large-`Attribute` datatype, the AttributeGenerator script generates the-datatype, instances, etc. for me.--<!---     Local Variables:-     mode:markdown-     End:-  -->---<!--  LocalWords:  graphviz- -->
+ FAQ.md view
@@ -0,0 +1,624 @@++Fortuitously Anticipated Queries (FAQ)+======================================++Note that to distinguish it from [Graphviz], the library shall be+henceforth referred to as _graphviz_.++Graphviz vs _graphviz_+----------------------++### What is the difference between Graphviz and _graphviz_? ###++[Graphviz] is an open source library and collection of utility+programs using that library to visualise [graphs] (which are specified+using the [Dot] language).++_graphviz_ is a library for the purely functional programming language+[Haskell] that provides "bindings" to Graphviz's programs.  It does so+by allowing programmers to specify the layout of the graph and then+converts that to Dot code before calling the appropriate program to+perform the visualisation.++[Graphviz]: http://www.graphviz.org/+[graphs]: http://en.wikipedia.org/wiki/Graph_theory+[Dot]: http://www.graphviz.org/doc/info/lang.html+[Haskell]: http://haskell.org/++### Why should I use graphviz over one of the other Haskell Graphviz libraries? ###++Various Haskell libraries have support for Graphviz to one extent or+another; however _graphviz_ has the most comprehensive support+available out of all of them:++* There are [four different representations] of Dot graphs:++       1. Canonical, which provides a clean separated definition of a+          Dot graph (that matches the former layout of `dot -Tcanon`).+       2. Generalised, which allows statements to be in any order.+       3. A graph-based one that allows manipulation of the Dot graph.+       4. A monadic interface for embedding relatively static graphs+          in Haskell.++    There are also conversion functions between them.++ [four different representations]: #whats-the-difference-between-the-different-dotgraph-types++* The ability to parse and generate most aspects of Dot [syntax] and+  [attributes].  This includes taking into account escaping and+  quoting rules where applicable.++  [syntax]: http://graphviz.org/doc/info/lang.html+  [attributes]: http://graphviz.org/doc/info/attrs.html++* The ability to use a custom node type for Dot graphs.++* Support for all stated layout algorithm programs and all specified+  [output formats] as well as the ability to use custom programs, etc.++  [output formats]: http://www.graphviz.org/doc/info/output.html++* Functions to convert [FGL] graphs and other graph-like structures+  (albeit not as nicely) to and from the internal Dot representations.+  In future, this will be expanded to a much larger range of+  graph-like values once a suitable abstraction is available.++  [FGL]: http://web.engr.oregonstate.edu/~erwig/fgl/haskell/++* The ability to augment Dot and FGL graphs with positioning+  information by round-trip passing through Graphviz.++* Pure Haskell implementations of `dot -Tcanon` and `tred`.++* _graphviz_ is continually being worked upon and expanded to better+  suit/match the requirements of Graphviz, to improve performance and+  to make it easier for the programmer to use.++### Is the API of _graphviz_ stable? ###++For the most part, yes: the only items that are likely to change in+the future are those with bugs/errors or if a radically better way of+doing things is found.  For most uses, however, the API should not+change for the foreseeable future.++Note that _graphviz_'s version numbers follow the+[package versioning policy]; this means that you can immediately tell+when the API has had a backwards-incompatible change by comparing the+first two elements of the version.  However, these changes won't+always affect most users.++[package versioning policy]: http://www.haskell.org/haskellwiki/Package_versioning_policy++### What aspects of Dot syntax and attributes are covered? ###++It's easier to state which aspects of Dot [syntax] and [attributes]+_aren't_ covered:++#### Overall syntax items not covered ####++* Cannot specify a sub-graph as an end point in an edge;++* Comments, pre-processor lines and split lines are (currently) not+  supported within HTML-like labels.++* _graphviz_ only uses UTF-8 encoding for printing and parsing+  (whereas Graphviz allows Latin1 encoding with the `charset`+  attribute).++* Graphviz is more liberal in accepting "invalid" values+  (e.g. accepting a floating-point value when only integer values are+  meant to be accepted); _graphviz_ is more strict in this aspect (and+  will indeed throw an exception if it cannot parse something+  properly).++* No extensions (e.g. postscript-specific attributes) are available.++#### Attribute and value items not covered ####++* The global `orientation` attribute is not defined; however its+  behaviour is duplicated by the `rotate` attribute.++* The deprecated `overlap` algorithms have not been defined, and the+  ability to specify an integer prefix for use with the `fdp` layout+  tool is not available.++* The deprecated `shapefile` attribute is not available; instead, you+  should specify the file on the command line.++* The deprecated `z` attribute is not available; use the optional+  third dimension for the `pos` attribute instead.++* Only polygon-based `shape`s are available (i.e. no custom shapes as+  yet).++* The `charset` attribute is not available as _graphviz_ assumes that+  all Dot graphs will be in UTF-8 for simplicity; if Latin1-encoded+  graphs need to be parsed then you shall need to do all I/O for them+  by hand.++* `colorscheme` attributes _are_ parsed, but the behaviour is not+  quite the same: consider the following minimal Dot graph:++    ~~~~~ {.dot}+    digraph {+        a [ style=filled, fillcolor=gray, colorscheme=svg ]+    }+    ~~~~~++    Despite the fact that the color is specified before the colorscheme,+    Graphviz will use that colorscheme to parse the color (as an SVG+    gray differs from the X11 gray); _graphviz_, however, will use the+    default colorscheme of `x11` to parse the color, and **then** set+    the colorscheme to be `svg` (despite it not being used after it is+    set).++#### Available items of note ####++There are a few items of note that are available that are worthy of+special note (as they may not be immediately obvious from the+generated documentation):++* _graphviz_ is able to parse (but not print) the following special+  aspects of specifying edges in Dot code:++    - The `node:port` method of specifying of head/tail `portPos`+      values.++    - Stating multiple edges with common interior nodes (e.g. `a -> b+      -> c`).++    - Stating edges with a grouping of nodes (e.g. `a -> {b c}`).++* Sub-graphs are specified as being clusters when the subgraph name+  starts with either `"cluster"` or `"cluster_"`; note that this+  prefix is removed when determining the subraph's name for the+  internal datatypes.++* Anonymous subgraphs (where not even the `subgraph` keyword is+  specified) are also parseable.++* HTML-like and record labels are available, and feature proper+  escaping/unescaping when printing/parsing.++* Other syntactic issues are taken care of for you automatically (such+  as escaping/unescaping quotation marks).  Even newlines are+  automatically escaped (but not unescaped) for you, defaulting to+  centered lines.++Getting _graphviz_ and more documentation+-----------------------------------------++### Where can I obtain _graphviz_? ###++The best place to get _graphviz_ is from its [HackageDB] page.++[HackageDB]: http://hackage.haskell.org/package/graphviz++### Where can I find the API documentation for _graphviz_? ###++Also on its [HackageDB] page.++### Is it safe to install and use _graphviz_ from its git repository? ###++No; unlike other projects I make no guarantees as to the stability of+the live version of _graphviz_.  Whilst the [git] [repository] is+_usually_ stable, it's often in a state of flux and at times patches+that break the repository are recorded (when it's simpler/cleaner to+break one patch into several smaller patches).++[git]: http://git-scm.com/+[repository]: https://github.com/ivan-m/graphviz/++### How is _graphviz_ licensed? ###++_graphviz_ is licensed under a [3-Clause BSD License] (note that the+ColorBrewer Color Schemes found in `Data.GraphViz.Attributes.Colors.Brewer`+are covered under+[their own license](http://graphviz.org/doc/info/colors.html#brewer_license)).++[3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php++Simplistically, this means that you can do whatever you want with+_graphviz_ as long as you cite both myself and [Matthew Sackman] (the+original author) as being the authors of _graphviz_.  However, I would+appreciate at least an [email] letting me know how _graphviz_ is being+used.++[Matthew Sackman]: http://www.wellquite.org/+[email]: mailto:Ivan.Miljenovic@gmail.com++### Where can I find more information on _graphviz_? ###++From its [home page].++[home page]: http://projects.haskell.org/graphviz/++### Are there any tutorials on how to use _graphviz_? ###++A basic tutorial on+[how to visualise graph-like data](http://ivanmiljenovic.wordpress.com/2011/10/16/graphviz-in-vacuum/)+is available; more will come if people ask for it.++### What other packages use _graphviz_? ###++This is a list of all known packages that use _graphviz_: if you know+of any others please let me know and I'll add it to the list.++* [Graphalyze](http://hackage.haskell.org/package/Graphalyze)+* [SourceGraph](http://hackage.haskell.org/package/SourceGraph)++### What is the history of _graphviz_? ###++_graphviz_ was originally written by [Matthew Sackman] (if you want+his reasons for doing so, you'll have to ask him yourself) with the+first known release being on 10 July, 2008.  In 2008 I (Ivan+Miljenovic) needed a library that provided bindings to Graphviz with+clustering support; at the time _graphviz_ was the most fully featured+and closest to what I wanted, so I submitted a patch that provided+support for both clustering and undirected graphs.++In April 2009, Matthew wanted to step down from maintaining _graphviz_+and asked if I wanted to take over.  Since then the library has been+almost completely re-written with greatly improved coverage of the Dot+language and extra features.  However, the original outline of the+library still remains.++Using _graphviz_+----------------++### Can I start using _graphviz_ without knowing anything about Graphviz? ###++You can, but if you want to start doing anything more advanced then+you should be reading Graphviz's documentation as well as+_graphviz_'s.  This is because the layout and design of _graphviz_ is+heavily based upon the Dot language and the various [attributes] that+Graphviz supports.++### Can I just use _graphviz_ without reading its documentation? ###++You should _at least_ read the various messages about possible+ambiguities, etc. at the top of each module and for the attributes you+use before you use _graphviz_.++### Do I need to have Graphviz installed to use _graphviz_? ###++Technically, no if you're only dealing with the Dot language aspects.+However, usage of the functions in the `Commands` module, or the+augmentation of pretty-printing functions in the GraphViz module _do_+require Graphviz to be installed.++### Why didn't you use FFI to bind to the Graphviz library? ###++Because I just kept working where [Matthew Sackman] left off and it+was already using Graphviz's tools rather than the actual library.+However, most other language bindings (for Python, Perl, etc.) seem to+do the same: generate Dot code and pass that to the relevant tool.++This, however, does provide a fortunate side effect where the ability+to print and parse Dot code means that _graphviz_ can be used for more+than just visualising graphs created solely in Haskell: it can also+import pre-defined graphs, or else generate Dot code for use with+other tools.++### What's the difference between the different DotGraph types? ###++_graphviz_ has four different "implementations" of Dot code:++**Canonical:**++:   matches the (former) output of `dot -Tcanon`.  Recommended for use+    when converting existing data into Dot (especially with the+    `graphElemsToDot` function in `Data.GraphViz`).++**Generalised:**++:   most closely matches the layout of actual Dot code, as such this is+    preferred when parsing in arbitrary Dot graphs.  Also useful in+    cases where you want to use the common Graphviz "hack" of specifying+    global attributes that don't apply to sub-graphs _after_ the+    sub-graphs in question.++**Graph:**++:   provides common graph operations on Dot graphs, based upon those+    found in the [FGL].++**Monadic:**++:   a nicer way of defining relatively static Dot graphs to embed within+    Haskell code, etc.  Loosely based (with permission!) upon Andy+    Gill's [dotgen] library.++[dotgen]: http://hackage.haskell.org/package/dotgen++### What's the best way to parse Dot code? ###++Use the `parseDotGraph` function (rather than the general parsing+functions that are available) to parse your Dot code: this is will+strip out comments and pre-processor lines and join together split+lines (if any of these remain the parser will fail).  Also, if you are+not sure what the type of the nodes are, use either String or else the+`GraphID` type as it explicitly caters for both Strings and numbers+(whereas just assuming it being a String will result in numbers being+stored internally as a String).++Unless you are very sure of the representation of the Dot code you+have been provided, you should parse in any Dot code as the+`Generalised.DotGraph` type.  Afterwards you can use+`FromGeneralisedDot` to convert to whichever representation you+prefer.++### There are too many attributes!!! Which ones should I use? ###++The `Data.GraphViz.Attributes` module contains a cut-down list of+recommended and commonly used attributes.++The entire list of attributes can be found in+`Data.GraphViz.Attributes.Complete`.  In particular, the following+attributes are **not** recommended for use:++* `Color` for anything except edge colours or gradients for nodes,+  clusters and graphs when using Graphviz >= 2.29.0 (and if you must,+  the border colour for a node).++* `ColorScheme`: just stick with X11 colours.++* `Comment`: pretty useless.  Enough said.++### Can I use any attribute wherever I want? ###++No: attributes are all defined in one big datatype for the sake of+simplicity, but not all attributes are valid in all places.  Read the+documentation (either for Graphviz or _graphviz_) to determine which is+suitable where.++### How can I use _graphviz_ to visualise non-FGL graphs? ###++The `graphElemsToDot` function allows you to visualise any graph for+which you can specify a list of labelled nodes and a list of labelled+edges.++### How can I use/process multiple graphs like Graphviz does? ###++At one stage, _graphviz_ supported dealing with lists of `DotGraph`s;+however, it was found to be faster to deal with each graph+individually rather than try to get Graphviz to deal with them all in+one go.  In future, once the problem causing this has been tracked+down and fixed this feature will be returned.++### How can I use custom datatypes for node IDs? ###++The important thing here is to ensure that your custom datatype has+defined instances of `PrintDot` and `ParseDot`.  Probably the easiest+way of doing this is to have functions that convert between your type+and `String` or `Text` and let graphviz determine how to print and+parse those.  Here is an example of a more difficult type that should+be printed like `"1: Foo"`:++~~~~~~~~~~~~~~~~~~~~ {.haskell}+data MyType = MyType Int String++instance PrintDot MyType where+  unqtDot (MyType i s) = unqtDot i <> colon <+> unqtDot s++  -- We have a space in there, so we need quotes.+  toDot = doubleQuotes . unqtDot++instance ParseDot MyType where+  parseUnqt = MyType <$> parseUnqt+                     <*  character ':'+                     <*  whitespace1+                     <*> parseUnqt++  -- Has at least one space, so it will be quoted.+  parse = quotedParse parseUnqt+~~~~~~~~~~~~~~~~~~~~++Things to note from this example:++* Whilst `PrintDot` and `ParseDot` have default definitions for+  `toDot` and `parse`, they assume the datatype doesn't need quotes;+  as such if the value will+  [need quoting](http://www.graphviz.org/doc/info/lang.html), then you+  should do so explicitly.++* It is better to use the `PrintDot` instances for common types such+  as `Int` and `String` rather than using the pretty-printers inbuilt+  conversion functions (`int`, `text`, etc.) to ensure that+  quotations, etc. are dealt with correctly.++* Be as liberal as you can when parsing, especially with whitespace:+  when printing only one space is used, yet when parsing we use the+  `whitespace1` parsing combinator that will parse all whitespace+  characters (but it must consume _at least_ one; there is a variant+  that does not need to parse any).++### When parsing Dot code, do I have to worry about the case? ###++Not at all: _graphviz_'s parser is case-insensitive; however, the+correct case is checked first so there is a slight degradation in+performance when the wrong case is used.++### How do I set portPos values for nodes in edges? ###++Graphviz allows you to specify edges such as `from:a -> to:b` where+the nodes "from" and "to" are defined with either `RecordLabel` or+`Html.Label` labels and have different sections; the edge is then drawn+from the "a" section of the "from" node to the "b" section of the "to"+node.++Whilst _graphviz_ can parse this, you can't define this yourself;+instead, do it the manual way:++~~~~~~~~~~~~~~~~~~~~ {.haskell}+DotEdge "from" "to" True [ TailPort (LabelledPort (PN "a") Nothing)+                         , HeadPort (LabelledPort (PN "b") Nothing)+                         ]+~~~~~~~~~~~~~~~~~~~~++I realise that doing this manually isn't as convenient, but I am open+to suggestions on how this can be improved.++Note where `TailPort` and `HeadPort` are used; the next question+explains this.++### Is there anything else I should know? ###++A few other things of note that you should know about:++* For an edge `a -> b`, Graphviz terms "a" to be the _tail_ node and+  "b" to be the _head_ node.++* When creating `GraphID` values for the graphs and sub-graphs, you+  should ensure that they won't clash with any of the `nodeID` values+  when printed to avoid possible problems.++* It is a good idea to have unique IDs for sub-graphs to ensure that+  global attributes are applied only to items in that sub-graph and so+  that clusters aren't combined (it took me a _long_ time to find out+  that this was the case).++* You should specify an ID for the overall graph when outputting to a+  format such as SVG as it becomes the title of that image.++* Graphviz allows a node to be "defined" twice with different+  attributes; in practice they are combined into one node.  Running+  Dot code through `dot -Tcanon` before parsing removes this problem.++* Several attributes are defined with taking a list of items; all of+  these assume that the provided lists are non-empty (sub-values are a+  different story).++* If a particular Dot graph is not parseable, the parser throws an+  error rather than failing gracefully.++Design Decisions+----------------++### Why does _graphviz_ use Polyparse rather than Parsec? ###++Short answer: because _graphviz_ was already using [Polyparse] when I+started working on it (and I hadn't done any parsing before so I had+no preference either way).++[Polyparse]: http://www.cs.york.ac.uk/fp/polyparse/++Longer answer: Polyparse has several advantages I feel over [Parsec]:++* Simpler types.+* Avoids the whole "but Parsec-3 is slower than Parsec-2" debate (with+  its associated baggage/problems).+* Few inbuilt combinators: since there is no inbuilt `character`+  parsing combinator, there are no problems with _graphviz_ using its+  own case-less one.+* [Easier backtracking](http://www.cs.york.ac.uk/fp/polyparse/#how)++[Parsec]: http://hackage.haskell.org/package/parsec++### Why do you have four different representations of Dot graphs? ###++_graphviz_ has [four different representations] of Dot graphs.  Apart+from the reasons given before, the canonical implementation was the+original representation, whereas the generalised one was only+introduced in the 2999.8.0.0 release and the other two in the+2999.12.0.0 release.++Note, however, that I was thinking of adding something like the+generalised implementation back around the time of the+[2999.0.0.0 release](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064436.html),+yet+[people didn't like the idea](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064442.html).++The graph-based implementation was added solely so I could write an+(as-yet finished) tutorial, and thought others might find it useful.+The monadic implementation came about as an attempt to encourage more+people to use _graphviz_ rather than other libraries such as [dotgen],+and I thought a nicer way of writing Dot graphs might help (the+initial plans involved complicated type-hackery to try and almost make+it a DSL for actual Dot code; however it ended up being too+complicated and unwieldy).++### Why are only FGL graphs supported? ###++Love them or hate them, [FGL] currently provides the best graph+datatype and library available for Haskell at this time.  As such, if+any one graph type had to be chosen to have conversion functions+written for it then FGL is the best option.  Furthermore, I needed FGL+graph support (which is the much more important reason!).++### Why are the version numbers so high? ###++To make sure the latest release has the highest version number:+Matthew Sackman originally made releases with date-based versioning,+but when I switched to using the [package versioning policy] I had to+change this.  I could have started with 2010.x.y.z or so, but at the+time I had initial hopes of introducing compatibility with other+graphs (not just [FGL] ones) soon and wanted to make that the+3000.0.0.0 release; however that has not yet come to pass.++### Why do you use the American spelling of colour in _graphviz_? ###++Because that's how Graphviz spells it, and I was following upstream to+avoid confusion.++Bugs, Feature Requests and Development+--------------------------------------++### Do you have any future plans for _graphviz_? ###++Yes, I do!  See the TODO file for more information.++### Does _graphviz_ have a test suite? ###++Yes, there is, using the in-built support for test suites in Cabal:++~~~~~~~~~~~~~~~~~~~~ {.bash}+cabal install graphviz --enable-tests+~~~~~~~~~~~~~~~~~~~~++Then run the `graphviz-testsuite` executable.  This test suite uses+[QuickCheck] to ensure that _graphviz_ can parse the Dot code it+generates (as well as a few other things).  Note that it isn't+perfect: there are no guarantees that the Dot graphs that are+generated are indeed valid, and those more extensive tests are not yet+available.++[QuickCheck]: http://hackage.haskell.org/package/QuickCheck++Furthermore, you can do more controlled testing to try and track down+the source of a bug as the above flag will also expose several+testing modules which give you access to the various tests used as+well as the `Arbitrary` instances for use with [QuickCheck].++For proper testing of real-life Dot code, there is also the+`TestParsing.hs` script that comes in the _graphviz_ tarball (but is+not installed).  Once you have _graphviz_ installed you can just run+this script, passing it any files containing Dot graphs you wish to+test.  It will attempt to parse each Dot graph as a+`Generalised.DotGraph`, and then test to see if the canonicalised form+is parseable as a `DotGraph`.++### I've found a bug! ###++Oh-oh... please file a report at the GitHub [repository] to tell me+the specifics of what you were doing (including the Dot file in+question if it's a parsing problem) and I'll get right on it.++### I have a feature request. ###++Is it in the TODO?  If not, file an issue at the GitHub [repository]+and I'll consider implementing it (depending on time and how well I+think it will fit in the overall library).++### I want to help out with developing _graphviz_. ###++Great!  Whether you have a specific feature in mind or want to help+clear the TODO list, please create a pull-request on the GitHub+[repository].++### What is the purpose of the AttributeGenerator.hs file? ###++Graphviz has a large number of attributes.  Rather than try to edit+everything manually each time I want to change how I use the large+`Attribute` datatype, the AttributeGenerator script generates the+datatype, instances, etc. for me.
− LICENSE 
@@ -1,106 +0,0 @@-% License-% Ivan Lazar Miljenovic--Licensing Information-=====================--The overall graphviz library is covered by a [3-Clause BSD License].-However, the _ColorBrewer_ colours are licensed under their own-license.--[3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php--License for graphviz-----------------------Copyright (c) 2008, Matthew Sackman--Copyright (c) 2008 - 2010, [Ivan Lazar Miljenovic](mailto:Ivan.Miljenovic+graphviz@gmail.com)--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are-met:--   * Redistributions of source code must retain the above copyright-       notice, this list of conditions and the following disclaimer.--   * Redistributions in binary form must reproduce the above-       copyright notice, this list of conditions and the following-       disclaimer in the documentation and/or other materials-       provided with the distribution.--   * The names of the contributors to this software may not be used-       to endorse or promote products derived from this software-       without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--The ColorBrewer license--------------------------> The _ColorBrewer_ colours and colour schemes found in-> `Data.GraphViz.Attributes.Colors` are covered by the following-> license.  This text is not part of the license.--Apache-Style Software License for ColorBrewer software and ColorBrewer-Color Schemes, Version 1.1--Copyright (c) 2002 Cynthia Brewer, Mark Harrower, and The Pennsylvania-State University. All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are-met:--   1. Redistributions as source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--   2. The end-user documentation included with the redistribution, if-      any, must include the following acknowledgment:--      This product includes color specifications and designs developed-      by Cynthia Brewer (http://colorbrewer.org/).--      Alternately, this acknowledgment may appear in the software-      itself, if and wherever such third-party acknowledgments-      normally appear.--   3. The name "ColorBrewer" must not be used to endorse or promote-      products derived from this software without prior written-      permission. For written permission, please contact Cynthia-      Brewer at cbrewer@psu.edu.--   4. Products derived from this software may not be called-      "ColorBrewer", nor may "ColorBrewer" appear in their name,-      without prior written permission of Cynthia Brewer.--THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED-WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL CYNTHIA BREWER, MARK HARROWER, OR THE-PENNSYLVANIA STATE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT,-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,-BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS-OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR-TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE-USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-DAMAGE.--<!---     Local Variables:-     mode:markdown-     End:-  -->
+ LICENSE.md view
@@ -0,0 +1,98 @@++Licensing Information+=====================++The overall graphviz library is covered by a [3-Clause BSD License].+However, the _ColorBrewer_ colours are licensed under their own+license.++[3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php++License for graphviz+--------------------++Copyright (c) 2008, Matthew Sackman++Copyright (c) 2008 - 2010, [Ivan Lazar Miljenovic](mailto:Ivan.Miljenovic+graphviz@gmail.com)++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++   * Redistributions of source code must retain the above copyright+       notice, this list of conditions and the following disclaimer.++   * Redistributions in binary form must reproduce the above+       copyright notice, this list of conditions and the following+       disclaimer in the documentation and/or other materials+       provided with the distribution.++   * The names of the contributors to this software may not be used+       to endorse or promote products derived from this software+       without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++The ColorBrewer license+-----------------------++> The _ColorBrewer_ colours and colour schemes found in+> `Data.GraphViz.Attributes.Colors` are covered by the following+> license.  This text is not part of the license.++Apache-Style Software License for ColorBrewer software and ColorBrewer+Color Schemes, Version 1.1++Copyright (c) 2002 Cynthia Brewer, Mark Harrower, and The Pennsylvania+State University. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++   1. Redistributions as source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++   2. The end-user documentation included with the redistribution, if+      any, must include the following acknowledgment:++      This product includes color specifications and designs developed+      by Cynthia Brewer (http://colorbrewer.org/).++      Alternately, this acknowledgment may appear in the software+      itself, if and wherever such third-party acknowledgments+      normally appear.++   3. The name "ColorBrewer" must not be used to endorse or promote+      products derived from this software without prior written+      permission. For written permission, please contact Cynthia+      Brewer at cbrewer@psu.edu.++   4. Products derived from this software may not be called+      "ColorBrewer", nor may "ColorBrewer" appear in their name,+      without prior written permission of Cynthia Brewer.++THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL CYNTHIA BREWER, MARK HARROWER, OR THE+PENNSYLVANIA STATE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS+OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR+TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.
− README 
@@ -1,64 +0,0 @@-% Haskell bindings to the Graphviz toolkit-% Ivan Lazar Miljenovic--The graphviz Library-====================--The _graphviz_ library provides bindings to the [Graphviz] graph-visualisation suite of tools for the purely functional programming-language [Haskell].  It can be downloaded from [HackageDB] or - if you-have [cabal-install] - installing it is as simple as:--~~~~~~~~~~~~~~~~~~~~ {.bash}-cabal update-cabal install graphviz-~~~~~~~~~~~~~~~~~~~~--[Graphviz]: http://www.graphviz.org/-[Haskell]: http://haskell.org/-[HackageDB]: http://hackage.haskell.org/package/graphviz-[cabal-install]: http://haskell.org/haskellwiki/Cabal-Install--Library features-------------------Main features of the graphviz library include:--* Almost complete coverage of all Graphviz attributes and syntax.--* Support for specifying clusters.--* The ability to use a custom node type.--* Functions for running a Graphviz layout tool with all specified-  output types.--* The ability to not only generate but also parse Dot code with two-  options: strict and liberal (in terms of ordering of statements).--* Functions to convert [FGL] graphs and other graph-like data-  structures to Dot code - including support to group them into-  clusters - with a high degree of customisation by specifying which-  attributes to use and limited support for the inverse operation.--* Round-trip support for passing an [FGL] graph through Graphviz to-  augment node and edge labels with positional information, etc.--[FGL]: http://web.engr.oregonstate.edu/~erwig/fgl/haskell/--graphviz is free software licensed under a [3-Clause BSD License].--\(C\) 2008 [Matthew Sackman](http://www.wellquite.org/)--\(C\) 2008 - onwards [Ivan Lazar Miljenovic](http://ivanmiljenovic.wordpress.com/)--[3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php--For more information, feel free to-[email](mailto:Ivan.Miljenovic+graphviz@gmail.com) me.--<!---     Local Variables:-     mode:markdown-     End:-  -->
+ README.md view
@@ -0,0 +1,53 @@++The graphviz Library+====================++The _graphviz_ library provides bindings to the [Graphviz] graph+visualisation suite of tools for the purely functional programming+language [Haskell].  It can be downloaded from [HackageDB] or - if you+have [cabal-install] - installing it is as simple as:++~~~~~~~~~~~~~~~~~~~~ {.bash}+cabal update+cabal install graphviz+~~~~~~~~~~~~~~~~~~~~++[Graphviz]: http://www.graphviz.org/+[Haskell]: http://haskell.org/+[HackageDB]: http://hackage.haskell.org/package/graphviz+[cabal-install]: http://haskell.org/haskellwiki/Cabal-Install++Library features+----------------++Main features of the graphviz library include:++* Almost complete coverage of all Graphviz attributes and syntax.++* Support for specifying clusters.++* The ability to use a custom node type.++* Functions for running a Graphviz layout tool with all specified+  output types.++* The ability to not only generate but also parse Dot code with two+  options: strict and liberal (in terms of ordering of statements).++* Functions to convert [FGL] graphs and other graph-like data+  structures to Dot code - including support to group them into+  clusters - with a high degree of customisation by specifying which+  attributes to use and limited support for the inverse operation.++* Round-trip support for passing an [FGL] graph through Graphviz to+  augment node and edge labels with positional information, etc.++[FGL]: http://web.engr.oregonstate.edu/~erwig/fgl/haskell/++graphviz is free software licensed under a [3-Clause BSD License].++\(C\) 2008 [Matthew Sackman](http://www.wellquite.org/)++\(C\) 2008 - onwards [Ivan Lazar Miljenovic](http://ivanmiljenovic.wordpress.com/)++[3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php
− Setup.hs 
@@ -1,4 +0,0 @@-#!/usr/bin/env runghc--import Distribution.Simple-main = defaultMain
− TODO 
@@ -1,54 +0,0 @@-% TODO-% Ivan Lazar Miljenovic--Future Plans for graphviz-=========================--This is a list of planned feature improvements to graphviz along with-an indication of when it's likely to be implemented (note that these-time scales are in relation to releases, not actual time; however, it-is quite possible that the order will not be adhered to).--Short term-------------* Quickstart-style documentation to help users get going with graphviz-  quickly.--* Add nicer syntax for record labels, and specifying ports in Monadic-  Dot graphs.--* Define new classes to distinguish between printing/parsing Attribute-  values and other values (as only the former requires quoted-  variants).--* Clean up AttributeGenerator and get it to use a better-  pretty-printing library.--Medium term--------------* Improve the test suite such that the generated `DotGraph` values are-  valid (and thus can be passed to Graphviz proper).  This may not in-  fact be possible as guaranteeing an arbitrary `Attribute` is valid-  is rather tricky (as the value itself needs to be verified,-  especially stateful ones).--* Switch to a proper test-suite library rather than the hand-rolled-  one currently being used.--* Add support for clusters as endpoints of edges.--Long term------------* Allow usage of non-FGL graphs with graphviz.  This will require-  implementing a separate library to represent graphs (see initial-  discussions about this-  [here](http://www.haskell.org/pipermail/haskell-cafe/2009-June/063402.html)).--<!---     Local Variables:-     mode:markdown-     End:-  -->
+ TODO.md view
@@ -0,0 +1,51 @@++Future Plans for graphviz+=========================++This is a list of planned feature improvements to graphviz along with+an indication of when it's likely to be implemented (note that these+time scales are in relation to releases, not actual time; however, it+is quite possible that the order will not be adhered to).++Short term+----------++* Quickstart-style documentation to help users get going with graphviz+  quickly.++* Add nicer syntax for record labels, and specifying ports in Monadic+  Dot graphs.++* Add support for custom shapes; in particular, a nice way of+  re-defining the `Shape` datatype (as just adding a non-nullary+  constructor would make it unwieldy to make sure tests, etc. were+  kept up-to-date).++* Define new classes to distinguish between printing/parsing Attribute+  values and other values (as only the former requires quoted+  variants).++* Clean up AttributeGenerator and get it to use a better+  pretty-printing library.++Medium term+-----------++* Improve the test suite such that the generated `DotGraph` values are+  valid (and thus can be passed to Graphviz proper).  This may not in+  fact be possible as guaranteeing an arbitrary `Attribute` is valid+  is rather tricky (as the value itself needs to be verified,+  especially stateful ones).++* Switch to a proper test-suite library rather than the hand-rolled+  one currently being used.++* Add support for clusters as endpoints of edges.++Long term+---------++* Allow usage of non-FGL graphs with graphviz.  This will require+  implementing a separate library to represent graphs (see initial+  discussions about this+  [here](http://www.haskell.org/pipermail/haskell-cafe/2009-June/063402.html)).
graphviz.cabal view
@@ -1,6 +1,5 @@ Name:               graphviz-Version:            2999.13.0.3-Stability:          Beta+Version:            2999.20.2.1 Synopsis:           Bindings to Graphviz for graph visualisation. Description: { This library provides bindings for the Dot language used by the@@ -30,41 +29,39 @@   augment node and edge labels with positional information, etc. } -Homepage:           http://projects.haskell.org/graphviz/ Category:           Graphs, Graphics License:            BSD3-License-File:       LICENSE+License-File:       LICENSE.md Copyright:          Matthew Sackman, Ivan Lazar Miljenovic Author:             Matthew Sackman, Ivan Lazar Miljenovic-Maintainer:         Ivan.Miljenovic+graphviz@gmail.com+Maintainer:         Daniel Casanueva (coding `at` danielcasanueva.eu) Build-Type:         Simple-Cabal-Version:      >= 1.14-Extra-Source-Files: TODO-                    Changelog-                    README-                    FAQ-                    utils/AttributeGenerator.hs-                    utils/TestParsing.hs+Cabal-Version:      1.18+Extra-Doc-Files:    TODO.md, Changelog.md, README.md, FAQ.md+Extra-Source-Files: utils/AttributeGenerator.hs+Bug-Reports:        https://codeberg.org/daniel-casanueva/graphviz/issues -Source-Repository head-    Type:         darcs-    Location:     http://code.haskell.org/graphviz+Flag test-parsing+     Description: Build a utility to test parsing of available Dot code.+     Default:     False  Library {-        Default-Language:  Haskell98+        Default-Language:  Haskell2010 -        Build-Depends:     base == 4.*,+        Build-Depends:     base >=4.5.0.0 && <5,                            containers,                            process,-                           fgl == 5.4.*,+                           directory,+                           temporary >=1.1 && <1.4,+                           fgl >= 5.4 && < 5.9,                            filepath,-                           polyparse >= 1.7 && < 1.9,-                           bytestring == 0.9.*,+                           polyparse >=1.9 && <1.14,+                           bytestring >= 0.9,                            colour == 2.3.*,-                           transformers >= 0.2 && < 0.4,+                           mtl == 2.*,                            text,-                           wl-pprint-text,-                           dlist == 0.5.*+                           wl-pprint-text == 1.2.*,+                           dlist >= 0.5 && < 1.1          Exposed-Modules:   Data.GraphViz                            Data.GraphViz.Types@@ -87,71 +84,76 @@                            Data.GraphViz.Exception                            Data.GraphViz.Algorithms +                           Data.GraphViz.Attributes.Internal+                           Data.GraphViz.Internal.Util+                           Data.GraphViz.Internal.State+                           Data.GraphViz.Types.Internal.Common+         Other-Modules:     Data.GraphViz.Algorithms.Clustering+                           Data.GraphViz.Attributes.Arrows                            Data.GraphViz.Attributes.ColorScheme-                           Data.GraphViz.Attributes.Internal                            Data.GraphViz.Attributes.Same-                           Data.GraphViz.Types.Common+                           Data.GraphViz.Attributes.Values+                           Data.GraphViz.Commands.Available                            Data.GraphViz.Types.State-                           Data.GraphViz.Util-                           Data.GraphViz.State -        if True-           Ghc-Options: -Wall--        if impl(ghc >= 6.12.1)-           Ghc-Options: -fno-warn-unused-do-bind--        Ghc-Prof-Options:  -prof -auto-all+        Ghc-Options: -Wall }  Test-Suite graphviz-testsuite {-        Default-Language:  Haskell98+        Default-Language:  Haskell2010          Type:              exitcode-stdio-1.0          -- Versions controlled by library section         Build-Depends:     base,+                           graphviz,                            containers,-                           process,-                           fgl,+                           fgl >= 5.5.0.0,+                           fgl-arbitrary == 0.2.*,                            filepath,-                           polyparse,-                           bytestring,-                           colour,-                           transformers,+                           hspec >= 2.1 && < 3,                            text,-                           wl-pprint-text,-                           dlist,-                           QuickCheck >= 2.3 && < 2.5+                           QuickCheck >= 2.3 && < 2.16+        Build-Tool-Depends: hspec-discover:hspec-discover == 2.* -        hs-Source-Dirs:    . tests+        hs-Source-Dirs:    tests -        Main-Is:           RunTests.hs+        Main-Is:           Main.hs  -        Other-Modules:       Data.GraphViz.Testing-                             Data.GraphViz.Testing.Instances+        Other-Modules:       Data.GraphViz.Testing.Instances                              Data.GraphViz.Testing.Properties-                             Data.GraphViz.Testing.Instances.FGL                              Data.GraphViz.Testing.Instances.Helpers                              Data.GraphViz.Testing.Instances.Attributes                              Data.GraphViz.Testing.Instances.Common                              Data.GraphViz.Testing.Instances.Canonical                              Data.GraphViz.Testing.Instances.Generalised                              Data.GraphViz.Testing.Instances.Graph+                             Data.GraphViz.Testing.Proxy +                             Data.GraphVizSpec+                             Data.GraphViz.AlgorithmsSpec+                             Data.GraphViz.Attributes.CompleteSpec+                             Data.GraphViz.Attributes.HTMLSpec+                             Data.GraphViz.PreProcessingSpec+                             Data.GraphViz.Types.CanonicalSpec+                             Data.GraphViz.Types.GeneralisedSpec+                             Data.GraphViz.Types.GraphSpec++                             Spec+         if True-           Ghc-Options: -O -Wall+           Ghc-Options: -Wall          if impl(ghc >= 6.12.1)            Ghc-Options: -fno-warn-unused-do-bind -        GHC-Prof-Options: -auto-all -caf-all -rtsopts+        GHC-Prof-Options: -rtsopts }  Benchmark graphviz-printparse {-        Default-Language: Haskell98+        Default-Language: Haskell2010          Type:             exitcode-stdio-1.0 @@ -159,17 +161,37 @@                           deepseq,                           text,                           graphviz,-                          criterion >= 0.5 && < 0.7+                          criterion >= 0.5 && < 1.7          hs-Source-Dirs:   utils          Main-Is:          Benchmark.hs -        if True-           Ghc-Options: -O -Wall+        Ghc-Options: -Wall -        if impl(ghc >= 6.12.1)-           Ghc-Options: -fno-warn-unused-do-bind+        GHC-Prof-Options: -rtsopts+} -        GHC-Prof-Options: -auto-all -caf-all -rtsopts+Executable graphviz-testparsing {+        Default-Language: Haskell2010++        if flag(test-parsing)+           Buildable:     True+        else+           Buildable:     False++        hs-Source-Dirs:   utils++        Main-Is:          TestParsing.hs++        Build-Depends:    base,+                          graphviz,+                          bytestring,+                          directory,+                          filepath,+                          text++        Ghc-Options: -Wall++        GHC-Prof-Options: -rtsopts }
+ tests/Data/GraphViz/AlgorithmsSpec.hs view
@@ -0,0 +1,37 @@+{- |+   Module      : Data.GraphViz.AlgorithmsSpec+   Description : Testing algorithms+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.AlgorithmsSpec (spec) where++import Data.GraphViz.Algorithms         (CanonicaliseOptions)+import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_canonicalise,+                                         prop_canonicaliseEdges,+                                         prop_canonicaliseNodes,+                                         prop_transitive, prop_transitiveNodes)+import Data.GraphViz.Types.Canonical    (DotGraph)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)++--------------------------------------------------------------------------------++spec :: Spec+spec = do+  prop "Canonicalisation should be idempotent"+       (prop_canonicalise :: CanonicaliseOptions -> DotGraph Int -> Bool)+  prop "Canonicalisation shouldn't change any nodes"+       (prop_canonicaliseNodes :: CanonicaliseOptions -> DotGraph Int -> Bool)+  prop "Canonicalisation shouldn't change any edges"+       (prop_canonicaliseEdges :: CanonicaliseOptions -> DotGraph Int -> Bool)+  prop "Transitive reduction should be idempotent"+       (prop_transitive :: CanonicaliseOptions -> DotGraph Int -> Bool)+  prop "Transitive reduction shouldn't change any nodes"+       (prop_transitiveNodes :: CanonicaliseOptions -> DotGraph Int -> Bool)
+ tests/Data/GraphViz/Attributes/CompleteSpec.hs view
@@ -0,0 +1,26 @@+{- |+   Module      : Data.GraphViz.Attributes.CompleteSpec+   Description : Attribute testing+   Copyright   : Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.Attributes.CompleteSpec (spec) where++import Data.GraphViz.Attributes.Complete (Attributes)+import Data.GraphViz.Testing.Instances   ()+import Data.GraphViz.Testing.Properties  (prop_printParseListID)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck       (Property)++--------------------------------------------------------------------------------++spec :: Spec+spec =+  prop "Printing and parsing of attributes"+       (prop_printParseListID :: Attributes -> Property)
+ tests/Data/GraphViz/Attributes/HTMLSpec.hs view
@@ -0,0 +1,26 @@+{- |+   Module      : Data.GraphViz.Attributes.HTMLSpec+   Description : HTML label testing+   Copyright   : Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++   This is in addition to "Data.GraphViz.Attributes.CompleteSpec" as+   HTML labels are also likely to have their own quirks for testing.++ -}+module Data.GraphViz.Attributes.HTMLSpec (spec) where++import Data.GraphViz.Attributes.HTML    (Label)+import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_printParseID)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)++--------------------------------------------------------------------------------++spec :: Spec+spec =+  prop "Printing and parsing of HTML labels"+       (prop_printParseID :: Label -> Bool)
+ tests/Data/GraphViz/PreProcessingSpec.hs view
@@ -0,0 +1,24 @@+{- |+   Module      : Data.GraphViz.PreProcessingSpec+   Description : Test pre-processing+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.PreProcessingSpec where++import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_preProcessingID)+import Data.GraphViz.Types.Canonical    (DotGraph)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)++--------------------------------------------------------------------------------++spec :: Spec+spec = prop "Preprocessing doesn't change Dot code"+            (prop_preProcessingID :: DotGraph Int -> Bool)
− tests/Data/GraphViz/Testing.hs 
@@ -1,383 +0,0 @@-{-# LANGUAGE Rank2Types, FlexibleContexts #-}--{- |-   Module      : Data.GraphViz.Testing-   Description : Test-suite for graphviz.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This defines a test-suite for the graphviz library.--   Limitations of the test suite are as follows:--   * For the most part, this library lets you use arbitrary numbers-     for String values.  However, this is not tested due to too many-     corner cases for special parsers that don't take arbitrary-     Strings.  As the Dot standard is ambiguous over whether you can-     or can't use numbers as Strings (more specifically, if they-     should be quoted or not), this is a user beware situation.--   * Same goes for empty Strings; sometimes they're allowed, sometimes-     they're not.  Thus, to simplify matters they're not generated.--   * The generated Strings are very simple, only composed of lower-     case letters, digits and some symbols.  This is because too many-     tests were \"failing\" due to some corner case; e.g. lower-case-     letters only because the parser parses Strings as lowercase, so-     if a particular String isn't valid (e.g. @\"all\"@ for 'LayerID',-     then the 'Arbitrary' instance has to ensure that all possible-     ways of capitalising that String isn't generated as a random-     'LRName'.--   * The generated 'DotRepr's are not guaranteed to be valid.--   * To avoid needless endless recursion, sub-graphs do not have their-     own internal sub-graphs.--   * This test suite isn't perfect: if you deliberately try to stuff-     something up, you probably can.--}-module Data.GraphViz.Testing-       ( -- * Running the test suite.-         runChosenTests-       , runTests-       , runTest-         -- ** The tests themselves-       , Test(..)-       , defaultTests-       , test_printParseID_Attributes-       , test_generalisedSameDot-       , test_printParseID-       , test_preProcessingID-       , test_dotizeAugment-       , test_dotizeAugmentUniq-       , test_canonicalise-       , test_transitive-        -- * Re-exporting modules for manual testing.-       , module Data.GraphViz-       , module Data.GraphViz.Testing.Properties-         -- * Debugging printing-       , PrintDot(..)-       , printIt-       , renderDot-         -- * Debugging parsing-       , ParseDot(..)-       , parseIt-       , parseIt'-       , runParser-       , preProcess-       ) where--import Test.QuickCheck--import Data.GraphViz.Testing.Instances()-import Data.GraphViz.Testing.Properties--import Data.GraphViz-import Data.GraphViz.Parsing(parseIt, parseIt', runParser)-import Data.GraphViz.PreProcessing(preProcess)-import Data.GraphViz.Printing(printIt, renderDot)-import qualified Data.GraphViz.Types.Generalised as G-import qualified Data.GraphViz.Types.Graph as Gr--- Can't use PatriciaTree because a Show instance is needed.-import Data.Graph.Inductive.Tree(Gr)--import System.Exit(ExitCode(..), exitWith)-import System.IO(hPutStrLn, stderr)---- -------------------------------------------------------------------------------runChosenTests       :: [Test] -> IO ()-runChosenTests tsts = do putStrLn msg-                         blankLn-                         runTests tsts-                         spacerLn-                         putStrLn successMsg-  where-    msg = "This is the test suite for the graphviz library.\n\-           \If any of these tests fail, please inform the maintainer,\n\-           \including full output of this test suite."--    successMsg = "All tests were successful!"----- -------------------------------------------------------------------------------- Defining a Test structure and how to run tests.---- | Defines the test structure being used.-data Test = Test { name       :: String-                 , lookupName :: String      -- ^ Should be lowercase-                 , desc       :: String-                 , tests      :: [IO Result] -- ^ QuickCheck test.-                 }---- | Run all of the provided tests.-runTests :: [Test] -> IO ()-runTests = mapM_ ((>>) spacerLn . runTest)---- | Run the provided test.-runTest     :: Test -> IO ()-runTest tst = do putStrLn title-                 blankLn-                 putStrLn $ desc tst-                 blankLn-                 run $ tests tst-                 blankLn-  where-    nm = '"' : name tst ++ "\""-    title = "Running test: " ++ nm ++ "."-    successMsg = "All tests for " ++ nm ++ " were successful!"-    gaveUpMsg = "Too many sample inputs for " ++ nm ++ " were rejected;\n\-                 \tentatively marking this as successful."-    failMsg = "The tests for " ++ nm ++ " failed!\n\-               \Not attempting any further tests."--    run [] = putStrLn successMsg-    run (t:ts) = do r <- t-                    case r of-                       Success{} -> run ts-                       GaveUp{}  -> putStrLn gaveUpMsg >> run ts-                       _         -> die failMsg--spacerLn :: IO ()-spacerLn = putStrLn (replicate 70 '=') >> blankLn--blankLn :: IO ()-blankLn = putStrLn ""--die     :: String -> IO a-die msg = do hPutStrLn stderr msg-             exitWith (ExitFailure 1)--qCheck :: (Testable prop) => prop -> IO Result-qCheck = quickCheckWithResult (stdArgs { maxSize = 50, maxSuccess = 200 })---- -------------------------------------------------------------------------------- Defining the tests to use.---- | The tests to run by default.-defaultTests :: [Test]-defaultTests = [ test_printParseID_Attributes-               , test_generalisedSameDot-               , test_printParseID-               , test_preProcessingID-               , test_dotizeAugment-               , test_dotizeHasAugment-               , test_dotizeAugmentUniq-               , test_findAllNodes-               , test_findAllNodesE-               , test_findAllEdges-               , test_noGraphInfo-               , test_canonicalise-               , test_transitive-               ]---- | Test that 'Attributes' can be printed and then parsed back.-test_printParseID_Attributes :: Test-test_printParseID_Attributes-  = Test { name       = "Printing and parsing of Attributes"-         , lookupName = "attributes"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: Attributes -> Property-    prop = prop_printParseListID--    dsc = "The most common source of errors in printing and parsing are for\n\-          \Attributes."--test_generalisedSameDot :: Test-test_generalisedSameDot-  = Test { name       = "Printing generalised Dot code"-         , lookupName = "makegeneralised"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-    where-      prop :: DotGraph Int -> Bool-      prop = prop_generalisedSameDot--      dsc = "When generalising \"DotGraph\" values to other \"DotRepr\" values,\n\-             \the generated Dot code should be identical."--test_printParseID :: Test-test_printParseID-  = Test { name       = "Printing and Parsing DotReprs"-         , lookupName = "printparseid"-         , desc       = dsc-         , tests      = tsts-         }-  where-    tsts :: [IO Result]-    tsts = [ qCheck (prop_printParseID :: DotGraph    Int -> Bool)-           , qCheck (prop_printParseID :: G.DotGraph  Int -> Bool)-           , qCheck (prop_printParseID :: Gr.DotGraph Int -> Bool)-           ]--    dsc = "The graphviz library should be able to parse back in its own\n\-           \generated Dot code for any \"DotRepr\" instance"--test_preProcessingID :: Test-test_preProcessingID-  = Test { name       = "Pre-processing Dot code"-         , lookupName = "preprocessing"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: DotGraph Int -> Bool-    prop = prop_preProcessingID--    dsc = "When parsing Dot code, some pre-processing is done to remove items\n\-           \such as comments and to join together multi-line strings.  This\n\-           \test verifies that this pre-processing doesn't affect actual\n\-           \Dot code by running the pre-processor on generated Dot code.\n\n\-           \This test is not run on generalised Dot graphs as if it works for\n\-           \normal dot graphs then it should also work for generalised ones."--test_dotizeAugment :: Test-test_dotizeAugment-  = Test { name       = "Augmenting FGL Graphs"-         , lookupName = "augment"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: Gr Char Double -> Bool-    prop = prop_dotizeAugment--    dsc = "The various Graph to Graph functions in Data.GraphViz should\n\-           \only _augment_ the graph labels and not change the graphs\n\-           \themselves.  This test compares the original graphs to these\n\-           \augmented graphs and verifies that they are the same."--test_dotizeHasAugment :: Test-test_dotizeHasAugment-  = Test { name       = "Ensuring augmentation of FGL Graphs"-         , lookupName = "hasaugment"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: Gr Char Double -> Bool-    prop = prop_dotizeHasAugment--    dsc = "The various Graph to Graph functions in Data.GraphViz should\n\-           \actually agument the graph labels; this ensures that all labels\n\-           \actually have attached Attributes after augmentation."--test_dotizeAugmentUniq :: Test-test_dotizeAugmentUniq-  = Test { name       = "Unique edges in augmented FGL Graphs"-         , lookupName = "augmentuniq"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: Gr Char Double -> Bool-    prop = prop_dotizeAugmentUniq--    dsc = "When augmenting a graph with multiple edges, as long as no\n\-           \Attributes are provided that override the default settings,\n\-           \then each edge between two nodes should have a unique position\n\-           \Attribute, etc."--test_findAllNodes :: Test-test_findAllNodes-  = Test { name       = "Ensure all nodes are found in a DotRepr"-         , lookupName = "findnodes"-         , desc       = dsc-         , tests      = map qCheck props-         }-  where-    props :: [Gr () () -> Bool]-    props = testAllGraphTypes prop_findAllNodes--    dsc = "nodeInformation should find all nodes in a DotRepr;\n\-           \this is tested by converting an FGL graph and comparing\n\-           \the nodes it should have to those that are found."--test_findAllNodesE :: Test-test_findAllNodesE-  = Test { name       = "Ensure all nodes are found in a node-less DotRepr"-         , lookupName = "findedgelessnodes"-         , desc       = dsc-         , tests      = map qCheck props-         }-  where-    props :: [Gr () () -> Bool]-    props = testAllGraphTypes prop_findAllNodesE--    dsc = "nodeInformation should find all nodes in a DotRepr,\n\-           \even if there are no explicit nodes in that graph.\n\-           \This is tested by converting an FGL graph and comparing\n\-           \the nodes it should have to those that are found."--test_findAllEdges :: Test-test_findAllEdges-  = Test { name       = "Ensure all edges are found in a DotRepr"-         , lookupName = "findedges"-         , desc       = dsc-         , tests      = map qCheck props-         }-  where-    props :: [Gr () () -> Bool]-    props = testAllGraphTypes prop_findAllEdges--    dsc = "nodeInformation should find all edges in a DotRepr;\n\-           \this is tested by converting an FGL graph and comparing\n\-           \the edges it should have to those that are found."--test_noGraphInfo :: Test-test_noGraphInfo-  = Test { name       = "Plain DotReprs should have no structural information"-         , lookupName = "nographinfo"-         , desc       = dsc-         , tests      = map qCheck props-         }-  where-    props :: [Gr () () -> Bool]-    props = testAllGraphTypes prop_noGraphInfo--    dsc = "When converting a Graph to a DotRepr, there should be no\n\-           \clusters or global attributes."--test_canonicalise :: Test-test_canonicalise-  = Test { name       = "Canonicalisation should be idempotent"-         , lookupName = "canonicalise"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: DotGraph Int -> Bool-    prop = prop_canonicalise--    dsc = "Repeated application of canonicalise shouldn't have any further affect."--test_transitive :: Test-test_transitive-  = Test { name       = "Transitive reduction should be idempotent"-         , lookupName = "transitive"-         , desc       = dsc-         , tests      = [qCheck prop]-         }-  where-    prop :: DotGraph Int -> Bool-    prop = prop_transitive--    dsc = "Repeated application of transitiveReduction shouldn't have any further affect."---- --------------------------------------------------------------------------------- | Used when a property takes in a DotRepr as the first argument to---   indicate which instance it should test via 'fromCanonical'.-testAllGraphTypes      :: (Testable prop)-                          => (forall dg. (Eq (dg Int), DotRepr dg Int) => dg Int -> prop)-                          -> [prop]-testAllGraphTypes prop = [ prop (undefined :: DotGraph Int)-                         , prop (undefined :: G.DotGraph Int)-                         , prop (undefined :: Gr.DotGraph Int)-                         ]
tests/Data/GraphViz/Testing/Instances.hs view
@@ -18,10 +18,9 @@  -} module Data.GraphViz.Testing.Instances() where -import Data.GraphViz.Testing.Instances.FGL()-import Data.GraphViz.Testing.Instances.Canonical()-import Data.GraphViz.Testing.Instances.Generalised()-import Data.GraphViz.Testing.Instances.Graph()+import Data.Graph.Inductive.Arbitrary              ()+import Data.GraphViz.Testing.Instances.Canonical   ()+import Data.GraphViz.Testing.Instances.Generalised ()+import Data.GraphViz.Testing.Instances.Graph       ()  -- ------------------------------------------------------------------------------
tests/Data/GraphViz/Testing/Instances/Attributes.hs view
@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-}  {- |    Module      : Data.GraphViz.Testing.Instances.Attributes@@ -19,24 +19,30 @@  import Data.GraphViz.Testing.Instances.Helpers -import Data.GraphViz.Attributes.Complete-import qualified Data.GraphViz.Attributes.HTML as Html-import Data.GraphViz.Attributes.Colors.Brewer-import Data.GraphViz.Attributes.Colors.X11(X11Color)-import Data.GraphViz.Attributes.Colors.SVG(SVGColor)-import Data.GraphViz.Attributes.Internal(compassLookup)-import Data.GraphViz.State(initialState, layerSep)-import Data.GraphViz.Util(bool)+import           Data.GraphViz.Attributes.Colors.Brewer+import           Data.GraphViz.Attributes.Colors.SVG    (SVGColor)+import           Data.GraphViz.Attributes.Colors.X11    (X11Color)+import           Data.GraphViz.Attributes.Complete+import qualified Data.GraphViz.Attributes.HTML          as Html+import           Data.GraphViz.Attributes.Internal      (compassLookup)+import           Data.GraphViz.Internal.State           (initialState,+                                                         layerListSep, layerSep)+import           Data.GraphViz.Internal.Util            (bool)  import Test.QuickCheck -import Data.List(nub, delete, groupBy)-import qualified Data.Map as Map-import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)-import Control.Monad(liftM, liftM2, liftM3, liftM4)-import System.FilePath(searchPathSeparator)+import           Control.Monad   (liftM, liftM2, liftM3, liftM4)+import           Data.List       (delete, groupBy, nub)+import qualified Data.Map        as Map+import           Data.Text.Lazy  (Text)+import qualified Data.Text.Lazy  as T+import           System.FilePath (searchPathSeparator) +#if !MIN_VERSION_QuickCheck(2,9,0)+import Data.GraphViz.Internal.Util (createVersion)+import Data.Version                (Version(..))+#endif+ -- ----------------------------------------------------------------------------- -- Defining Arbitrary instances for Attributes @@ -62,16 +68,17 @@   arbitrary = oneof [ liftM Damping arbitrary                     , liftM K arbitrary                     , liftM URL arbitrary+                    , liftM Area arbitrary                     , liftM ArrowHead arbitrary                     , liftM ArrowSize arbitrary                     , liftM ArrowTail arbitrary-                    , liftM Aspect arbitrary+                    , liftM Background arbitrary                     , liftM BoundingBox arbitrary-                    , liftM ColorScheme arbitrary                     , liftM BgColor arbList                     , liftM Center arbitrary                     , liftM ClusterRank arbitrary                     , liftM Color arbList+                    , liftM ColorScheme arbitrary                     , liftM Comment arbitrary                     , liftM Compound arbitrary                     , liftM Concentrate arbitrary@@ -100,6 +107,7 @@                     , liftM GradientAngle arbitrary                     , liftM Group arbitrary                     , liftM HeadURL arbitrary+                    , liftM Head_LP arbitrary                     , liftM HeadClip arbitrary                     , liftM HeadLabel arbitrary                     , liftM HeadPort arbitrary@@ -110,6 +118,7 @@                     , liftM Image arbitrary                     , liftM ImagePath arbitrary                     , liftM ImageScale arbitrary+                    , liftM InputScale arbitrary                     , liftM Label arbitrary                     , liftM LabelURL arbitrary                     , liftM LabelScheme arbitrary@@ -125,12 +134,14 @@                     , liftM LabelTooltip arbitrary                     , liftM Landscape arbitrary                     , liftM Layer arbitrary+                    , liftM LayerListSep arbitrary                     , liftM Layers arbitrary+                    , liftM LayerSelect arbitrary                     , liftM LayerSep arbitrary                     , liftM Layout arbitrary                     , liftM Len arbitrary-                    , liftM LevelsGap arbitrary                     , liftM Levels arbitrary+                    , liftM LevelsGap arbitrary                     , liftM LHead arbitrary                     , liftM LHeight arbitrary                     , liftM LPos arbitrary@@ -147,6 +158,7 @@                     , liftM NodeSep arbitrary                     , liftM NoJustify arbitrary                     , liftM Normalize arbitrary+                    , liftM NoTranslate arbitrary                     , liftM Nslimit arbitrary                     , liftM Nslimit1 arbitrary                     , liftM Ordering arbitrary@@ -154,6 +166,7 @@                     , liftM OutputOrder arbitrary                     , liftM Overlap arbitrary                     , liftM OverlapScaling arbitrary+                    , liftM OverlapShrink arbitrary                     , liftM Pack arbitrary                     , liftM PackMode arbitrary                     , liftM Pad arbitrary@@ -184,7 +197,6 @@                     , liftM SearchSize arbitrary                     , liftM Sep arbitrary                     , liftM Shape arbitrary-                    , liftM ShapeFile arbitrary                     , liftM ShowBoxes arbitrary                     , liftM Sides arbitrary                     , liftM Size arbitrary@@ -196,6 +208,7 @@                     , liftM Style arbList                     , liftM StyleSheet arbitrary                     , liftM TailURL arbitrary+                    , liftM Tail_LP arbitrary                     , liftM TailClip arbitrary                     , liftM TailLabel arbitrary                     , liftM TailPort arbitrary@@ -209,24 +222,26 @@                     , liftM VoroMargin arbitrary                     , liftM Weight arbitrary                     , liftM Width arbitrary+                    , liftM XDotVersion arbitrary                     , liftM XLabel arbitrary-                    , liftM Z arbitrary+                    , liftM XLP arbitrary                     , liftM2 UnknownAttribute (suchThat arbIDString validUnknown) arbitrary                     ]    shrink (Damping v)            = map Damping             $ shrink v   shrink (K v)                  = map K                   $ shrink v   shrink (URL v)                = map URL                 $ shrink v+  shrink (Area v)               = map Area                $ shrink v   shrink (ArrowHead v)          = map ArrowHead           $ shrink v   shrink (ArrowSize v)          = map ArrowSize           $ shrink v   shrink (ArrowTail v)          = map ArrowTail           $ shrink v-  shrink (Aspect v)             = map Aspect              $ shrink v+  shrink (Background v)         = map Background          $ shrink v   shrink (BoundingBox v)        = map BoundingBox         $ shrink v-  shrink (ColorScheme v)        = map ColorScheme         $ shrink v   shrink (BgColor v)            = map BgColor             $ nonEmptyShrinks v   shrink (Center v)             = map Center              $ shrink v   shrink (ClusterRank v)        = map ClusterRank         $ shrink v   shrink (Color v)              = map Color               $ nonEmptyShrinks v+  shrink (ColorScheme v)        = map ColorScheme         $ shrink v   shrink (Comment v)            = map Comment             $ shrink v   shrink (Compound v)           = map Compound            $ shrink v   shrink (Concentrate v)        = map Concentrate         $ shrink v@@ -255,6 +270,7 @@   shrink (GradientAngle v)      = map GradientAngle       $ shrink v   shrink (Group v)              = map Group               $ shrink v   shrink (HeadURL v)            = map HeadURL             $ shrink v+  shrink (Head_LP v)            = map Head_LP             $ shrink v   shrink (HeadClip v)           = map HeadClip            $ shrink v   shrink (HeadLabel v)          = map HeadLabel           $ shrink v   shrink (HeadPort v)           = map HeadPort            $ shrink v@@ -265,6 +281,7 @@   shrink (Image v)              = map Image               $ shrink v   shrink (ImagePath v)          = map ImagePath           $ shrink v   shrink (ImageScale v)         = map ImageScale          $ shrink v+  shrink (InputScale v)         = map InputScale          $ shrink v   shrink (Label v)              = map Label               $ shrink v   shrink (LabelURL v)           = map LabelURL            $ shrink v   shrink (LabelScheme v)        = map LabelScheme         $ shrink v@@ -280,12 +297,14 @@   shrink (LabelTooltip v)       = map LabelTooltip        $ shrink v   shrink (Landscape v)          = map Landscape           $ shrink v   shrink (Layer v)              = map Layer               $ shrink v+  shrink (LayerListSep v)       = map LayerListSep        $ shrink v   shrink (Layers v)             = map Layers              $ shrink v+  shrink (LayerSelect v)        = map LayerSelect         $ shrink v   shrink (LayerSep v)           = map LayerSep            $ shrink v   shrink (Layout v)             = map Layout              $ shrink v   shrink (Len v)                = map Len                 $ shrink v-  shrink (LevelsGap v)          = map LevelsGap           $ shrink v   shrink (Levels v)             = map Levels              $ shrink v+  shrink (LevelsGap v)          = map LevelsGap           $ shrink v   shrink (LHead v)              = map LHead               $ shrink v   shrink (LHeight v)            = map LHeight             $ shrink v   shrink (LPos v)               = map LPos                $ shrink v@@ -302,6 +321,7 @@   shrink (NodeSep v)            = map NodeSep             $ shrink v   shrink (NoJustify v)          = map NoJustify           $ shrink v   shrink (Normalize v)          = map Normalize           $ shrink v+  shrink (NoTranslate v)        = map NoTranslate         $ shrink v   shrink (Nslimit v)            = map Nslimit             $ shrink v   shrink (Nslimit1 v)           = map Nslimit1            $ shrink v   shrink (Ordering v)           = map Ordering            $ shrink v@@ -309,6 +329,7 @@   shrink (OutputOrder v)        = map OutputOrder         $ shrink v   shrink (Overlap v)            = map Overlap             $ shrink v   shrink (OverlapScaling v)     = map OverlapScaling      $ shrink v+  shrink (OverlapShrink v)      = map OverlapShrink       $ shrink v   shrink (Pack v)               = map Pack                $ shrink v   shrink (PackMode v)           = map PackMode            $ shrink v   shrink (Pad v)                = map Pad                 $ shrink v@@ -339,7 +360,6 @@   shrink (SearchSize v)         = map SearchSize          $ shrink v   shrink (Sep v)                = map Sep                 $ shrink v   shrink (Shape v)              = map Shape               $ shrink v-  shrink (ShapeFile v)          = map ShapeFile           $ shrink v   shrink (ShowBoxes v)          = map ShowBoxes           $ shrink v   shrink (Sides v)              = map Sides               $ shrink v   shrink (Size v)               = map Size                $ shrink v@@ -351,6 +371,7 @@   shrink (Style v)              = map Style               $ nonEmptyShrinks v   shrink (StyleSheet v)         = map StyleSheet          $ shrink v   shrink (TailURL v)            = map TailURL             $ shrink v+  shrink (Tail_LP v)            = map Tail_LP             $ shrink v   shrink (TailClip v)           = map TailClip            $ shrink v   shrink (TailLabel v)          = map TailLabel           $ shrink v   shrink (TailPort v)           = map TailPort            $ shrink v@@ -364,11 +385,15 @@   shrink (VoroMargin v)         = map VoroMargin          $ shrink v   shrink (Weight v)             = map Weight              $ shrink v   shrink (Width v)              = map Width               $ shrink v+  shrink (XDotVersion v)        = map XDotVersion         $ shrink v   shrink (XLabel v)             = map XLabel              $ shrink v-  shrink (Z v)                  = map Z                   $ shrink v+  shrink (XLP v)                = map XLP                 $ shrink v   shrink (UnknownAttribute a v) = liftM2 UnknownAttribute (liftM (filter validUnknown) shrink a) (shrink v) {- delete to here -} +instance Arbitrary GraphvizCommand where+  arbitrary = arbBounded+ instance Arbitrary ArrowType where   arbitrary = liftM AType               -- Arrow specifications have between 1 and 4 elements.@@ -388,16 +413,6 @@ instance Arbitrary ArrowSide where   arbitrary = arbBounded -instance Arbitrary AspectType where-  arbitrary = oneof [ liftM  RatioOnly arbitrary-                    , liftM2 RatioPassCount arbitrary posArbitrary-                    ]--  shrink (RatioOnly d) = map RatioOnly $ shrink d-  shrink (RatioPassCount d i) = do ds <- shrink d-                                   is <- shrink i-                                   return $ RatioPassCount ds is- instance Arbitrary LabelScheme where   arbitrary = arbBounded @@ -412,7 +427,7 @@   -- Pretty sure points have to be positive...   arbitrary = liftM4 Point posArbitrary posArbitrary posZ arbitrary     where-      posZ = frequency [(1, return Nothing), (3, liftM Just posArbitrary)]+      posZ = liftArbitrary posArbitrary    shrink p = do x' <- shrink $ xCoord p                 y' <- shrink $ yCoord p@@ -439,6 +454,16 @@   shrink (DVal d) = map DVal $ shrink d   shrink (PVal p) = map PVal $ shrink p +instance Arbitrary SVGFontNames where+  arbitrary = arbBounded++instance Arbitrary GraphSize where+  arbitrary = liftM3 GSize arbitrary arbitrary arbitrary++  shrink gs = do w' <- shrink $ width gs+                 h' <- shrinkM $ height gs+                 return $ GSize w' h' False+ instance Arbitrary ModeType where   arbitrary = arbBounded @@ -453,7 +478,7 @@    shrink (StrLabel str)   = map StrLabel $ shrink str   shrink (HtmlLabel html) = map HtmlLabel $ shrink html-  shrink (RecordLabel fs) = map RecordLabel . filter notStr $ shrinkList fs+  shrink (RecordLabel fs) = map RecordLabel . filter notStr $ listShrink fs  notStr                :: RecordFields -> Bool notStr [FieldLabel{}] = False -- Just in case@@ -478,7 +503,7 @@   shrink (LabelledTarget f l) = [PortName f, FieldLabel l]   shrink (PortName f)         = map PortName $ shrink f   shrink (FieldLabel l)       = map FieldLabel $ shrink l-  shrink (FlipFields fs)      = map FlipFields $ shrinkList fs+  shrink (FlipFields fs)      = map FlipFields $ listShrink fs  instance Arbitrary Overlap where   arbitrary = oneof [ simpleOverlap@@ -490,6 +515,7 @@       simpleOverlap = elements [ KeepOverlaps                                , ScaleOverlaps                                , ScaleXYOverlaps+                               , VoronoiOverlap                                , CompressOverlap                                , VpscOverlap                                , IpsepOverlap@@ -503,6 +529,11 @@   -- one because of arbLayerName   arbitrary = return . LSep . T.pack $ layerSep initialState +instance Arbitrary LayerListSep where+  -- Since Arbitrary isn't stateful, we can't generate an arbitrary+  -- one because of arbLayerName+  arbitrary = return . LLSep . T.pack $ layerListSep initialState+ instance Arbitrary LayerList where   arbitrary = liftM LL $ listOf1 arbName     where@@ -513,7 +544,7 @@    shrink (LL ll) = map LL $ nonEmptyShrinks ll -instance Arbitrary LayerRange where+instance Arbitrary LayerRangeElem where   arbitrary = oneof [ liftM LRID arbitrary                     , liftM2 LRS arbitrary arbitrary                     ]@@ -632,8 +663,8 @@                     , liftM2 StartStyleSeed arbitrary arbitrary                     ] -  shrink StartStyle{} = [] -- No shrinks for STStyle-  shrink (StartSeed ss) = map StartSeed $ shrink ss+  shrink StartStyle{}           = [] -- No shrinks for STStyle+  shrink (StartSeed ss)         = map StartSeed $ shrink ss   shrink (StartStyleSeed st ss) = map (StartStyleSeed st) $ shrink ss  instance Arbitrary STStyle where@@ -656,6 +687,8 @@                                , Bold                                , Invisible                                , Filled+                               , Striped+                               , Wedged                                , Diagonals                                , Rounded                                , Tapered@@ -667,6 +700,8 @@                                 , "bold"                                 , "invis"                                 , "filled"+                                , "striped"+                                , "wedged"                                 , "diagonals"                                 , "rounded"                                 , "tapered"@@ -777,6 +812,15 @@   shrink (BrewerColor c) = map BrewerColor $ shrink c   shrink _               = [] -- Shrinking 0<=h,s,v<=1 does nothing +-- | No guarantees are made as to sanity of generated weightings.+instance Arbitrary WeightedColor where+  arbitrary = liftM2 WC arbitrary arbitrary++  -- No color shrinks to itself, so no sanity checking needed.+  shrink (WC c mw) = do c' <- shrink c+                        mw' <- shrink mw+                        return $ WC c' mw'+ instance Arbitrary X11Color where   arbitrary = arbBounded @@ -793,8 +837,8 @@ instance Arbitrary Html.Label where   arbitrary = sized $ arbHtml True -  shrink ht@(Html.Text txts) = delete ht . map Html.Text $ shrinkL txts-  shrink (Html.Table tbl)    = map Html.Table $ shrink tbl+  shrink (Html.Text txts) = map Html.Text $ listShrink txts+  shrink (Html.Table tbl) = map Html.Table $ shrink tbl  -- Note: for the most part, Html.Label values are very repetitive (and -- furthermore, they end up chewing a large amount of memory).  As@@ -820,7 +864,7 @@                      . sized                      $ arbHtmlText fnt   where-    s' = min s 10+    s' = min s 5  -- When parsing, all textual characters are parsed together; thus, -- make sure we generate them like that.@@ -836,9 +880,9 @@ instance Arbitrary Html.TextItem where   arbitrary = sized $ arbHtmlText True -  shrink (Html.Str str)        = map Html.Str $ shrink str-  shrink (Html.Newline as)     = map Html.Newline $ shrink as-  shrink hf@(Html.Font as txt) = do as' <- shrink as+  shrink (Html.Str str)        = map Html.Str . filter (not . T.null) . map T.strip $ shrink str+  shrink (Html.Newline as)     = map Html.Newline $ shrinkHtmlAttrs as+  shrink hf@(Html.Font as txt) = do as' <- shrinkHtmlAttrs as                                     txt' <- shrinkL txt                                     returnCheck hf $ Html.Font as' txt'   shrink (Html.Format _ txt)   = txt@@ -851,23 +895,34 @@                  else id     s' = min 2 s     arbRec = resize s' . sized $ arbHtmlTexts False-    recHtmlText = [ (1, liftM2 Html.Font arbitrary arbRec)+    recHtmlText = [ (1, liftM2 Html.Font arbHtmlAttrs arbRec)                   , (3, liftM2 Html.Format arbitrary arbRec)                   ]-    options = allowFonts [ (10, liftM Html.Str arbitrary)-                         , (10, liftM Html.Newline arbitrary)+    options = allowFonts [ (10, liftM Html.Str (suchThat (liftM T.strip arbitrary) (not . T.null)))+                         , (10, liftM Html.Newline arbHtmlAttrs)                          ]  instance Arbitrary Html.Format where   arbitrary = arbBounded  instance Arbitrary Html.Table where-  arbitrary = liftM3 Html.HTable arbitrary arbitrary (sized arbRows)+  arbitrary = liftM3 Html.HTable (liftArbitrary arbHtmlAttrs) arbHtmlAttrs (sized arbRows)     where       arbRows s = resize (min s 10) arbList -  shrink (Html.HTable fas as rs) = map (Html.HTable fas as) $ shrinkL rs+  shrink (Html.HTable fas as rs) = liftM3 Html.HTable shrinkFont (shrinkHtmlAttrs as) (shrinkL rs)+    where+      shrinkFont = liftShrink shrinkHtmlAttrs fas +#if !MIN_VERSION_QuickCheck(2,10,0)+liftArbitrary :: Gen a -> Gen (Maybe a)+liftArbitrary gen = frequency [(1, return Nothing), (3, liftM Just gen)]++liftShrink :: (a -> [a]) -> Maybe a -> [Maybe a]+liftShrink shr (Just x) = Nothing : map Just (shr x)+liftShrink _   Nothing  = []+#endif+ instance Arbitrary Html.Row where   arbitrary = frequency [ (5, liftM Html.Cells arbList)                         , (1, return Html.HorizontalRule)@@ -891,6 +946,12 @@ instance Arbitrary Html.Img where   arbitrary = liftM Html.Img arbitrary +arbHtmlAttrs :: Gen Html.Attributes+arbHtmlAttrs = sized (\s -> resize (min 5 s) arbitrary)++shrinkHtmlAttrs :: Html.Attributes -> [Html.Attributes]+shrinkHtmlAttrs = listShrink+ instance Arbitrary Html.Attribute where   arbitrary = oneof [ liftM Html.Align arbitrary                     , liftM Html.BAlign arbitrary@@ -901,45 +962,55 @@                     , liftM Html.CellSpacing arbitrary                     , liftM Html.Color arbitrary                     , liftM Html.ColSpan arbitrary+                    , liftM Html.Columns arbitrary                     , liftM Html.Face arbitrary                     , liftM Html.FixedSize arbitrary+                    , liftM Html.GradientAngle arbitrary                     , liftM Html.Height arbitrary                     , liftM Html.HRef arbitrary                     , liftM Html.ID arbitrary                     , liftM Html.PointSize arbitrary                     , liftM Html.Port arbitrary+                    , liftM Html.Rows arbitrary                     , liftM Html.RowSpan arbitrary                     , liftM Html.Scale arbitrary+                    , liftM Html.Sides (fmap nub (sized (\s -> resize (min s 4) arbitrary))) -- Will never have more than 4 values                     , liftM Html.Src arbString+                    , liftM Html.Style arbitrary                     , liftM Html.Target arbitrary                     , liftM Html.Title arbitrary                     , liftM Html.VAlign arbitrary                     , liftM Html.Width arbitrary                     ] -  shrink (Html.Align v)       = map Html.Align       $ shrink v-  shrink (Html.BAlign v)      = map Html.BAlign      $ shrink v-  shrink (Html.BGColor v)     = map Html.BGColor     $ shrink v-  shrink (Html.Border v)      = map Html.Border      $ shrink v-  shrink (Html.CellBorder v)  = map Html.CellBorder  $ shrink v-  shrink (Html.CellPadding v) = map Html.CellPadding $ shrink v-  shrink (Html.CellSpacing v) = map Html.CellSpacing $ shrink v-  shrink (Html.Color v)       = map Html.Color       $ shrink v-  shrink (Html.ColSpan v)     = map Html.ColSpan     $ shrink v-  shrink (Html.Face v)        = map Html.Face        $ shrink v-  shrink (Html.FixedSize v)   = map Html.FixedSize   $ shrink v-  shrink (Html.Height v)      = map Html.Height      $ shrink v-  shrink (Html.HRef v)        = map Html.HRef        $ shrink v-  shrink (Html.ID v)          = map Html.ID          $ shrink v-  shrink (Html.PointSize v)   = map Html.PointSize   $ shrink v-  shrink (Html.Port v)        = map Html.Port        $ shrink v-  shrink (Html.RowSpan v)     = map Html.RowSpan     $ shrink v-  shrink (Html.Scale v)       = map Html.Scale       $ shrink v-  shrink (Html.Src v)         = map Html.Src         $ shrinkString v-  shrink (Html.Target v)      = map Html.Target      $ shrink v-  shrink (Html.Title v)       = map Html.Title       $ shrink v-  shrink (Html.VAlign v)      = map Html.VAlign      $ shrink v-  shrink (Html.Width v)       = map Html.Width       $ shrink v+  shrink (Html.Align v)         = map Html.Align         $ shrink v+  shrink (Html.BAlign v)        = map Html.BAlign        $ shrink v+  shrink (Html.BGColor v)       = map Html.BGColor       $ shrink v+  shrink (Html.Border v)        = map Html.Border        $ shrink v+  shrink (Html.CellBorder v)    = map Html.CellBorder    $ shrink v+  shrink (Html.CellPadding v)   = map Html.CellPadding   $ shrink v+  shrink (Html.CellSpacing v)   = map Html.CellSpacing   $ shrink v+  shrink (Html.Color v)         = map Html.Color         $ shrink v+  shrink (Html.ColSpan v)       = map Html.ColSpan       $ shrink v+  shrink (Html.Columns v)       = map Html.Columns       $ shrink v+  shrink (Html.Face v)          = map Html.Face          $ shrink v+  shrink (Html.FixedSize v)     = map Html.FixedSize     $ shrink v+  shrink (Html.GradientAngle v) = map Html.GradientAngle $ shrink v+  shrink (Html.Height v)        = map Html.Height        $ shrink v+  shrink (Html.HRef v)          = map Html.HRef          $ shrink v+  shrink (Html.ID v)            = map Html.ID            $ shrink v+  shrink (Html.PointSize v)     = map Html.PointSize     $ shrink v+  shrink (Html.Port v)          = map Html.Port          $ shrink v+  shrink (Html.Rows v)          = map Html.Rows          $ shrink v+  shrink (Html.RowSpan v)       = map Html.RowSpan       $ shrink v+  shrink (Html.Scale v)         = map Html.Scale         $ shrink v+  shrink (Html.Sides v)         = map Html.Sides         $ listShrink' v+  shrink (Html.Src v)           = map Html.Src           $ shrinkString v+  shrink (Html.Style v)         = map Html.Style         $ shrink v+  shrink (Html.Target v)        = map Html.Target        $ shrink v+  shrink (Html.Title v)         = map Html.Title         $ shrink v+  shrink (Html.VAlign v)        = map Html.VAlign        $ shrink v+  shrink (Html.Width v)         = map Html.Width         $ shrink v  instance Arbitrary Html.Scale where   arbitrary = arbBounded@@ -950,6 +1021,15 @@ instance Arbitrary Html.VAlign where   arbitrary = arbBounded +instance Arbitrary Html.CellFormat where+  arbitrary = arbBounded++instance Arbitrary Html.Side where+  arbitrary = arbBounded++instance Arbitrary Html.Style where+  arbitrary = arbBounded+ instance Arbitrary PortName where   arbitrary = liftM PN               $ suchThat arbitrary (liftM2 (&&) (T.all (/=':')) notCP)@@ -958,3 +1038,46 @@  notCP :: Text -> Bool notCP = flip Map.notMember compassLookup++instance Arbitrary Number where+  arbitrary = frequency [ (3, liftM Dbl $ suchThat arbitrary notInt)+                        , (1, liftM Int arbitrary)+                        ]++  shrink (Int i) = map Int $ shrink i+  shrink (Dbl d) = map Dbl $ filter notInt $ shrink d++instance Arbitrary Normalized where+  arbitrary = oneof [ elements [IsNormalized, NotNormalized]+                    , liftM NormalizedAngle arbitrary+                    ]++  shrink (NormalizedAngle a) = map NormalizedAngle $ shrink a+  shrink _                   = []++#if !MIN_VERSION_QuickCheck(2,9,0)+instance Arbitrary Version where+  arbitrary = liftM (createVersion . map getPositive) arbList++  shrink = map createVersion . nonEmptyShrinks . versionBranch+#endif++instance Arbitrary NodeSize where+  arbitrary = arbBounded++{-++As of Graphviz 2.36.0 this was commented out; as such it might come+back, so leave this here in case we need it again.++instance Arbitrary AspectType where+  arbitrary = oneof [ liftM  RatioOnly arbitrary+                    , liftM2 RatioPassCount arbitrary posArbitrary+                    ]++  shrink (RatioOnly d) = map RatioOnly $ shrink d+  shrink (RatioPassCount d i) = do ds <- shrink d+                                   is <- shrink i+                                   return $ RatioPassCount ds is++-}
tests/Data/GraphViz/Testing/Instances/Canonical.hs view
@@ -13,12 +13,12 @@ import Data.GraphViz.Testing.Instances.Common import Data.GraphViz.Testing.Instances.Helpers +import Data.GraphViz.Internal.Util   (bool) import Data.GraphViz.Types.Canonical-import Data.GraphViz.Util(bool)  import Test.QuickCheck -import Control.Monad(liftM2, liftM4)+import Control.Monad (liftM2, liftM4)  -- ----------------------------------------------------------------------------- -- Defining Arbitrary instances for the overall types@@ -32,10 +32,10 @@ instance (Eq n, Arbitrary n) => Arbitrary (DotStatements n) where   arbitrary = sized (arbDS gaGraph True) -  shrink ds@(DotStmts gas sgs ns es) = do gas' <- shrinkL gas-                                          sgs' <- shrinkL sgs-                                          ns' <- shrinkL ns-                                          es' <- shrinkL es+  shrink ds@(DotStmts gas sgs ns es) = do gas' <- shrink gas+                                          sgs' <- shrink sgs+                                          ns' <- shrink ns+                                          es' <- shrink es                                           returnCheck ds                                             $ DotStmts gas' sgs' ns' es'
tests/Data/GraphViz/Testing/Instances/Common.hs view
@@ -17,36 +17,35 @@ import Data.GraphViz.Testing.Instances.Attributes import Data.GraphViz.Testing.Instances.Helpers -import Data.GraphViz.Attributes(Attributes)-import Data.GraphViz.Types.Common( DotNode(..), DotEdge(..)-                                 , GlobalAttributes(..), GraphID(..))+import Data.GraphViz.Algorithms            (CanonicaliseOptions (..))+import Data.GraphViz.Attributes            (Attributes)+import Data.GraphViz.Types.Internal.Common (DotEdge (..), DotNode (..),+                                            GlobalAttributes (..), GraphID (..))  import Test.QuickCheck -import Control.Monad(liftM, liftM2, liftM3)+import Control.Monad (liftM, liftM2, liftM3)  -- ----------------------------------------------------------------------------- -- Common values  instance Arbitrary GraphID where   arbitrary = oneof [ liftM Str arbitrary-                    , liftM Int arbitrary-                    , liftM Dbl $ suchThat arbitrary notInt+                    , liftM Num arbitrary                     ]    shrink (Str s) = map Str $ shrink s-  shrink (Int i) = map Int $ shrink i-  shrink (Dbl d) = map Dbl $ filter notInt $ shrink d+  shrink (Num n) = map Num $ shrink n  instance (Arbitrary n) => Arbitrary (DotNode n) where   arbitrary = liftM2 DotNode arbitrary arbNodeAttrs -  shrink (DotNode n as) = map (DotNode n) $ shrinkList as+  shrink (DotNode n as) = map (DotNode n) $ shrink as  instance (Arbitrary n) => Arbitrary (DotEdge n) where   arbitrary = liftM3 DotEdge arbitrary arbitrary arbEdgeAttrs -  shrink (DotEdge f t as) = map (DotEdge f t) $ shrinkList as+  shrink (DotEdge f t as) = map (DotEdge f t) $ shrink as  instance Arbitrary GlobalAttributes where   arbitrary = gaGraph@@ -69,3 +68,6 @@                 , liftM NodeAttrs  arbNodeAttrs                 , liftM EdgeAttrs  arbEdgeAttrs                 ]++instance Arbitrary CanonicaliseOptions where+  arbitrary = liftM2 COpts arbitrary arbitrary
− tests/Data/GraphViz/Testing/Instances/FGL.hs 
@@ -1,47 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances #-}--{- |-   Module      : Data.GraphViz.Testing.Instances.FGL-   Description : 'Arbitrary' instances for FGL graphs.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines the 'Arbitrary' instances for FGL 'DynGraph'-   graphs.  Note that this instance cannot be in-   "Data.GraphViz.Testing.Instances", as this instance requires the-   FlexibleInstances extension, which makes some of the other-   'Arbitrary' instances fail to type-check.--}-module Data.GraphViz.Testing.Instances.FGL() where--import Test.QuickCheck--import Data.GraphViz.Util(uniq)--import Data.Graph.Inductive.Graph(Graph, mkGraph, nodes, delNode)-import Data.List(sortBy)-import Data.Function(on)-import Control.Monad(liftM, liftM3)---- -------------------------------------------------------------------------------- Arbitrary instance for FGL graphs.--instance (Graph g, Arbitrary n, Arbitrary e) => Arbitrary (g n e) where-  arbitrary = do ns <- suchThat genNs (not . null)-                 let nGen = elements ns-                 lns <- mapM makeLNode ns-                 les <- liftM (sortBy (compare `on` toE)) . listOf-                        $ makeLEdge nGen-                 return $ mkGraph lns les-    where-      genNs = liftM uniq arbitrary-      toE (f,t,_) = (f,t)-      makeLNode n = liftM ((,) n) arbitrary-      makeLEdge nGen = liftM3 (,,) nGen nGen arbitrary--  shrink gr = case nodes gr of-                   -- Need to have at least 2 nodes before we delete one!-                   ns@(_:_:_) -> map (`delNode` gr) ns-                   _          -> []
tests/Data/GraphViz/Testing/Instances/Generalised.hs view
@@ -10,17 +10,17 @@  -} module Data.GraphViz.Testing.Instances.Generalised where -import Data.GraphViz.Testing.Instances.Attributes()+import Data.GraphViz.Testing.Instances.Attributes () import Data.GraphViz.Testing.Instances.Common-import Data.GraphViz.Testing.Instances.Helpers()+import Data.GraphViz.Testing.Instances.Helpers    () +import Data.GraphViz.Internal.Util     (bool) import Data.GraphViz.Types.Generalised-import Data.GraphViz.Util(bool)  import Test.QuickCheck +import           Control.Monad (liftM, liftM2, liftM4) import qualified Data.Sequence as Seq-import Control.Monad(liftM, liftM2, liftM4)  -- ----------------------------------------------------------------------------- -- Defining Arbitrary instances for the generalised types
tests/Data/GraphViz/Testing/Instances/Helpers.hs view
@@ -11,14 +11,14 @@  -} module Data.GraphViz.Testing.Instances.Helpers where -import Data.GraphViz.Parsing(isNumString)-import Data.GraphViz.State(initialState, layerSep)+import Data.GraphViz.Internal.State (initialState, layerListSep, layerSep)+import Data.GraphViz.Parsing        (isNumString)  import Test.QuickCheck +import           Control.Monad  (liftM, liftM2)+import           Data.Text.Lazy (Text) import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)-import Control.Monad(liftM, liftM2)  -- ----------------------------------------------------------------------------- -- Helper Functions@@ -66,7 +66,7 @@ shrinkString = map T.unpack . shrink . T.pack  notNumStr :: Text -> Bool-notNumStr = not . isNumString+notNumStr = not . isNumString True  arbBounded :: (Bounded a, Enum a) => Gen a arbBounded = elements [minBound .. maxBound]@@ -74,7 +74,7 @@ arbLayerName :: Gen Text arbLayerName = suchThat arbitrary (T.all notLayerSep)   where-    defLayerSep = layerSep initialState+    defLayerSep = layerSep initialState ++ layerListSep initialState     notLayerSep = (`notElem` defLayerSep)  arbStyleName :: Gen Text@@ -86,20 +86,20 @@ arbList = listOf1 arbitrary  nonEmptyShrinks :: (Arbitrary a) => [a] -> [[a]]-nonEmptyShrinks = filter (not . null) . shrinkList+nonEmptyShrinks = filter (not . null) . shrink  nonEmptyShrinks' :: [a] -> [[a]]-nonEmptyShrinks' = filter (not . null) . shrinkList'+nonEmptyShrinks' = filter (not . null) . listShrink'  -- Shrink lists with more than one value only by removing values, not -- by shrinking individual items.-shrinkList     :: (Arbitrary a) => [a] -> [[a]]-shrinkList [a] = map return $ shrink a-shrinkList as  = shrinkList' as+listShrink     :: (Arbitrary a) => [a] -> [[a]]+listShrink [a] = map return $ shrink a+listShrink as  = listShrink' as  -- Just shrink the size.-shrinkList'     :: [a] -> [[a]]-shrinkList' as  = rm (length as) as+listShrink'     :: [a] -> [[a]]+listShrink' as  = rm (length as) as   where     rm 0 _  = []     rm 1 _  = [[]]@@ -125,7 +125,7 @@ shrinkM j       = shrink j  shrinkL    :: (Arbitrary a) => [a] -> [[a]]-shrinkL xs = case shrinkList xs of+shrinkL xs = case listShrink xs of                []  -> [xs]                xs' -> xs'
tests/Data/GraphViz/Testing/Properties.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}  {- |    Module      : Data.GraphViz.Testing.Properties@@ -11,30 +11,38 @@ -} module Data.GraphViz.Testing.Properties where -import Data.GraphViz( dotizeGraph, graphToDot-                    , setDirectedness, nonClusteredParams)-import Data.GraphViz.Types( DotRepr(..), PrintDotRepr-                          , DotNode(..), DotEdge(..), GlobalAttributes(..)-                          , printDotGraph, graphNodes, graphEdges-                          , graphStructureInformation)-import Data.GraphViz.Types.Canonical(DotGraph(..), DotStatements(..))+import           Data.GraphViz                   (dotizeGraph, graphToDot,+                                                  nonClusteredParams,+                                                  setDirectedness)+import           Data.GraphViz.Algorithms+import           Data.GraphViz.Internal.Util     (groupSortBy, isSingle)+import           Data.GraphViz.Parsing           (ParseDot(..), parseIt,+                                                  parseIt')+import           Data.GraphViz.PreProcessing     (preProcess)+import           Data.GraphViz.Printing          (PrintDot(..), printIt)+import           Data.GraphViz.Testing.Proxy     (DGProxy(..))+import           Data.GraphViz.Types             (DotEdge(..), DotNode(..),+                                                  DotRepr(..),+                                                  GlobalAttributes(..),+                                                  PrintDotRepr,+                                                  edgeInformationClean,+                                                  graphEdges, graphNodes,+                                                  nodeInformationClean,+                                                  printDotGraph)+import           Data.GraphViz.Types.Canonical   (DotGraph(..),+                                                  DotStatements(..)) import qualified Data.GraphViz.Types.Generalised as G-import Data.GraphViz.Printing(PrintDot(..), printIt)-import Data.GraphViz.Parsing(ParseDot(..), parseIt, parseIt')-import Data.GraphViz.PreProcessing(preProcess)-import Data.GraphViz.Util(groupSortBy, isSingle)-import Data.GraphViz.Algorithms  import Test.QuickCheck -import Data.Graph.Inductive( Graph, DynGraph-                           , equal, nmap, emap, labNodes, labEdges, nodes, edges)-import Data.List(nub, sort)-import Data.Function(on)-import qualified Data.Map as Map-import qualified Data.Set as Set-import Data.Text.Lazy(Text)-import Control.Arrow((&&&))+import           Control.Arrow        ((&&&))+import           Data.Function        (on)+import           Data.Graph.Inductive (DynGraph, Graph, edges, emap, equal,+                                       labEdges, labNodes, nmap, nodes)+import           Data.List            (nub, sort)+import qualified Data.Map             as Map+import qualified Data.Set             as Set+import           Data.Text.Lazy       (Text)  -- ----------------------------------------------------------------------------- -- The properties to test for@@ -55,7 +63,7 @@ prop_generalisedSameDot    :: (Ord n, PrintDot n, ParseDot n) => DotGraph n -> Bool prop_generalisedSameDot dg = printDotGraph dg == printDotGraph gdg   where-    gdg = canonicalToType (undefined :: G.DotGraph n) dg+    gdg = canonicalToType (DGProxy :: DGProxy G.DotGraph) dg  -- | Pre-processing shouldn't change the output of printed Dot code. --   This should work for all 'PrintDot' instances, but is more@@ -91,7 +99,7 @@ --   should have unique 'Attributes' (namely the positions).  Note --   that this may not hold true with custom supplied 'Attributes' --   (i.e. not using one of the @dotize@ functions).-prop_dotizeAugmentUniq   :: (DynGraph g, Eq n, Ord e) => g n e -> Bool+prop_dotizeAugmentUniq   :: (DynGraph g, Ord e) => g n e -> Bool prop_dotizeAugmentUniq g = all uniqLs lss   where     g' = setDirectedness dotizeGraph nonClusteredParams g@@ -104,22 +112,22 @@ -- | Ensure that the definition of 'nodeInformation' for a DotRepr --   finds all the nodes. prop_findAllNodes       :: (DotRepr dg Int, Ord el, Graph g)-                           => dg Int -> g nl el -> Bool-prop_findAllNodes dg' g = ((==) `on` sort) gns dgns+                           => DGProxy dg -> g nl el -> Bool+prop_findAllNodes dgp g = ((==) `on` sort) gns dgns   where     gns = nodes g-    dg = canonicalToType dg' $ setDirectedness graphToDot nonClusteredParams g+    dg = canonicalToType dgp $ setDirectedness graphToDot nonClusteredParams g     dgns = map nodeID $ graphNodes dg  -- | Ensure that the definition of 'nodeInformation' for DotReprs --   finds all the nodes when the explicit 'DotNode' definitions are --   removed. prop_findAllNodesE       :: (DotRepr dg Int, Ord el, Graph g)-                            => dg Int -> g nl el -> Bool-prop_findAllNodesE dg' g = ((==) `on` sort) gns dgns+                            => DGProxy dg -> g nl el -> Bool+prop_findAllNodesE dgp g = ((==) `on` sort) gns dgns   where     gns = nodes g-    dg = canonicalToType dg' . removeNodes $ setDirectedness graphToDot nonClusteredParams g+    dg = canonicalToType dgp . removeNodes $ setDirectedness graphToDot nonClusteredParams g     dgns = map nodeID $ graphNodes dg     removeNodes dot@DotGraph{graphStatements = stmts}       = dot { graphStatements@@ -130,36 +138,57 @@  -- | Ensure that the definition of 'edgeInformation' for DotReprs --   finds all the nodes.-prop_findAllEdges       :: (DotRepr dg Int, Ord el, Graph g) => dg Int -> g nl el -> Bool-prop_findAllEdges dg' g = ((==) `on` sort) ges dges+prop_findAllEdges       :: (DotRepr dg Int, Graph g) => DGProxy dg -> g nl el -> Bool+prop_findAllEdges dgp g = ((==) `on` sort) ges dges   where     ges = edges g-    dg = canonicalToType dg' $ graphToDot nonClusteredParams g+    dg = canonicalToType dgp $ graphToDot nonClusteredParams g     dges = map (fromNode &&& toNode) $ graphEdges dg  -- | There should be no clusters or global attributes when converting --   a 'Graph' to a DotRepr (via fromCanonical) without any formatting --   or clustering. prop_noGraphInfo       :: (DotRepr dg Int, Ord el, Graph g)-                          => dg Int -> g nl el -> Bool-prop_noGraphInfo dg' g = info == (GraphAttrs [], Map.empty)+                          => DGProxy dg -> g nl el -> Bool+prop_noGraphInfo dgp g = info == (GraphAttrs [], Map.empty)   where-    dg = canonicalToType dg'+    dg = canonicalToType dgp          $ setDirectedness graphToDot nonClusteredParams g     info = graphStructureInformation dg  -- | Canonicalisation should be idempotent.-prop_canonicalise   :: (ParseDot n, PrintDot n, DotRepr dg n) => dg n -> Bool-prop_canonicalise g = cdg == canonicalise cdg+prop_canonicalise :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool+prop_canonicalise copts g = cdg == canonicaliseOptions copts cdg   where-    cdg = canonicalise g+    cdg = canonicaliseOptions copts g +-- | Canonicalisation shouldn't change any nodes.+prop_canonicaliseNodes :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool+prop_canonicaliseNodes copts g = nodeInformationClean True g+                                 == nodeInformationClean True cdg+  where+    cdg = canonicaliseOptions copts g++-- | Canonicalisation shouldn't change any edges.+prop_canonicaliseEdges :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool+prop_canonicaliseEdges copts g = sort (edgeInformationClean True g)+                                 == sort (edgeInformationClean True cdg)+  where+    cdg = canonicaliseOptions copts g+ -- | Removing transitive edges should be idempotent.-prop_transitive   :: (DotRepr dg n) => dg n -> Bool-prop_transitive g = tdg == transitiveReduction tdg+prop_transitive :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool+prop_transitive copts g = tdg == transitiveReductionOptions copts tdg   where-    tdg = transitiveReduction g+    tdg = transitiveReductionOptions copts g +-- | Transitive reduction shouldn't change any nodes.+prop_transitiveNodes :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool+prop_transitiveNodes copts g = nodeInformationClean True g+                               == nodeInformationClean True cdg+  where+    cdg = transitiveReductionOptions copts g+ -- ----------------------------------------------------------------------------- -- Helper utility functions @@ -177,5 +206,5 @@  -- | A wrapper around 'fromCanonical' that lets you specify up-front --   what type to create (it need not be a sensible value).-canonicalToType   :: (DotRepr dg n) => dg n -> DotGraph n -> dg n+canonicalToType   :: (DotRepr dg n) => DGProxy dg -> DotGraph n -> dg n canonicalToType _ = fromCanonical
+ tests/Data/GraphViz/Testing/Proxy.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE KindSignatures #-}++{- |+   Module      : Data.GraphViz.Testing.Proxy+   Description : Proxy implementation+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++   Data.Proxy was added to base with GHC 7.8.1, and we want to test+   for older versions than that.++ -}+module Data.GraphViz.Testing.Proxy where++--------------------------------------------------------------------------------++data DGProxy (dg :: * -> *) = DGProxy+  deriving (Eq, Ord, Show, Read)
+ tests/Data/GraphViz/Types/CanonicalSpec.hs view
@@ -0,0 +1,44 @@+{- |+   Module      : Data.GraphViz.Types.CanonicalSpec+   Description : Testing canonical graph representation+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.Types.CanonicalSpec (spec) where++import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_findAllEdges, prop_findAllNodes,+                                         prop_findAllNodesE,+                                         prop_generalisedSameDot,+                                         prop_noGraphInfo, prop_printParseID)+import Data.GraphViz.Testing.Proxy      (DGProxy(..))+import Data.GraphViz.Types.Canonical    (DotGraph)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)++import Data.Graph.Inductive.PatriciaTree (Gr)++--------------------------------------------------------------------------------++spec :: Spec+spec = do+  prop "Generalising a graph doesn't change Dot code"+       (prop_generalisedSameDot :: DotGraph Int -> Bool)+  prop "Printing and parsing Dot graph"+       (prop_printParseID :: DotGraph Int -> Bool)+  prop "Find all nodes in a Dot graph"+       (prop_findAllNodes dproxy :: Gr () () -> Bool)+  prop "Find all nodes in an node-less Dot graph"+       (prop_findAllNodesE dproxy :: Gr () () -> Bool)+  prop "Find all edges in a Dot graph"+       (prop_findAllEdges dproxy :: Gr () () -> Bool)+  prop "Plain Dot graphs should have no structural information"+       (prop_noGraphInfo dproxy :: Gr () () -> Bool)++dproxy :: DGProxy DotGraph+dproxy = DGProxy
+ tests/Data/GraphViz/Types/GeneralisedSpec.hs view
@@ -0,0 +1,41 @@+{- |+   Module      : Data.GraphViz.Types.GeneralisedSpec+   Description : Testing generalised graph representation+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.Types.GeneralisedSpec (spec) where++import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_findAllEdges, prop_findAllNodes,+                                         prop_findAllNodesE, prop_noGraphInfo,+                                         prop_printParseID)+import Data.GraphViz.Testing.Proxy      (DGProxy(..))+import Data.GraphViz.Types.Generalised  (DotGraph)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)++import Data.Graph.Inductive.PatriciaTree (Gr)++--------------------------------------------------------------------------------++spec :: Spec+spec = do+  prop "Printing and parsing Dot graph"+       (prop_printParseID :: DotGraph Int -> Bool)+  prop "Find all nodes in a Dot graph"+       (prop_findAllNodes dproxy :: Gr () () -> Bool)+  prop "Find all nodes in an node-less Dot graph"+       (prop_findAllNodesE dproxy :: Gr () () -> Bool)+  prop "Find all edges in a Dot graph"+       (prop_findAllEdges dproxy :: Gr () () -> Bool)+  prop "Plain Dot graphs should have no structural information"+       (prop_noGraphInfo dproxy :: Gr () () -> Bool)++dproxy :: DGProxy DotGraph+dproxy = DGProxy
+ tests/Data/GraphViz/Types/GraphSpec.hs view
@@ -0,0 +1,59 @@+{- |+   Module      : Data.GraphViz.Types.GraphSpec+   Description : Testing graph-based graph representation+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphViz.Types.GraphSpec (spec) where++import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_findAllEdges, prop_findAllNodes,+                                         prop_findAllNodesE, prop_noGraphInfo,+                                         prop_printParseID)+import Data.GraphViz.Testing.Proxy      (DGProxy(..))+import Data.GraphViz.Types              (edgeInformation)+import Data.GraphViz.Types.Graph        (Context(..), DotEdge(..), DotGraph,+                                         DotNode(..), addEdge, emptyGraph,+                                         mkGraph, (&))++import Test.Hspec            (Spec, describe, it)+import Test.Hspec.QuickCheck (prop)++import Data.Graph.Inductive.PatriciaTree (Gr)++--------------------------------------------------------------------------------++spec :: Spec+spec = do+  prop "Printing and parsing Dot graph"+       (prop_printParseID :: DotGraph Int -> Bool)+  prop "Find all nodes in a Dot graph"+       (prop_findAllNodes dproxy :: Gr () () -> Bool)+  prop "Find all nodes in an node-less Dot graph"+       (prop_findAllNodesE dproxy :: Gr () () -> Bool)+  prop "Find all edges in a Dot graph"+       (prop_findAllEdges dproxy :: Gr () () -> Bool)+  prop "Plain Dot graphs should have no structural information"+       (prop_noGraphInfo dproxy :: Gr () () -> Bool)++  describe "issue#28" $ do+    it "mkGraph retains proper edge order" $+      hasEdge (mkGraph [DotNode 0 [], DotNode 1 []] [DotEdge 0 1 []]) (0,1)+    it "& retains proper edge order" $+      hasEdge (Cntxt { node = 1, inCluster = Nothing, attributes = [], predecessors = [(0,[])], successors = []}+               & Cntxt { node = 0, inCluster = Nothing, attributes = [], predecessors = [], successors = []}+               & emptyGraph)+              (0,1)+    it "addEdge retains proper edge order" $+      hasEdge (addEdge 0 1 [] (mkGraph [DotNode 0 [], DotNode 1 []] [])) (0,1)+++dproxy :: DGProxy DotGraph+dproxy = DGProxy++hasEdge :: DotGraph Int -> (Int,Int) -> Bool+hasEdge dg (f,t) = edgeInformation False dg == [DotEdge f t []]
+ tests/Data/GraphVizSpec.hs view
@@ -0,0 +1,34 @@+{- |+   Module      : Data.GraphVizSpec+   Description : Testing algorithms+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Data.GraphVizSpec (spec) where++import Data.GraphViz.Testing.Instances  ()+import Data.GraphViz.Testing.Properties (prop_dotizeAugment,+                                         prop_dotizeAugmentUniq,+                                         prop_dotizeHasAugment)++import Test.Hspec            (Spec)+import Test.Hspec.QuickCheck (prop)++import Data.Graph.Inductive.PatriciaTree (Gr)++--------------------------------------------------------------------------------++spec :: Spec+spec = do+  prop "FGL Graphs are augmentable"+       (prop_dotizeAugment :: GrType -> Bool)+  prop "Ensure augmentation is valid"+       (prop_dotizeHasAugment :: GrType -> Bool)+  prop "Unique edges in augmented FGL Graphs"+       (prop_dotizeAugmentUniq :: GrType -> Bool)++type GrType = Gr Char Double
+ tests/Main.hs view
@@ -0,0 +1,23 @@+{- |+   Module      : Main+   Description : Top-level HSpec runner+   Copyright   : Matthew Sackman, Ivan Lazar Miljenovic+   License     : BSD3+   Maintainer  : Ivan.Miljenovic@gmail.com++   Used as we want to wrap default QuickCheck configurations.++ -}+module Main where++import qualified Spec+import           Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess)+import           Test.Hspec.Runner     (hspec)++--------------------------------------------------------------------------------++main :: IO ()+main = hspec+       . modifyMaxSuccess (const 200)+       . modifyMaxSize (const 50)+       $ Spec.spec
− tests/RunTests.hs 
@@ -1,83 +0,0 @@-{- |-   Module      : RunTests-   Description : Run the graphviz test suite.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module exists solely to make a Main module to build and run-   the test suite.--}-module Main where--import Data.GraphViz.Testing( Test(name, lookupName)-                            , defaultTests, runChosenTests)--import Data.Char(toLower)-import Data.Maybe(mapMaybe)-import qualified Data.Map as Map-import Data.Map(Map)-import Control.Arrow((&&&))-import Control.Monad(when)-import System.Environment(getArgs, getProgName)-import System.Exit(ExitCode(ExitSuccess), exitWith)---- -------------------------------------------------------------------------------main :: IO ()-main = do opts <- getArgs-          let opts' = map (map toLower) opts-              hasArg arg = any (arg==) opts'-          when (hasArg "help") helpMsg-          let tests = if hasArg "all"-                      then defaultTests-                      else mapMaybe getTest opts'-              tests' = if null tests-                       then defaultTests-                       else tests-          runChosenTests tests'--testLookup :: Map String Test-testLookup = Map.fromList-             $ map (lookupName &&& id) defaultTests--getTest :: String -> Maybe Test-getTest = (`Map.lookup` testLookup)--helpMsg :: IO ()-helpMsg = getProgName >>= (putStr . msg) >> exitWith ExitSuccess-  where-    msg nm = unlines-      [ "This utility is the test-suite for the graphviz library for Haskell."-      , "Various tests are available; see the table below for a complete list."-      , "There are several ways of running this program:"-      , ""-      , "    " ++ nm ++ "               Run all of the tests"-      , "    " ++ nm ++ " all           Run all of the tests"-      , "    " ++ nm ++ " help          Get this help message"-      , "    " ++ nm ++ " <key>         Run the test associated with each key,"-      , "        (where <key> denotes a space-separated list of keys"-      , "         from the table below)."-      , ""-      , helpTable-      ]--helpTable :: String-helpTable = unlines $ fmtName ((lnHeader,lnHeaderLen),(nHeader,nHeaderLen))-                      : line-                      : map fmtName testNames-  where-    andLen = ((id &&& length) .)-    testNames = map (andLen lookupName &&& andLen name) defaultTests-    fmtName ((ln,lnl),(n,_)) = concat [ ln-                                      , replicate (maxLN-lnl+spacerLen) ' '-                                      , n-                                      ]-    line = replicate (maxLN + spacerLen + maxN) '-'-    maxLN = maximum $ map (snd . fst) testNames-    maxN = maximum $ map (snd . snd) testNames-    spacerLen = 3-    lnHeader = "Key"-    lnHeaderLen = length lnHeader-    nHeader = "Description"-    nHeaderLen = length nHeader
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
utils/AttributeGenerator.hs view
@@ -148,14 +148,14 @@                      . asRows                      . firstOthers equals (char '|')                      . (++ [defUnknown])-                     . map createDefn+                     . map createDf                      $ atts att       derivs = nest tab $ text "deriving (Eq, Ord, Show, Read)"-      createDefn a = [cnst a <+> vtypeCode a-                     , if isEmpty cm-                       then empty-                       else text "-- ^" <+> cm-                     ]+      createDf a = [cnst a <+> vtypeCode a+                   , if isEmpty cm+                     then empty+                     else text "-- ^" <+> cm+                   ]           where             cm = comment a       defUnknown = [ unknownAttr <+> unknownNameAlias <+> vtype Strng@@ -170,17 +170,19 @@     where       tp = tpNm att -nameAlias     :: Atts -> Code-nameAlias att = comment-                $$ (text "type"-                    <+> unknownNameAlias-                    <+> equals-                    <+> vtype Strng)+-- The Atts value isn't used; this is just to make it have the same+-- type as the other code-generating functions.+nameAlias   :: Atts -> Code+nameAlias _ = cmnt+              $$ (text "type"+                  <+> unknownNameAlias+                  <+> equals+                  <+> vtype Strng)   where-    comment = text "-- | The name for an" <+> unknownAttr-              <> text "; must satisfy "-              <+> quotes validUnknownName-              <> text "."+    cmnt = text "-- | The name for an" <+> unknownAttr+           <> text "; must satisfy "+           <+> quotes validUnknownName+           <> text "."  unknownNameAlias :: Code unknownNameAlias = text "AttributeName"@@ -191,7 +193,6 @@       hdr = text "instance" <+> text "PrintDot" <+> tpNm att <+> text "where"       var = char 'v'       sFunc = text "unqtDot"-      cnct = text "<>"       insts = asRows               . (++ [unknownInst])               . map mkInstance@@ -227,17 +228,26 @@             $ atts att       pFunc = text "parseUnqt"       pType b a-          | valtype a == Bl     = pFld <> text "Bool" <+> cnst a-          | isJust $ parseDef a = pFld <> text "Def"  <+> cnst a <+> fromJust (parseDef a)-          | otherwise           = pFld <+> cnst a+          | valtype a == Bl       = pFld <> text "Bool" <+> cnst a+          | isJust $ parseDef a   = pFld <> text "Def"  <+> cnst a <+> fromJust (parseDef a)+          | otherwise             = pFld <+> cnst a           where             pFld = text "parseField" <> if b then char 's' else empty        parseAttr a = case map doubleQuotes $ parseNames a of                       [n] -> pType False a <+> n                       ns  -> pType True  a <+> docList ns-      pUnknown = text "liftM2" <+> unknownAttr <+> text "stringBlock"-                 <+> parens (text "parseEq >> parse")+      unknownName = text "attrName"+      pUnknown = text "do"+                 <+> (   (unknownName <+> text "<- stringBlock")+                      $$ (text "liftEqParse"+                          <+> (parens (text "\"" <> unknownAttr <+> text "(\""+                                       <+> text "++ T.unpack" <+> unknownName+                                       <+> text "++ \")\"")+                               $$ parens (unknownAttr <+> unknownName)+                               )+                         )+                     )  arbitraryInstance     :: Atts -> Code arbitraryInstance att = hdr $+$ fns@@ -310,17 +320,21 @@                 . concatMap parseNames                 $ atts att -arbitraryFor                :: VType -> Doc-arbitraryFor (Cust ('[':_)) = text "arbList"-arbitraryFor _              = text "arbitrary"+arbitraryFor :: VType -> Doc+arbitraryFor = text . bool "arbitrary" "arbList" . isListType  arbitraryFor' :: Attribute -> Doc arbitraryFor' = arbitraryFor . valtype  shrinkFor :: VType -> Doc-shrinkFor (Cust ('[':_)) = text "nonEmptyShrinks"-shrinkFor _              = text "shrink"+shrinkFor = text . bool "shrink" "nonEmptyShrinks" . isListType +-- Some types are aliases for lists.+isListType :: VType -> Bool+isListType (Cust ('[':_))     = True+isListType (Cust "ColorList") = True+isListType _                  = False+ usedByFunc          :: String -> (Attribute -> Bool) -> Atts -> Code usedByFunc nm p att = cmnt $$ asRows (tpSig : trs ++ [fls])     where@@ -448,168 +462,375 @@  -- The actual attributes --- ColorScheme is put earlier so that when sorting, it comes before the various *Color attributes.+-- Don't edit this value directly; edit the table below instead.  attributes :: [Attribute]-attributes = [ makeAttr "Damping" ["Damping"] "G" Dbl Nothing (Just "0.99") (Just "@0.99@") (Just "@0.0@") (Just "neato only")-             , makeAttr "K" ["K"] "GC" Dbl Nothing (Just "0.3") (Just "@0.3@") (Just "@0@") (Just "sfdp, fdp only")-             , makeAttr "URL" ["URL", "href"] "ENGC" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, postscript, map only")-             , makeAttr "ArrowHead" ["arrowhead"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing-             , makeAttr "ArrowSize" ["arrowsize"] "E" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") Nothing-             , makeAttr "ArrowTail" ["arrowtail"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing-             , makeAttr "Aspect" ["aspect"] "G" (Cust "AspectType") Nothing Nothing Nothing Nothing (Just "dot only")-             , makeAttr "BoundingBox" ["bb"] "G" (Cust "Rect") Nothing Nothing Nothing Nothing (Just "write only")-             , makeAttr "ColorScheme" ["colorscheme"] "ENCG" (Cust "ColorScheme") Nothing (Just "X11") (Just "@'X11'@") Nothing Nothing-             , makeAttr "BgColor" ["bgcolor"] "GC" (Cust "[Color]") Nothing (Just "[X11Color Transparent]") (Just "@['X11Color' 'Transparent']@") Nothing Nothing-             , makeAttr "Center" ["center"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "ClusterRank" ["clusterrank"] "G" (Cust "ClusterMode") Nothing (Just "Local") (Just "@'Local'@") Nothing (Just "dot only")-             , makeAttr "Color" ["color"] "ENC" (Cust "[Color]") Nothing (Just "[X11Color Black]") (Just "@['X11Color' 'Black']@") Nothing Nothing-             , makeAttr "Comment" ["comment"] "ENG" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Compound" ["compound"] "G" Bl (Just "True") (Just "False")(Just "@'False'@") Nothing (Just "dot only")-             , makeAttr "Concentrate" ["concentrate"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "Constraint" ["constraint"] "E" Bl (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "dot only")-             , makeAttr "Decorate" ["decorate"] "E" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "DefaultDist" ["defaultdist"] "G" Dbl Nothing Nothing (Just "@1+(avg. len)*sqrt(|V|)@") (Just "@epsilon@") (Just "neato only, only if @'Pack' 'DontPack'@")-             , makeAttr "Dim" ["dim"] "G" Integ Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "sfdp, fdp, neato only")-             , makeAttr "Dimen" ["dimen"] "G" Integ Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "sfdp, fdp, neato only")-             , makeAttr "Dir" ["dir"] "E" (Cust "DirType") Nothing Nothing (Just "@'Forward'@ (directed), @'NoDir'@ (undirected)") Nothing Nothing-             , makeAttr "DirEdgeConstraints" ["diredgeconstraints"] "G" (Cust "DEConstraints") (Just "EdgeConstraints") (Just "NoConstraints") (Just "@'NoConstraints'@") Nothing (Just "neato only")-             , makeAttr "Distortion" ["distortion"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@-100.0@") Nothing-             , makeAttr "DPI" ["dpi", "resolution"] "G" Dbl Nothing Nothing (Just "@96.0@, @0.0@") Nothing (Just "svg, bitmap output only; \\\"resolution\\\" is a synonym")-             , makeAttr "EdgeURL" ["edgeURL", "edgehref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "EdgeTarget" ["edgetarget"] "E" EStrng Nothing Nothing (Just "none") Nothing (Just "svg, map only")-             , makeAttr "EdgeTooltip" ["edgetooltip"] "E" EStrng Nothing Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Epsilon" ["epsilon"] "G" Dbl Nothing Nothing (Just "@.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@)") Nothing (Just "neato only")-             , makeAttr "ESep" ["esep"] "G" (Cust "DPoint") Nothing (Just "(DVal 3)") (Just "@'DVal' 3@") Nothing (Just "not dot")-             , makeAttr "FillColor" ["fillcolor"] "NEC" (Cust "[Color]") Nothing (Just "[X11Color Black]")(Just "@['X11Color' 'LightGray']@ (nodes), @['X11Color' 'Black']@ (clusters)") Nothing Nothing-             , makeAttr "FixedSize" ["fixedsize"] "N" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "FontColor" ["fontcolor"] "ENGC" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing-             , makeAttr "FontName" ["fontname"] "ENGC" Strng Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing-             , makeAttr "FontNames" ["fontnames"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg only")-             , makeAttr "FontPath" ["fontpath"] "G" Strng Nothing Nothing (Just "system dependent") Nothing Nothing-             , makeAttr "FontSize" ["fontsize"] "ENGC" Dbl Nothing (Just "14") (Just "@14.0@") (Just "@1.0@") Nothing-             , makeAttr "ForceLabels" ["forcelabels"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "Only for 'XLabel' attributes, requires Graphviz >= 2.29.0")-             , makeAttr "GradientAngle" ["gradientangle"] "NCG" Integ Nothing (Just "0") (Just "0") Nothing (Just "requires Graphviz >= 2.29.0")-             , makeAttr "Group" ["group"] "N" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "HeadURL" ["headURL", "headhref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "HeadClip" ["headclip"] "E" Bl (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing-             , makeAttr "HeadLabel" ["headlabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing Nothing-             , makeAttr "HeadPort" ["headport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing-             , makeAttr "HeadTarget" ["headtarget"] "E" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")-             , makeAttr "HeadTooltip" ["headtooltip"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Height" ["height"] "N" Dbl Nothing (Just "0.5") (Just "@0.5@") (Just "@0.02@") Nothing-             , makeAttr "ID" ["id"] "GNE" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"") Nothing (Just "svg, postscript, map only")-             , makeAttr "Image" ["image"] "N" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "ImagePath" ["imagepath"] "G" (Cust "Paths") Nothing (Just "(Paths [])") (Just "@'Paths' []@") Nothing (Just "Printing and parsing is OS-specific, requires Graphviz >= 2.29.0")-             , makeAttr "ImageScale" ["imagescale"] "N" (Cust "ScaleType") (Just "UniformScale") (Just "NoScale") (Just "@'NoScale'@") Nothing Nothing-             , makeAttr "Label" ["label"] "ENGC" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise)") Nothing Nothing-             , makeAttr "LabelURL" ["labelURL", "labelhref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "LabelScheme" ["label_scheme"] "G" (Cust "LabelScheme") Nothing (Just "NotEdgeLabel") (Just "@'NotEdgeLabel'@") Nothing (Just "sfdp only, requires Graphviz >= 2.28.0")-             , makeAttr "LabelAngle" ["labelangle"] "E" Dbl Nothing (Just "(-25)") (Just "@-25.0@") (Just "@-180.0@") Nothing-             , makeAttr "LabelDistance" ["labeldistance"] "E" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") Nothing-             , makeAttr "LabelFloat" ["labelfloat"] "E" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "LabelFontColor" ["labelfontcolor"] "E" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing-             , makeAttr "LabelFontName" ["labelfontname"] "E" Strng Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing-             , makeAttr "LabelFontSize" ["labelfontsize"] "E" Dbl Nothing (Just "14") (Just "@14.0@") (Just "@1.0@") Nothing-             , makeAttr "LabelJust" ["labeljust"] "GC" (Cust "Justification") Nothing (Just "JCenter") (Just "@'JCenter'@") Nothing Nothing-             , makeAttr "LabelLoc" ["labelloc"] "GCN" (Cust "VerticalPlacement") Nothing (Just "VTop") (Just "@'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)") Nothing Nothing-             , makeAttr "LabelTarget" ["labeltarget"] "E" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")-             , makeAttr "LabelTooltip" ["labeltooltip"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Landscape" ["landscape"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "Layer" ["layer"] "EN" (Cust "LayerRange") Nothing Nothing Nothing Nothing Nothing-             , makeAttr "Layers" ["layers"] "G" (Cust "LayerList") Nothing (Just "(LL [])")  (Just "@'LL' []@") Nothing Nothing-             , makeAttr "LayerSep" ["layersep"] "G" (Cust "LayerSep") Nothing (Just "(LSep \" :\\t\")") (Just "@'LSep' \\\" :\\t\\\"@") Nothing Nothing-             , makeAttr "Layout" ["layout"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Len" ["len"] "E" Dbl Nothing Nothing (Just "@1.0@ (neato), @0.3@ (fdp)") Nothing (Just "fdp, neato only")-             , makeAttr "LevelsGap" ["levelsgap"] "G" Dbl Nothing (Just "0") (Just "@0.0@") Nothing (Just "neato only")-             , makeAttr "Levels" ["levels"] "G" Integ Nothing (Just "maxBound") (Just "@'maxBound'@") (Just "@0@") (Just "sfdp only")-             , makeAttr "LHead" ["lhead"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "LHeight" ["LHeight"] "GC" Dbl Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.28.0")-             , makeAttr "LPos" ["lp"] "EGC" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only")-             , makeAttr "LTail" ["ltail"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "LWidth" ["lwidth"] "GC" Dbl Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.28.0")-             , makeAttr "Margin" ["margin"] "NG" (Cust "DPoint") Nothing Nothing (Just "device dependent") Nothing Nothing-             , makeAttr "MaxIter" ["maxiter"] "G" Integ Nothing Nothing (Just "@100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp)") Nothing (Just "fdp, neato only")-             , makeAttr "MCLimit" ["mclimit"] "G" Dbl Nothing (Just "1") (Just "@1.0@") Nothing (Just "dot only")-             , makeAttr "MinDist" ["mindist"] "G" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") (Just "circo only")-             , makeAttr "MinLen" ["minlen"] "E" Integ Nothing (Just "1") (Just "@1@") (Just "@0@") (Just "dot only")-             , makeAttr "Mode" ["mode"] "G" (Cust "ModeType") Nothing (Just "Major") (Just "@'Major'@") Nothing (Just "neato only")-             , makeAttr "Model" ["model"] "G" (Cust "Model") Nothing (Just "ShortPath") (Just "@'ShortPath'@") Nothing (Just "neato only")-             , makeAttr "Mosek" ["mosek"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "neato only; requires the Mosek software")-             , makeAttr "NodeSep" ["nodesep"] "G" Dbl Nothing (Just "0.25") (Just "@0.25@") (Just "@0.02@") (Just "dot only")-             , makeAttr "NoJustify" ["nojustify"] "GCNE" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "Normalize" ["normalize"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "not dot")-             , makeAttr "Nslimit" ["nslimit"] "G" Dbl Nothing Nothing Nothing Nothing (Just "dot only")-             , makeAttr "Nslimit1" ["nslimit1"] "G" Dbl Nothing Nothing Nothing Nothing (Just "dot only")-             , makeAttr "Ordering" ["ordering"] "GN" (Cust "Order") Nothing Nothing (Just "none") Nothing (Just "dot only")-             , makeAttr "Orientation" ["orientation"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@360.0@") Nothing-             , makeAttr "OutputOrder" ["outputorder"] "G" (Cust "OutputMode") Nothing (Just "BreadthFirst") (Just "@'BreadthFirst'@") Nothing Nothing-             , makeAttr "Overlap" ["overlap"] "G" (Cust "Overlap") (Just "KeepOverlaps") (Just "KeepOverlaps") (Just "@'KeepOverlaps'@") Nothing (Just "not dot")-             , makeAttr "OverlapScaling" ["overlap_scaling"] "G" Dbl Nothing (Just "(-4)") (Just "@-4@") (Just "@-1.0e10@") (Just "prism only")-             , makeAttr "Pack" ["pack"] "G" (Cust "Pack") (Just "DoPack") (Just "DontPack") (Just "@'DontPack'@") Nothing (Just "not dot")-             , makeAttr "PackMode" ["packmode"] "G" (Cust "PackMode") Nothing (Just "PackNode") (Just "@'PackNode'@") Nothing (Just "not dot")-             , makeAttr "Pad" ["pad"] "G" (Cust "DPoint") Nothing (Just "(DVal 0.0555)") (Just "@'DVal' 0.0555@ (4 points)") Nothing Nothing-             , makeAttr "Page" ["page"] "G" (Cust "Point") Nothing Nothing Nothing Nothing Nothing-             , makeAttr "PageDir" ["pagedir"] "G" (Cust "PageDir") Nothing (Just "Bl") (Just "@'Bl'@") Nothing Nothing-             , makeAttr "PenColor" ["pencolor"] "C" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing-             , makeAttr "PenWidth" ["penwidth"] "CNE" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") Nothing-             , makeAttr "Peripheries" ["peripheries"] "NC" Integ Nothing (Just "1") (Just "shape default (nodes), @1@ (clusters)") (Just "0") Nothing-             , makeAttr "Pin" ["pin"] "N" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "fdp, neato only")-             , makeAttr "Pos" ["pos"] "EN" (Cust "Pos") Nothing Nothing Nothing Nothing Nothing-             , makeAttr "QuadTree" ["quadtree"] "G" (Cust "QuadType") (Just "NormalQT") (Just "NormalQT") (Just "@'NormalQT'@") Nothing (Just "sfdp only")-             , makeAttr "Quantum" ["quantum"] "G" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@0.0@") Nothing-             , makeAttr "Rank" ["rank"] "S" (Cust "RankType") Nothing Nothing Nothing Nothing (Just "dot only")-             , makeAttr "RankDir" ["rankdir"] "G" (Cust "RankDir") Nothing (Just "FromTop") (Just "@'FromTop'@") Nothing (Just "dot only")-             , makeAttr "RankSep" ["ranksep"] "G" (Cust "[Double]") Nothing Nothing (Just "@[0.5]@ (dot), @[1.0]@ (twopi)") (Just "[0.02]") (Just "twopi, dot only")-             , makeAttr "Ratio" ["ratio"] "G" (Cust "Ratios") Nothing Nothing Nothing Nothing Nothing-             , makeAttr "Rects" ["rects"] "N" (Cust "[Rect]") Nothing Nothing Nothing Nothing (Just "write only")-             , makeAttr "Regular" ["regular"] "N" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing-             , makeAttr "ReMinCross" ["remincross"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "dot only")-             , makeAttr "RepulsiveForce" ["repulsiveforce"] "G" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") (Just "sfdp only")-             , makeAttr "Root" ["root"] "GN" (Cust "Root") (Just "IsCentral") (Just "(NodeName \"\")") (Just "@'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes)") Nothing (Just "circo, twopi only")-             , makeAttr "Rotate" ["rotate"] "G" Integ Nothing (Just "0") (Just "@0@") Nothing Nothing-             , makeAttr "Rotation" ["rotation"] "G" Dbl Nothing (Just "0") (Just "@0@") Nothing (Just "sfdp only, requires Graphviz >= 2.28.0")-             , makeAttr "SameHead" ["samehead"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "SameTail" ["sametail"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "SamplePoints" ["samplepoints"] "N" Integ Nothing Nothing (Just "@8@ (output), @20@ (overlap and image maps)") Nothing Nothing-             , makeAttr "Scale" ["scale"] "G" (Cust "DPoint") Nothing Nothing Nothing Nothing (Just "twopi only, requires Graphviz >= 2.28.0")-             , makeAttr "SearchSize" ["searchsize"] "G" Integ Nothing (Just "30") (Just "@30@") Nothing (Just "dot only")-             , makeAttr "Sep" ["sep"] "G" (Cust "DPoint") Nothing (Just "(DVal 4)") (Just "@'DVal' 4@") Nothing (Just "not dot")-             , makeAttr "Shape" ["shape"] "N" (Cust "Shape") Nothing (Just "Ellipse") (Just "@'Ellipse'@") Nothing Nothing-             , makeAttr "ShapeFile" ["shapefile"] "N" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "ShowBoxes" ["showboxes"] "ENG" Integ Nothing (Just "0") (Just "@0@") (Just "@0@") (Just "dot only")-             , makeAttr "Sides" ["sides"] "N" Integ Nothing (Just "4") (Just "@4@") (Just "@0@") Nothing-             , makeAttr "Size" ["size"] "G" (Cust "Point") Nothing Nothing Nothing Nothing Nothing-             , makeAttr "Skew" ["skew"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@-100.0@") Nothing-             , makeAttr "Smoothing" ["smoothing"] "G" (Cust "SmoothType") Nothing (Just "NoSmooth") (Just "@'NoSmooth'@") Nothing (Just "sfdp only")-             , makeAttr "SortV" ["sortv"] "GCN" (Cust "Word16") Nothing (Just "0") (Just "@0@") (Just "@0@") Nothing-             , makeAttr "Splines" ["splines"] "G" (Cust "EdgeType") (Just "SplineEdges") (Just "SplineEdges") Nothing Nothing Nothing-             , makeAttr "Start" ["start"] "G" (Cust "StartType") Nothing Nothing Nothing Nothing (Just "fdp, neato only")-             , makeAttr "Style" ["style"] "ENC" (Cust "[StyleItem]") Nothing Nothing Nothing Nothing Nothing-             , makeAttr "StyleSheet" ["stylesheet"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg only")-             , makeAttr "TailURL" ["tailURL", "tailhref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "TailClip" ["tailclip"] "E" Bl (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing-             , makeAttr "TailLabel" ["taillabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing Nothing-             , makeAttr "TailPort" ["tailport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing-             , makeAttr "TailTarget" ["tailtarget"] "E" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")-             , makeAttr "TailTooltip" ["tailtooltip"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Target" ["target"] "ENGC" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")-             , makeAttr "Tooltip" ["tooltip"] "NEC" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "TrueColor" ["truecolor"] "G" Bl (Just "True") Nothing Nothing Nothing (Just "bitmap output only")-             , makeAttr "Vertices" ["vertices"] "N" (Cust "[Point]") Nothing Nothing Nothing Nothing (Just "write only")-             , makeAttr "ViewPort" ["viewport"] "G" (Cust "ViewPort") Nothing Nothing (Just "none") Nothing Nothing-             , makeAttr "VoroMargin" ["voro_margin"] "G" Dbl Nothing (Just "0.05") (Just "@0.05@") (Just "@0.0@") (Just "not dot")-             , makeAttr "Weight" ["weight"] "E" Dbl Nothing Nothing (Just "@1.0@") (Just "@0@ (dot), @1@ (neato,fdp,sfdp)") Nothing-             , makeAttr "Width" ["width"] "N" Dbl Nothing (Just "0.75") (Just "@0.75@") (Just "@0.01@") Nothing-             , makeAttr "XLabel" ["xlabel"] "EN" (Cust "Label") Nothing (Just "(StrLabel \"\")")  (Just "@'StrLabel' \\\"\\\"@") Nothing (Just "requires Graphviz >= 2.29.0")-             , makeAttr "Z" ["z"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@-MAXFLOAT@, @-1000@") Nothing-             ]+attributes = [+  -- BEGIN RECEIVE ORGTBL Attributes+  makeAttr "Damping" ["Damping"] "G" (Dbl) Nothing (Just "0.99") (Just "@0.99@") (Just "@0.0@") (Just "'Neato' only"),+  makeAttr "K" ["K"] "GC" (Dbl) Nothing (Just "0.3") (Just "@0.3@") (Just "@0@") (Just "'Sfdp', 'Fdp' only"),+  makeAttr "URL" ["URL", "href"] "ENGC" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, postscript, map only"),+  makeAttr "Area" ["area"] "NC" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@>0@") (Just "'Patchwork' only, requires Graphviz >= 2.30.0"),+  makeAttr "ArrowHead" ["arrowhead"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing,+  makeAttr "ArrowSize" ["arrowsize"] "E" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") Nothing,+  makeAttr "ArrowTail" ["arrowtail"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing,+  makeAttr "Background" ["_background"] "G" (Strng) Nothing (Just "\"\"") (Just "none") Nothing (Just "xdot only"),+  makeAttr "BoundingBox" ["bb"] "G" (Cust "Rect") Nothing Nothing Nothing Nothing (Just "write only"),+  makeAttr "BgColor" ["bgcolor"] "GC" (Cust "ColorList") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,+  makeAttr "Center" ["center"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "ClusterRank" ["clusterrank"] "G" (Cust "ClusterMode") Nothing (Just "Local") (Just "@'Local'@") Nothing (Just "'Dot' only"),+  makeAttr "Color" ["color"] "ENC" (Cust "ColorList") Nothing (Just "[toWColor Black]") (Just "@['WC' ('X11Color' 'Black') Nothing]@") Nothing Nothing,+  makeAttr "ColorScheme" ["colorscheme"] "ENCG" (Cust "ColorScheme") Nothing (Just "X11") (Just "@'X11'@") Nothing Nothing,+  makeAttr "Comment" ["comment"] "ENG" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing,+  makeAttr "Compound" ["compound"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Dot' only"),+  makeAttr "Concentrate" ["concentrate"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "Constraint" ["constraint"] "E" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "'Dot' only"),+  makeAttr "Decorate" ["decorate"] "E" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "DefaultDist" ["defaultdist"] "G" (Dbl) Nothing Nothing (Just "@1+(avg. len)*sqrt(abs(V))@ (unable to statically define)") (Just "The value of 'Epsilon'.") (Just "'Neato' only, only if @'Pack' 'DontPack'@"),+  makeAttr "Dim" ["dim"] "G" (Integ) Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only"),+  makeAttr "Dimen" ["dimen"] "G" (Integ) Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only"),+  makeAttr "Dir" ["dir"] "E" (Cust "DirType") Nothing Nothing (Just "@'Forward'@ (directed), @'NoDir'@ (undirected)") Nothing Nothing,+  makeAttr "DirEdgeConstraints" ["diredgeconstraints"] "G" (Cust "DEConstraints") (Just "EdgeConstraints") (Just "NoConstraints") (Just "@'NoConstraints'@") Nothing (Just "'Neato' only"),+  makeAttr "Distortion" ["distortion"] "N" (Dbl) Nothing (Just "0.0") (Just "@0.0@") (Just "@-100.0@") Nothing,+  makeAttr "DPI" ["dpi", "resolution"] "G" (Dbl) Nothing (Just "96.0") (Just "@96.0@, @0.0@") Nothing (Just "svg, bitmap output only; \\\"resolution\\\" is a synonym"),+  makeAttr "EdgeURL" ["edgeURL", "edgehref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),+  makeAttr "EdgeTarget" ["edgetarget"] "E" (EStrng) Nothing Nothing (Just "none") Nothing (Just "svg, map only"),+  makeAttr "EdgeTooltip" ["edgetooltip"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),+  makeAttr "Epsilon" ["epsilon"] "G" (Dbl) Nothing Nothing (Just "@.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@)") Nothing (Just "'Neato' only"),+  makeAttr "ESep" ["esep"] "G" (Cust "DPoint") Nothing (Just "(DVal 3)") (Just "@'DVal' 3@") Nothing (Just "not 'Dot'"),+  makeAttr "FillColor" ["fillcolor"] "NEC" (Cust "ColorList") Nothing (Just "[toWColor Black]") (Just "@['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters)") Nothing Nothing,+  makeAttr "FixedSize" ["fixedsize"] "N" (Cust "NodeSize") (Just "SetNodeSize") (Just "GrowAsNeeded") (Just "@'GrowAsNeeded'@") Nothing Nothing,+  makeAttr "FontColor" ["fontcolor"] "ENGC" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing,+  makeAttr "FontName" ["fontname"] "ENGC" (Strng) Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing,+  makeAttr "FontNames" ["fontnames"] "G" (Cust "SVGFontNames") Nothing (Just "SvgNames") (Just "@'SvgNames'@") Nothing (Just "svg only"),+  makeAttr "FontPath" ["fontpath"] "G" (Cust "Paths") Nothing Nothing (Just "system dependent") Nothing Nothing,+  makeAttr "FontSize" ["fontsize"] "ENGC" (Dbl) Nothing (Just "14.0") (Just "@14.0@") (Just "@1.0@") Nothing,+  makeAttr "ForceLabels" ["forcelabels"] "G" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "only for 'XLabel' attributes, requires Graphviz >= 2.29.0"),+  makeAttr "GradientAngle" ["gradientangle"] "NCG" (Integ) Nothing (Just "0") (Just "0") Nothing (Just "requires Graphviz >= 2.29.0"),+  makeAttr "Group" ["group"] "N" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),+  makeAttr "HeadURL" ["headURL", "headhref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),+  makeAttr "Head_LP" ["head_lp"] "E" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.30.0"),+  makeAttr "HeadClip" ["headclip"] "E" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing,+  makeAttr "HeadLabel" ["headlabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing Nothing,+  makeAttr "HeadPort" ["headport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing,+  makeAttr "HeadTarget" ["headtarget"] "E" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only"),+  makeAttr "HeadTooltip" ["headtooltip"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),+  makeAttr "Height" ["height"] "N" (Dbl) Nothing (Just "0.5") (Just "@0.5@") (Just "@0.02@") Nothing,+  makeAttr "ID" ["id"] "GNE" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, postscript, map only"),+  makeAttr "Image" ["image"] "N" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing,+  makeAttr "ImagePath" ["imagepath"] "G" (Cust "Paths") Nothing (Just "(Paths [])") (Just "@'Paths' []@") Nothing (Just "Printing and parsing is OS-specific, requires Graphviz >= 2.29.0"),+  makeAttr "ImageScale" ["imagescale"] "N" (Cust "ScaleType") (Just "UniformScale") (Just "NoScale") (Just "@'NoScale'@") Nothing Nothing,+  makeAttr "InputScale" ["inputscale"] "N" (Dbl) Nothing Nothing (Just "none") Nothing (Just "'Fdp', 'Neato' only, a value of @0@ is equivalent to being @72@, requires Graphviz >= 2.36.0"),+  makeAttr "Label" ["label"] "ENGC" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise)") Nothing Nothing,+  makeAttr "LabelURL" ["labelURL", "labelhref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),+  makeAttr "LabelScheme" ["label_scheme"] "G" (Cust "LabelScheme") Nothing (Just "NotEdgeLabel") (Just "@'NotEdgeLabel'@") Nothing (Just "'Sfdp' only, requires Graphviz >= 2.28.0"),+  makeAttr "LabelAngle" ["labelangle"] "E" (Dbl) Nothing (Just "(-25.0)") (Just "@-25.0@") (Just "@-180.0@") Nothing,+  makeAttr "LabelDistance" ["labeldistance"] "E" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") Nothing,+  makeAttr "LabelFloat" ["labelfloat"] "E" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "LabelFontColor" ["labelfontcolor"] "E" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing,+  makeAttr "LabelFontName" ["labelfontname"] "E" (Strng) Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing,+  makeAttr "LabelFontSize" ["labelfontsize"] "E" (Dbl) Nothing (Just "14.0") (Just "@14.0@") (Just "@1.0@") Nothing,+  makeAttr "LabelJust" ["labeljust"] "GC" (Cust "Justification") Nothing (Just "JCenter") (Just "@'JCenter'@") Nothing Nothing,+  makeAttr "LabelLoc" ["labelloc"] "GCN" (Cust "VerticalPlacement") Nothing (Just "VTop") (Just "@'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)") Nothing Nothing,+  makeAttr "LabelTarget" ["labeltarget"] "E" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only"),+  makeAttr "LabelTooltip" ["labeltooltip"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),+  makeAttr "Landscape" ["landscape"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "Layer" ["layer"] "ENC" (Cust "LayerRange") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,+  makeAttr "LayerListSep" ["layerlistsep"] "G" (Cust "LayerListSep") Nothing (Just "(LLSep \",\")") (Just "@'LLSep' \\\",\\\"@") Nothing (Just "requires Graphviz >= 2.30.0"),+  makeAttr "Layers" ["layers"] "G" (Cust "LayerList") Nothing (Just "(LL [])") (Just "@'LL' []@") Nothing Nothing,+  makeAttr "LayerSelect" ["layerselect"] "G" (Cust "LayerRange") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,+  makeAttr "LayerSep" ["layersep"] "G" (Cust "LayerSep") Nothing (Just "(LSep \" :\\t\")") (Just "@'LSep' \\\" :\\t\\\"@") Nothing Nothing,+  makeAttr "Layout" ["layout"] "G" (Cust "GraphvizCommand") Nothing Nothing Nothing Nothing Nothing,+  makeAttr "Len" ["len"] "E" (Dbl) Nothing Nothing (Just "@1.0@ ('Neato'), @0.3@ ('Fdp')") Nothing (Just "'Fdp', 'Neato' only"),+  makeAttr "Levels" ["levels"] "G" (Integ) Nothing (Just "maxBound") (Just "@'maxBound'@") (Just "@0@") (Just "'Sfdp' only"),+  makeAttr "LevelsGap" ["levelsgap"] "G" (Dbl) Nothing (Just "0.0") (Just "@0.0@") Nothing (Just "'Neato' only"),+  makeAttr "LHead" ["lhead"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),+  makeAttr "LHeight" ["LHeight"] "GC" (Dbl) Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.28.0"),+  makeAttr "LPos" ["lp"] "EGC" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only"),+  makeAttr "LTail" ["ltail"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),+  makeAttr "LWidth" ["lwidth"] "GC" (Dbl) Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.28.0"),+  makeAttr "Margin" ["margin"] "NGC" (Cust "DPoint") Nothing Nothing (Just "device dependent") Nothing Nothing,+  makeAttr "MaxIter" ["maxiter"] "G" (Integ) Nothing Nothing (Just "@100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ ('Fdp')") Nothing (Just "'Fdp', 'Neato' only"),+  makeAttr "MCLimit" ["mclimit"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") Nothing (Just "'Dot' only"),+  makeAttr "MinDist" ["mindist"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") (Just "'Circo' only"),+  makeAttr "MinLen" ["minlen"] "E" (Integ) Nothing (Just "1") (Just "@1@") (Just "@0@") (Just "'Dot' only"),+  makeAttr "Mode" ["mode"] "G" (Cust "ModeType") Nothing (Just "Major") (Just "@'Major'@ (actually @'Spring'@ for 'Sfdp', but this isn't used as a default in this library)") Nothing (Just "'Neato', 'Sfdp' only"),+  makeAttr "Model" ["model"] "G" (Cust "Model") Nothing (Just "ShortPath") (Just "@'ShortPath'@") Nothing (Just "'Neato' only"),+  makeAttr "Mosek" ["mosek"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Neato' only; requires the Mosek software"),+  makeAttr "NodeSep" ["nodesep"] "G" (Dbl) Nothing (Just "0.25") (Just "@0.25@") (Just "@0.02@") Nothing,+  makeAttr "NoJustify" ["nojustify"] "GCNE" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "Normalize" ["normalize"] "G" (Cust "Normalized") (Just "IsNormalized") (Just "NotNormalized") (Just "@'NotNormalized'@") Nothing (Just "not 'Dot'"),+  makeAttr "NoTranslate" ["notranslate"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Neato' only, requires Graphviz >= 2.38.0"),+  makeAttr "Nslimit" ["nslimit"] "G" (Dbl) Nothing Nothing Nothing Nothing (Just "'Dot' only"),+  makeAttr "Nslimit1" ["nslimit1"] "G" (Dbl) Nothing Nothing Nothing Nothing (Just "'Dot' only"),+  makeAttr "Ordering" ["ordering"] "GN" (Cust "Order") Nothing Nothing (Just "none") Nothing (Just "'Dot' only"),+  makeAttr "Orientation" ["orientation"] "N" (Dbl) Nothing (Just "0.0") (Just "@0.0@") (Just "@360.0@") Nothing,+  makeAttr "OutputOrder" ["outputorder"] "G" (Cust "OutputMode") Nothing (Just "BreadthFirst") (Just "@'BreadthFirst'@") Nothing Nothing,+  makeAttr "Overlap" ["overlap"] "G" (Cust "Overlap") (Just "KeepOverlaps") (Just "KeepOverlaps") (Just "@'KeepOverlaps'@") Nothing (Just "not 'Dot'"),+  makeAttr "OverlapScaling" ["overlap_scaling"] "G" (Dbl) Nothing (Just "(-4)") (Just "@-4@") (Just "@-1.0e10@") (Just "'PrismOverlap' only"),+  makeAttr "OverlapShrink" ["overlap_shrink"] "G" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "'PrismOverlap' only, requires Graphviz >= 2.36.0"),+  makeAttr "Pack" ["pack"] "G" (Cust "Pack") (Just "DoPack") (Just "DontPack") (Just "@'DontPack'@") Nothing Nothing,+  makeAttr "PackMode" ["packmode"] "G" (Cust "PackMode") Nothing (Just "PackNode") (Just "@'PackNode'@") Nothing Nothing,+  makeAttr "Pad" ["pad"] "G" (Cust "DPoint") Nothing (Just "(DVal 0.0555)") (Just "@'DVal' 0.0555@ (4 points)") Nothing Nothing,+  makeAttr "Page" ["page"] "G" (Cust "Point") Nothing Nothing Nothing Nothing Nothing,+  makeAttr "PageDir" ["pagedir"] "G" (Cust "PageDir") Nothing (Just "Bl") (Just "@'Bl'@") Nothing Nothing,+  makeAttr "PenColor" ["pencolor"] "C" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing,+  makeAttr "PenWidth" ["penwidth"] "CNE" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") Nothing,+  makeAttr "Peripheries" ["peripheries"] "NC" (Integ) Nothing (Just "1") (Just "shape default (nodes), @1@ (clusters)") (Just "0") Nothing,+  makeAttr "Pin" ["pin"] "N" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Fdp', 'Neato' only"),+  makeAttr "Pos" ["pos"] "EN" (Cust "Pos") Nothing Nothing Nothing Nothing Nothing,+  makeAttr "QuadTree" ["quadtree"] "G" (Cust "QuadType") (Just "NormalQT") (Just "NormalQT") (Just "@'NormalQT'@") Nothing (Just "'Sfdp' only"),+  makeAttr "Quantum" ["quantum"] "G" (Dbl) Nothing (Just "0") (Just "@0.0@") (Just "@0.0@") Nothing,+  makeAttr "Rank" ["rank"] "S" (Cust "RankType") Nothing Nothing Nothing Nothing (Just "'Dot' only"),+  makeAttr "RankDir" ["rankdir"] "G" (Cust "RankDir") Nothing (Just "FromTop") (Just "@'FromTop'@") Nothing (Just "'Dot' only"),+  makeAttr "RankSep" ["ranksep"] "G" (Cust "[Double]") Nothing Nothing (Just "@[0.5]@ ('Dot'), @[1.0]@ ('Twopi')") (Just "@[0.02]@") (Just "'Twopi', 'Dot' only"),+  makeAttr "Ratio" ["ratio"] "G" (Cust "Ratios") Nothing Nothing Nothing Nothing Nothing,+  makeAttr "Rects" ["rects"] "N" (Cust "[Rect]") Nothing Nothing Nothing Nothing (Just "write only"),+  makeAttr "Regular" ["regular"] "N" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,+  makeAttr "ReMinCross" ["remincross"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Dot' only"),+  makeAttr "RepulsiveForce" ["repulsiveforce"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") (Just "'Sfdp' only"),+  makeAttr "Root" ["root"] "GN" (Cust "Root") (Just "IsCentral") (Just "(NodeName \"\")") (Just "@'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes)") Nothing (Just "'Circo', 'Twopi' only"),+  makeAttr "Rotate" ["rotate"] "G" (Integ) Nothing (Just "0") (Just "@0@") Nothing Nothing,+  makeAttr "Rotation" ["rotation"] "G" (Dbl) Nothing (Just "0") (Just "@0@") Nothing (Just "'Sfdp' only, requires Graphviz >= 2.28.0"),+  makeAttr "SameHead" ["samehead"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),+  makeAttr "SameTail" ["sametail"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),+  makeAttr "SamplePoints" ["samplepoints"] "N" (Integ) Nothing Nothing (Just "@8@ (output), @20@ (overlap and image maps)") Nothing Nothing,+  makeAttr "Scale" ["scale"] "G" (Cust "DPoint") Nothing Nothing Nothing Nothing (Just "Not 'Dot', requires Graphviz >= 2.28.0 (>= 2.38.0 for anything except 'TwoPi')"),+  makeAttr "SearchSize" ["searchsize"] "G" (Integ) Nothing (Just "30") (Just "@30@") Nothing (Just "'Dot' only"),+  makeAttr "Sep" ["sep"] "G" (Cust "DPoint") Nothing (Just "(DVal 4)") (Just "@'DVal' 4@") Nothing (Just "not 'Dot'"),+  makeAttr "Shape" ["shape"] "N" (Cust "Shape") Nothing (Just "Ellipse") (Just "@'Ellipse'@") Nothing Nothing,+  makeAttr "ShowBoxes" ["showboxes"] "ENG" (Integ) Nothing (Just "0") (Just "@0@") (Just "@0@") (Just "'Dot' only; used for debugging by printing PostScript guide boxes"),+  makeAttr "Sides" ["sides"] "N" (Integ) Nothing (Just "4") (Just "@4@") (Just "@0@") Nothing,+  makeAttr "Size" ["size"] "G" (Cust "GraphSize") Nothing Nothing Nothing Nothing Nothing,+  makeAttr "Skew" ["skew"] "N" (Dbl) Nothing (Just "0.0") (Just "@0.0@") (Just "@-100.0@") Nothing,+  makeAttr "Smoothing" ["smoothing"] "G" (Cust "SmoothType") Nothing (Just "NoSmooth") (Just "@'NoSmooth'@") Nothing (Just "'Sfdp' only"),+  makeAttr "SortV" ["sortv"] "GCN" (Cust "Word16") Nothing (Just "0") (Just "@0@") (Just "@0@") Nothing,+  makeAttr "Splines" ["splines"] "G" (Cust "EdgeType") (Just "SplineEdges") Nothing (Just "@'SplineEdges'@ ('Dot'), @'LineEdges'@ (other)") Nothing Nothing,+  makeAttr "Start" ["start"] "G" (Cust "StartType") Nothing Nothing (Just "@'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed.") Nothing (Just "'Fdp', 'Neato' only"),+  makeAttr "Style" ["style"] "ENCG" (Cust "[StyleItem]") Nothing Nothing Nothing Nothing Nothing,+  makeAttr "StyleSheet" ["stylesheet"] "G" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg only"),+  makeAttr "TailURL" ["tailURL", "tailhref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),+  makeAttr "Tail_LP" ["tail_lp"] "E" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.30.0"),+  makeAttr "TailClip" ["tailclip"] "E" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing,+  makeAttr "TailLabel" ["taillabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing Nothing,+  makeAttr "TailPort" ["tailport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing,+  makeAttr "TailTarget" ["tailtarget"] "E" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only"),+  makeAttr "TailTooltip" ["tailtooltip"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),+  makeAttr "Target" ["target"] "ENGC" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only"),+  makeAttr "Tooltip" ["tooltip"] "NEC" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),+  makeAttr "TrueColor" ["truecolor"] "G" (Bl) (Just "True") Nothing Nothing Nothing (Just "bitmap output only"),+  makeAttr "Vertices" ["vertices"] "N" (Cust "[Point]") Nothing Nothing Nothing Nothing (Just "write only"),+  makeAttr "ViewPort" ["viewport"] "G" (Cust "ViewPort") Nothing Nothing (Just "none") Nothing Nothing,+  makeAttr "VoroMargin" ["voro_margin"] "G" (Dbl) Nothing (Just "0.05") (Just "@0.05@") (Just "@0.0@") (Just "not 'Dot'"),+  makeAttr "Weight" ["weight"] "E" (Cust "Number") Nothing (Just "(Int 1)") (Just "@'Int' 1@") (Just "@'Int' 0@ ('Dot'), @'Int' 1@ ('Neato','Fdp','Sfdp')") (Just "as of Graphviz 2.30: weights for dot need to be 'Int's"),+  makeAttr "Width" ["width"] "N" (Dbl) Nothing (Just "0.75") (Just "@0.75@") (Just "@0.01@") Nothing,+  makeAttr "XDotVersion" ["xdotversion"] "G" (Cust "Version") Nothing Nothing Nothing Nothing (Just "xdot only, requires Graphviz >= 2.34.0, equivalent to specifying version of xdot to be used"),+  makeAttr "XLabel" ["xlabel"] "EN" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing (Just "requires Graphviz >= 2.29.0"),+  makeAttr "XLP" ["xlp"] "EN" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.29.0")+  -- END RECEIVE ORGTBL Attributes+  ] +{-++When using Emacs with org-mode available, hitting ` C-c C-c ' inside+the table below should update the actual Haskell code above.++This way, you can more easily edit/update the appropriate values.++* Values in "Allowed names" should be space-separated (and are+  converted into a list of Strings).++* Used by should consist of a sub-set of `ENGCS'.++* The entries in "Type" should be a valid Haskell value of type+  'VType' (parens are added).++* An empty cell in the last five columns translates to a `Nothing'+  value; anything else is wrapped in quotes and then has Just applied to+  it.  As such, you still need to escape quotes.++* Any entries in 'Parsing default' or "Default value" should be a+  valid Haskell value (add parens if needed) with the exception that+  double-quotes should be escaped.++* @C-c `@ can be used to edit a field that has been narrowed.++#+ORGTBL: SEND Attributes orgtbl-to-generic :skip 2 :splice t :hline nil :no-escape t :lstart "  makeAttr " :lend "," :llend "" :sep " " :fmt (1 cell-quote 2 cell-to-list 3 cell-quote 4 cell-parens 5 cell-to-maybe 6 cell-to-maybe 7 cell-to-maybe 8 cell-to-maybe 9 cell-to-maybe)+| Constructor     | Allowed names   | Used By | Type            | Parse def  | Default value   | Default for Documentation | Minimum    | Comment notes        |+|-----------------+-----------------+---------+-----------------+------------+-----------------+----------------------+------------+----------------------|+| <15>            | <15>            |         | <15>            | <10>       | <15>            | <20>                 | <10>       | <20>                 |+| Damping         | Damping         | G       | Dbl             |            | 0.99            | @0.99@               | @0.0@      | 'Neato' only         |+| K               | K               | GC      | Dbl             |            | 0.3             | @0.3@                | @0@        | 'Sfdp', 'Fdp' only   |+| URL             | URL href        | ENGC    | EStrng          |            | \"\"            | none                 |            | svg, postscript, map only |+| Area            | area            | NC      | Dbl             |            | 1.0             | @1.0@                | @>0@       | 'Patchwork' only, requires Graphviz >= 2.30.0 |+| ArrowHead       | arrowhead       | E       | Cust "ArrowType" |            | normal          | @'normal'@           |            |                      |+| ArrowSize       | arrowsize       | E       | Dbl             |            | 1.0             | @1.0@                | @0.0@      |                      |+| ArrowTail       | arrowtail       | E       | Cust "ArrowType" |            | normal          | @'normal'@           |            |                      |+| Background      | _background     | G       | Strng           |            | \"\"            | none                 |            | xdot only            |+| BoundingBox     | bb              | G       | Cust "Rect"     |            |                 |                      |            | write only           |+| BgColor         | bgcolor         | GC      | Cust "ColorList" |            | []              | @[]@                 |            |                      |+| Center          | center          | G       | Bl              | True       | False           | @'False'@            |            |                      |+| ClusterRank     | clusterrank     | G       | Cust "ClusterMode" |            | Local           | @'Local'@            |            | 'Dot' only           |+| Color           | color           | ENC     | Cust "ColorList" |            | [toWColor Black] | @['WC' ('X11Color' 'Black') Nothing]@ |            |                      |+| ColorScheme     | colorscheme     | ENCG    | Cust "ColorScheme" |            | X11             | @'X11'@              |            |                      |+| Comment         | comment         | ENG     | Strng           |            | \"\"            | @\\\"\\\"@           |            |                      |+| Compound        | compound        | G       | Bl              | True       | False           | @'False'@            |            | 'Dot' only           |+| Concentrate     | concentrate     | G       | Bl              | True       | False           | @'False'@            |            |                      |+| Constraint      | constraint      | E       | Bl              | True       | True            | @'True'@             |            | 'Dot' only           |+| Decorate        | decorate        | E       | Bl              | True       | False           | @'False'@            |            |                      |+| DefaultDist     | defaultdist     | G       | Dbl             |            |                 | @1+(avg. len)*sqrt(abs(V))@ (unable to statically define) | The value of 'Epsilon'. | 'Neato' only, only if @'Pack' 'DontPack'@ |+| Dim             | dim             | G       | Integ           |            | 2               | @2@                  | @2@        | maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only |+| Dimen           | dimen           | G       | Integ           |            | 2               | @2@                  | @2@        | maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only |+| Dir             | dir             | E       | Cust "DirType"  |            |                 | @'Forward'@ (directed), @'NoDir'@ (undirected) |            |                      |+| DirEdgeConstraints | diredgeconstraints | G       | Cust "DEConstraints" | EdgeConstraints | NoConstraints   | @'NoConstraints'@    |            | 'Neato' only         |+| Distortion      | distortion      | N       | Dbl             |            | 0.0             | @0.0@                | @-100.0@   |                      |+| DPI             | dpi resolution  | G       | Dbl             |            | 96.0            | @96.0@, @0.0@        |            | svg, bitmap output only; \\\"resolution\\\" is a synonym |+| EdgeURL         | edgeURL edgehref | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, map only        |+| EdgeTarget      | edgetarget      | E       | EStrng          |            |                 | none                 |            | svg, map only        |+| EdgeTooltip     | edgetooltip     | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, cmap only       |+| Epsilon         | epsilon         | G       | Dbl             |            |                 | @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@) |            | 'Neato' only         |+| ESep            | esep            | G       | Cust "DPoint"   |            | (DVal 3)        | @'DVal' 3@           |            | not 'Dot'            |+| FillColor       | fillcolor       | NEC     | Cust "ColorList" |            | [toWColor Black] | @['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters) |            |                      |+| FixedSize       | fixedsize       | N       | Cust "NodeSize" | SetNodeSize | GrowAsNeeded    | @'GrowAsNeeded'@     |            |                      |+| FontColor       | fontcolor       | ENGC    | Cust "Color"    |            | (X11Color Black) | @'X11Color' 'Black'@ |            |                      |+| FontName        | fontname        | ENGC    | Strng           |            | \"Times-Roman\" | @\\\"Times-Roman\\\"@ |            |                      |+| FontNames       | fontnames       | G       | Cust "SVGFontNames" |            | SvgNames        | @'SvgNames'@         |            | svg only             |+| FontPath        | fontpath        | G       | Cust "Paths"    |            |                 | system dependent     |            |                      |+| FontSize        | fontsize        | ENGC    | Dbl             |            | 14.0            | @14.0@               | @1.0@      |                      |+| ForceLabels     | forcelabels     | G       | Bl              | True       | True            | @'True'@             |            | only for 'XLabel' attributes, requires Graphviz >= 2.29.0 |+| GradientAngle   | gradientangle   | NCG     | Integ           |            | 0               | 0                    |            | requires Graphviz >= 2.29.0 |+| Group           | group           | N       | Strng           |            | \"\"            | @\\\"\\\"@           |            | 'Dot' only           |+| HeadURL         | headURL headhref | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, map only        |+| Head_LP         | head_lp         | E       | Cust "Point"    |            |                 |                      |            | write only, requires Graphviz >= 2.30.0 |+| HeadClip        | headclip        | E       | Bl              | True       | True            | @'True'@             |            |                      |+| HeadLabel       | headlabel       | E       | Cust "Label"    |            | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ |            |                      |+| HeadPort        | headport        | E       | Cust "PortPos"  |            | (CompassPoint CenterPoint) | @'CompassPoint' 'CenterPoint'@ |            |                      |+| HeadTarget      | headtarget      | E       | EStrng          |            | \"\"            | none                 |            | svg, map only        |+| HeadTooltip     | headtooltip     | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, cmap only       |+| Height          | height          | N       | Dbl             |            | 0.5             | @0.5@                | @0.02@     |                      |+| ID              | id              | GNE     | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, postscript, map only |+| Image           | image           | N       | Strng           |            | \"\"            | @\\\"\\\"@           |            |                      |+| ImagePath       | imagepath       | G       | Cust "Paths"    |            | (Paths [])      | @'Paths' []@         |            | Printing and parsing is OS-specific, requires Graphviz >= 2.29.0 |+| ImageScale      | imagescale      | N       | Cust "ScaleType" | UniformScale | NoScale         | @'NoScale'@          |            |                      |+| InputScale      | inputscale      | N       | Dbl             |            |                 | none                 |            | 'Fdp', 'Neato' only, a value of @0@ is equivalent to being @72@, requires Graphviz >= 2.36.0 |+| Label           | label           | ENGC    | Cust "Label"    |            | (StrLabel \"\") | @'StrLabel' \\\"\\\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise) |            |                      |+| LabelURL        | labelURL labelhref | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, map only        |+| LabelScheme     | label_scheme    | G       | Cust "LabelScheme" |            | NotEdgeLabel    | @'NotEdgeLabel'@     |            | 'Sfdp' only, requires Graphviz >= 2.28.0 |+| LabelAngle      | labelangle      | E       | Dbl             |            | (-25.0)         | @-25.0@              | @-180.0@   |                      |+| LabelDistance   | labeldistance   | E       | Dbl             |            | 1.0             | @1.0@                | @0.0@      |                      |+| LabelFloat      | labelfloat      | E       | Bl              | True       | False           | @'False'@            |            |                      |+| LabelFontColor  | labelfontcolor  | E       | Cust "Color"    |            | (X11Color Black) | @'X11Color' 'Black'@ |            |                      |+| LabelFontName   | labelfontname   | E       | Strng           |            | \"Times-Roman\" | @\\\"Times-Roman\\\"@ |            |                      |+| LabelFontSize   | labelfontsize   | E       | Dbl             |            | 14.0            | @14.0@               | @1.0@      |                      |+| LabelJust       | labeljust       | GC      | Cust "Justification" |            | JCenter         | @'JCenter'@          |            |                      |+| LabelLoc        | labelloc        | GCN     | Cust "VerticalPlacement" |            | VTop            | @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes) |            |                      |+| LabelTarget     | labeltarget     | E       | EStrng          |            | \"\"            | none                 |            | svg, map only        |+| LabelTooltip    | labeltooltip    | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, cmap only       |+| Landscape       | landscape       | G       | Bl              | True       | False           | @'False'@            |            |                      |+| Layer           | layer           | ENC     | Cust "LayerRange" |            | []              | @[]@                 |            |                      |+| LayerListSep    | layerlistsep    | G       | Cust "LayerListSep" |            | (LLSep \",\")   | @'LLSep' \\\",\\\"@  |            | requires Graphviz >= 2.30.0 |+| Layers          | layers          | G       | Cust "LayerList" |            | (LL [])         | @'LL' []@            |            |                      |+| LayerSelect     | layerselect     | G       | Cust "LayerRange" |            | []              | @[]@                 |            |                      |+| LayerSep        | layersep        | G       | Cust "LayerSep" |            | (LSep \" :\\t\") | @'LSep' \\\" :\\t\\\"@ |            |                      |+| Layout          | layout          | G       | Cust "GraphvizCommand" |            |                 |                      |            |                      |+| Len             | len             | E       | Dbl             |            |                 | @1.0@ ('Neato'), @0.3@ ('Fdp') |            | 'Fdp', 'Neato' only  |+| Levels          | levels          | G       | Integ           |            | maxBound        | @'maxBound'@         | @0@        | 'Sfdp' only          |+| LevelsGap       | levelsgap       | G       | Dbl             |            | 0.0             | @0.0@                |            | 'Neato' only         |+| LHead           | lhead           | E       | Strng           |            | \"\"            | @\\\"\\\"@           |            | 'Dot' only           |+| LHeight         | LHeight         | GC      | Dbl             |            |                 |                      |            | write only, requires Graphviz >= 2.28.0 |+| LPos            | lp              | EGC     | Cust "Point"    |            |                 |                      |            | write only           |+| LTail           | ltail           | E       | Strng           |            | \"\"            | @\\\"\\\"@           |            | 'Dot' only           |+| LWidth          | lwidth          | GC      | Dbl             |            |                 |                      |            | write only, requires Graphviz >= 2.28.0 |+| Margin          | margin          | NGC     | Cust "DPoint"   |            |                 | device dependent     |            |                      |+| MaxIter         | maxiter         | G       | Integ           |            |                 | @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ ('Fdp') |            | 'Fdp', 'Neato' only  |+| MCLimit         | mclimit         | G       | Dbl             |            | 1.0             | @1.0@                |            | 'Dot' only           |+| MinDist         | mindist         | G       | Dbl             |            | 1.0             | @1.0@                | @0.0@      | 'Circo' only         |+| MinLen          | minlen          | E       | Integ           |            | 1               | @1@                  | @0@        | 'Dot' only           |+| Mode            | mode            | G       | Cust "ModeType" |            | Major           | @'Major'@ (actually @'Spring'@ for 'Sfdp', but this isn't used as a default in this library) |            | 'Neato', 'Sfdp' only |+| Model           | model           | G       | Cust "Model"    |            | ShortPath       | @'ShortPath'@        |            | 'Neato' only         |+| Mosek           | mosek           | G       | Bl              | True       | False           | @'False'@            |            | 'Neato' only; requires the Mosek software |+| NodeSep         | nodesep         | G       | Dbl             |            | 0.25            | @0.25@               | @0.02@     |                      |+| NoJustify       | nojustify       | GCNE    | Bl              | True       | False           | @'False'@            |            |                      |+| Normalize       | normalize       | G       | Cust "Normalized" | IsNormalized | NotNormalized   | @'NotNormalized'@    |            | not 'Dot'            |+| NoTranslate     | notranslate     | G       | Bl              | True       | False           | @'False'@            |            | 'Neato' only, requires Graphviz >= 2.38.0 |+| Nslimit         | nslimit         | G       | Dbl             |            |                 |                      |            | 'Dot' only           |+| Nslimit1        | nslimit1        | G       | Dbl             |            |                 |                      |            | 'Dot' only           |+| Ordering        | ordering        | GN      | Cust "Order"    |            |                 | none                 |            | 'Dot' only           |+| Orientation     | orientation     | N       | Dbl             |            | 0.0             | @0.0@                | @360.0@    |                      |+| OutputOrder     | outputorder     | G       | Cust "OutputMode" |            | BreadthFirst    | @'BreadthFirst'@     |            |                      |+| Overlap         | overlap         | G       | Cust "Overlap"  | KeepOverlaps | KeepOverlaps    | @'KeepOverlaps'@     |            | not 'Dot'            |+| OverlapScaling  | overlap_scaling | G       | Dbl             |            | (-4)            | @-4@                 | @-1.0e10@  | 'PrismOverlap' only  |+| OverlapShrink   | overlap_shrink  | G       | Bl              | True       | True            | @'True'@             |            | 'PrismOverlap' only, requires Graphviz >= 2.36.0 |+| Pack            | pack            | G       | Cust "Pack"     | DoPack     | DontPack        | @'DontPack'@         |            |                      |+| PackMode        | packmode        | G       | Cust "PackMode" |            | PackNode        | @'PackNode'@         |            |                      |+| Pad             | pad             | G       | Cust "DPoint"   |            | (DVal 0.0555)   | @'DVal' 0.0555@ (4 points) |            |                      |+| Page            | page            | G       | Cust "Point"    |            |                 |                      |            |                      |+| PageDir         | pagedir         | G       | Cust "PageDir"  |            | Bl              | @'Bl'@               |            |                      |+| PenColor        | pencolor        | C       | Cust "Color"    |            | (X11Color Black) | @'X11Color' 'Black'@ |            |                      |+| PenWidth        | penwidth        | CNE     | Dbl             |            | 1.0             | @1.0@                | @0.0@      |                      |+| Peripheries     | peripheries     | NC      | Integ           |            | 1               | shape default (nodes), @1@ (clusters) | 0          |                      |+| Pin             | pin             | N       | Bl              | True       | False           | @'False'@            |            | 'Fdp', 'Neato' only  |+| Pos             | pos             | EN      | Cust "Pos"      |            |                 |                      |            |                      |+| QuadTree        | quadtree        | G       | Cust "QuadType" | NormalQT   | NormalQT        | @'NormalQT'@         |            | 'Sfdp' only          |+| Quantum         | quantum         | G       | Dbl             |            | 0               | @0.0@                | @0.0@      |                      |+| Rank            | rank            | S       | Cust "RankType" |            |                 |                      |            | 'Dot' only           |+| RankDir         | rankdir         | G       | Cust "RankDir"  |            | FromTop         | @'FromTop'@          |            | 'Dot' only           |+| RankSep         | ranksep         | G       | Cust "[Double]" |            |                 | @[0.5]@ ('Dot'), @[1.0]@ ('Twopi') | @[0.02]@   | 'Twopi', 'Dot' only  |+| Ratio           | ratio           | G       | Cust "Ratios"   |            |                 |                      |            |                      |+| Rects           | rects           | N       | Cust "[Rect]"   |            |                 |                      |            | write only           |+| Regular         | regular         | N       | Bl              | True       | False           | @'False'@            |            |                      |+| ReMinCross      | remincross      | G       | Bl              | True       | False           | @'False'@            |            | 'Dot' only           |+| RepulsiveForce  | repulsiveforce  | G       | Dbl             |            | 1.0             | @1.0@                | @0.0@      | 'Sfdp' only          |+| Root            | root            | GN      | Cust "Root"     | IsCentral  | (NodeName \"\") | @'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes) |            | 'Circo', 'Twopi' only |+| Rotate          | rotate          | G       | Integ           |            | 0               | @0@                  |            |                      |+| Rotation        | rotation        | G       | Dbl             |            | 0               | @0@                  |            | 'Sfdp' only, requires Graphviz >= 2.28.0 |+| SameHead        | samehead        | E       | Strng           |            | \"\"            | @\\\"\\\"@           |            | 'Dot' only           |+| SameTail        | sametail        | E       | Strng           |            | \"\"            | @\\\"\\\"@           |            | 'Dot' only           |+| SamplePoints    | samplepoints    | N       | Integ           |            |                 | @8@ (output), @20@ (overlap and image maps) |            |                      |+| Scale           | scale           | G       | Cust "DPoint"   |            |                 |                      |            | Not 'Dot', requires Graphviz >= 2.28.0 (>= 2.38.0 for anything except 'TwoPi') |+| SearchSize      | searchsize      | G       | Integ           |            | 30              | @30@                 |            | 'Dot' only           |+| Sep             | sep             | G       | Cust "DPoint"   |            | (DVal 4)        | @'DVal' 4@           |            | not 'Dot'            |+| Shape           | shape           | N       | Cust "Shape"    |            | Ellipse         | @'Ellipse'@          |            |                      |+| ShowBoxes       | showboxes       | ENG     | Integ           |            | 0               | @0@                  | @0@        | 'Dot' only; used for debugging by printing PostScript guide boxes |+| Sides           | sides           | N       | Integ           |            | 4               | @4@                  | @0@        |                      |+| Size            | size            | G       | Cust "GraphSize" |            |                 |                      |            |                      |+| Skew            | skew            | N       | Dbl             |            | 0.0             | @0.0@                | @-100.0@   |                      |+| Smoothing       | smoothing       | G       | Cust "SmoothType" |            | NoSmooth        | @'NoSmooth'@         |            | 'Sfdp' only          |+| SortV           | sortv           | GCN     | Cust "Word16"   |            | 0               | @0@                  | @0@        |                      |+| Splines         | splines         | G       | Cust "EdgeType" | SplineEdges |                 | @'SplineEdges'@ ('Dot'), @'LineEdges'@ (other) |            |                      |+| Start           | start           | G       | Cust "StartType" |            |                 | @'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed. |            | 'Fdp', 'Neato' only  |+| Style           | style           | ENCG    | Cust "[StyleItem]" |            |                 |                      |            |                      |+| StyleSheet      | stylesheet      | G       | Strng           |            | \"\"            | @\\\"\\\"@           |            | svg only             |+| TailURL         | tailURL tailhref | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, map only        |+| Tail_LP         | tail_lp         | E       | Cust "Point"    |            |                 |                      |            | write only, requires Graphviz >= 2.30.0 |+| TailClip        | tailclip        | E       | Bl              | True       | True            | @'True'@             |            |                      |+| TailLabel       | taillabel       | E       | Cust "Label"    |            | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ |            |                      |+| TailPort        | tailport        | E       | Cust "PortPos"  |            | (CompassPoint CenterPoint) | @'CompassPoint' 'CenterPoint'@ |            |                      |+| TailTarget      | tailtarget      | E       | EStrng          |            | \"\"            | none                 |            | svg, map only        |+| TailTooltip     | tailtooltip     | E       | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, cmap only       |+| Target          | target          | ENGC    | EStrng          |            | \"\"            | none                 |            | svg, map only        |+| Tooltip         | tooltip         | NEC     | EStrng          |            | \"\"            | @\\\"\\\"@           |            | svg, cmap only       |+| TrueColor       | truecolor       | G       | Bl              | True       |                 |                      |            | bitmap output only   |+| Vertices        | vertices        | N       | Cust "[Point]"  |            |                 |                      |            | write only           |+| ViewPort        | viewport        | G       | Cust "ViewPort" |            |                 | none                 |            |                      |+| VoroMargin      | voro_margin     | G       | Dbl             |            | 0.05            | @0.05@               | @0.0@      | not 'Dot'            |+| Weight          | weight          | E       | Cust "Number"   |            | (Int 1)         | @'Int' 1@            | @'Int' 0@ ('Dot'), @'Int' 1@ ('Neato','Fdp','Sfdp') | as of Graphviz 2.30: weights for dot need to be 'Int's |+| Width           | width           | N       | Dbl             |            | 0.75            | @0.75@               | @0.01@     |                      |+| XDotVersion     | xdotversion     | G       | Cust "Version"  |            |                 |                      |            | xdot only, requires Graphviz >= 2.34.0, equivalent to specifying version of xdot to be used |+| XLabel          | xlabel          | EN      | Cust "Label"    |            | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ |            | requires Graphviz >= 2.29.0 |+| XLP             | xlp             | EN      | Cust "Point"    |            |                 |                      |            | write only, requires Graphviz >= 2.29.0 |++-}+ unknownAttr :: Doc unknownAttr = text "UnknownAttribute" +-- For testing purposes+attrs :: [Attribute] attrs = take 10 $ drop 5 attributes +-- For testing purposes+attrs' :: Atts attrs' = AS (text "Attribute") attrs  bool       :: a -> a -> Bool -> a@@ -617,3 +838,12 @@  dollar :: Doc dollar = char '$'+++-- Local Variables:+-- eval: (turn-on-orgtbl)+-- eval: (defun cell-quote (s) (concat "\"" s "\""))+-- eval: (defun cell-parens (s) (concat "(" s ")"))+-- eval: (defun cell-to-maybe (s) (if (string= "" s) "Nothing" (cell-parens (concat "Just " (cell-quote s)))))+-- eval: (defun cell-to-list (s) (concat "[" (mapconcat 'cell-quote (split-string s) ", ") "]"))+-- END:
utils/Benchmark.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ {- |    Module      : Benchmark    Description : Benchmarking utilities for graphviz@@ -10,13 +12,13 @@ -} module Main where -import Data.GraphViz hiding (DotGraph)+import Data.GraphViz                   hiding (DotGraph) import Data.GraphViz.Types.Generalised  import Criterion.Main  import Control.DeepSeq-import Data.Text.Lazy(Text)+import Data.Text.Lazy  (Text)  -- -----------------------------------------------------------------------------
utils/TestParsing.hs view
@@ -1,4 +1,4 @@-#!/usr/bin/runhaskell+{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}  {- |    Module      : TestParsing@@ -12,23 +12,25 @@    (with the assumption that the provided code is valid).  -}-module Main where+module Main (main) where -import Data.GraphViz+import           Data.GraphViz+import           Data.GraphViz.Commands.IO       (toUTF8)+import           Data.GraphViz.Exception+import           Data.GraphViz.Parsing           (runParser)+import           Data.GraphViz.PreProcessing     (preProcess) import qualified Data.GraphViz.Types.Generalised as G-import Data.GraphViz.Parsing(runParser)-import Data.GraphViz.PreProcessing(preProcess)-import Data.GraphViz.Commands.IO(hGetStrict, toUTF8)-import Data.GraphViz.Exception -import qualified Data.Text.Lazy as T-import Data.Text.Lazy(Text)+import           Control.Exception    (SomeException, evaluate, try)+import           Control.Monad        (filterM, liftM) import qualified Data.ByteString.Lazy as B-import Control.Exception(try, evaluate, SomeException)-import Control.Monad(liftM, filterM)-import System.Directory-import System.FilePath-import System.Environment(getArgs)+import           Data.Either          (either)+import           Data.Monoid          (mappend)+import           Data.Text.Lazy       (Text)+import qualified Data.Text.Lazy       as T+import           System.Directory+import           System.Environment   (getArgs)+import           System.FilePath  -- ----------------------------------------------------------------------------- @@ -41,7 +43,7 @@                                \\n\                                \One way of using this file:\n\t\                                \$ locate -r \".*\\.\\(gv\\|dot\\)$\" -0\-                               \ | xargs -0 runhaskell TestParsing.hs"+                               \ | xargs -0 TestParsing.hs"     tryParsing [fp] = do isDir <- doesDirectoryExist fp                          if isDir                             then mapM_ tryParseFile =<< getDContents fp@@ -53,56 +55,53 @@  -- ----------------------------------------------------------------------------- --withParse :: (PPDotRepr dg n) => (a -> IO Text) -> (dg n -> IO ())+withParse :: (Show a, PPDotRepr dg n) => (a -> IO Text) -> (dg n -> IO ())              -> (ErrMsg -> String) -> a -> IO () withParse toStr withDG cmbErr a = do dc <- liftM getMsg . try $ toStr a                                      case dc of                                        Right dc' -> do edg <- tryParse dc'                                                        case edg of                                                          (Right dg) -> withDG dg-                                                         (Left err) -> do putStrLn "Parsing problem!"+                                                         (Left err) -> do putStr (show a)+                                                                          putStrLn " - Parsing problem!"                                                                           putStrLn $ cmbErr err                                                                           putStrLn  ""-                                       Left err  -> do putStrLn "IO problem!"+                                       Left err  -> do putStr (show a)+                                                       putStrLn " - IO problem!"                                                        putStrLn err                                                        putStrLn ""   where     getMsg :: Either SomeException Text -> Either ErrMsg Text     getMsg = either (Left . show) Right -type DG = DotGraph Text type GDG = G.DotGraph Text type ErrMsg = String  tryParseFile    :: FilePath -> IO ()-tryParseFile fp = withParse readFile'-                            (tryParseCanon fp)+tryParseFile fp = withParse readUTF8File+                            ((`seq` return ()) . T.length . printDotGraph . asGDG)                             ("Cannot parse as a G.DotGraph: "++)                             fp--tryParseCanon    :: FilePath -> GDG -> IO ()-tryParseCanon fp = withParse prettyPrint-                             ((`seq` putStrLn "Parsed OK!") . T.length . printDotGraph . asDG)-                             (\ e -> fp ++ ": Canonical Form not a DotGraph:\n"-                                     ++ e)   where-    asDG = flip asTypeOf emptDG-    emptDG = DotGraph False False Nothing $ DotStmts [] [] [] [] :: DG-    prettyPrint dg = graphvizWithHandle (commandFor dg) dg Canon hGetStrict+    asGDG :: GDG -> GDG+    asGDG = id  tryParse    :: (PPDotRepr dg n) => Text -> IO (Either ErrMsg (dg n)) tryParse dc = handle getErr               $ let (dg, rst) = runParser parse $ preProcess dc-                in T.length rst `seq` return dg+                in T.length rst `seq` return (eitherLR (augmentErr rst) id dg)   where     getErr :: SomeException -> IO (Either ErrMsg a)     getErr = return . Left . show -readFile' :: FilePath -> IO Text-readFile' fp = do putStr fp-                  putStr " - "-                  readUTF8File fp+    augmentErr rst err = err ++ "\n\tRemaining input: " ++ show res+      where+        sampleLen = 35++        res | T.length rst <= sampleLen = rst+            | otherwise                 = T.take sampleLen rst `mappend` " ..."++    eitherLR f g = either (Left . f) (Right . g)  -- Force any encoding errors into the IO section rather than when parsing. readUTF8File    :: FilePath -> IO Text