graphviz 2999.1.0.2 → 2999.5.0.0

raw patch · 12 files changed

+3549/−2387 lines, 12 filesdep +prettyPVP ok

version bump matches the API change (PVP)

Dependencies added: pretty

API changes (from Hackage documentation)

Files

• Changelog +53/−0
• Data/GraphViz.hs +213/−62
• Data/GraphViz/Attributes.hs +2195/−1849
• Data/GraphViz/Commands.hs +9/−7
• Data/GraphViz/ParserCombinators.hs +0/−239
• Data/GraphViz/Types.hs +526/−173
• Data/GraphViz/Types/Clustering.hs +45/−44
• Data/GraphViz/Types/Internal.hs +63/−0
• Data/GraphViz/Types/Parsing.hs +285/−0
• Data/GraphViz/Types/Printing.hs +151/−0
• TODO +2/−9
• graphviz.cabal +7/−4

@@ -1,3 +1,56 @@+Changes since 2999.1.0.2+========================++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.  Also add cluster support for the graph+  -> dot -> graph conversion-style 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 since 2999.1.0.1+========================++* Fix a bug spotted by Srihari Ramanathan where Color values were+  double-quoted.++Changes since 2999.1.0.0+========================++* The Color Attribute should take [Color], not just a single Color.++Changes since 2999.0.0.0+========================++* Stop using Either for composite Attributes and use a custom type:+  this avoids problems with the Show instance.+ Changes since 2009.5.1 ====================== 

@@ -6,22 +6,44 @@    Maintainer  : Ivan.Miljenovic@gmail.com     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/ program (as well as a-   limited ability to perform the reverse operation).+   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).     Information about GraphViz and the Dot language can be found at:    <http://graphviz.org/>- -} +   Commands for converting graphs to Dot format have two options: one+   in which the user specifies whether the graph is directed or+   undirected, and a primed version which attempts to automatically+   infer if the graph is directed or not.  Note that these conversion+   functions assume that undirected graphs have every edge being+   duplicated (or at least that if there exists an edge from /n1/ to+   /n2/, then /n1 <= n2/).+ -} module Data.GraphViz-    ( graphToDot-    , clusterGraphToDot-    , graphToGraph-    , dotizeGraph+    ( -- * Conversion from graphs to /Dot/ format.+      graphToDot+    , graphToDot'+      -- ** Conversion with support for clusters.     , NodeCluster(..)+    , clusterGraphToDot+    , clusterGraphToDot'+      -- * Passing the graph through GraphViz.+      -- ** Type aliases for @Node@ and @Edge@ labels.     , AttributeNode     , AttributeEdge+      -- ** For normal graphs.+    , graphToGraph+    , graphToGraph'+    , dotizeGraph+    , dotizeGraph'+      -- ** For clustered graphs.+    , clusterGraphToGraph+    , clusterGraphToGraph'+    , dotizeClusterGraph+    , dotizeClusterGraph'+      -- * Re-exporting other modules.     , module Data.GraphViz.Types     , module Data.GraphViz.Attributes     , module Data.GraphViz.Commands@@ -31,110 +53,239 @@ import Data.GraphViz.Types.Clustering import Data.GraphViz.Attributes import Data.GraphViz.Commands-import Data.GraphViz.ParserCombinators(runParser)  import Data.Graph.Inductive.Graph import qualified Data.Set as Set import Control.Arrow((&&&))-import Data.Maybe+import Data.Maybe(mapMaybe, fromJust) import qualified Data.Map as Map import System.IO(hGetContents) import System.IO.Unsafe(unsafePerformIO)  -- ----------------------------------------------------------------------------- --- | Determine if the given graph is undirected or directed.-isUndir   :: (Ord b, Graph g) => g a b -> Bool-isUndir g = all hasFlip es+-- | Determine if the given graph is undirected.+isUndirected   :: (Ord b, Graph g) => g a b -> Bool+isUndirected g = all hasFlip es     where       es = labEdges g       eSet = Set.fromList es       hasFlip e = Set.member (flippedEdge e) eSet       flippedEdge (f,t,l) = (t,f,l) +-- | Determine if the given graph is directed.+isDirected :: (Ord b, Graph g) => g a b -> Bool+isDirected = not . isUndirected+ -- ----------------------------------------------------------------------------- --- | Convert a graph to GraphViz's /Dot/ format.-graphToDot :: (Ord b, Graph gr) => gr a b -> [Attribute]-           -> (LNode a -> [Attribute]) -> (LEdge b -> [Attribute]) -> DotGraph-graphToDot graph gAttributes fmtNode fmtEdge-    = clusterGraphToDot graph gAttributes clusterBy fmtCluster fmtNode fmtEdge+-- | Convert a graph to GraphViz's /Dot/ format.  The 'Bool' value is+--   'True' for directed graphs, 'False' otherwise.+graphToDot :: (Graph gr) => Bool -> gr a b -> [GlobalAttributes]+              -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+              -> DotGraph Node+graphToDot isDir graph gAttributes+    = clusterGraphToDot isDir graph gAttributes clustBy cID fmtClust       where-        clusterBy :: LNode a -> NodeCluster () a-        clusterBy = N-        fmtCluster _ = []+        clustBy :: LNode a -> NodeCluster () a+        clustBy = N+        cID = const Nothing+        fmtClust = const [] +-- | Convert a graph to GraphViz's /Dot/ format with automatic+--   direction detection.+graphToDot'       :: (Ord b, Graph gr) => gr a b -> [GlobalAttributes]+                     -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+                     -> DotGraph Node+graphToDot' graph = graphToDot (isDirected graph) graph+ -- | Convert a graph to /Dot/ format, using the specified clustering function --   to group nodes into clusters. --   Clusters can be nested to arbitrary depth.-clusterGraphToDot :: (Ord c, Ord b, Graph gr) => gr a b-                  -> [Attribute] -> (LNode a -> NodeCluster c a)-                  -> (c -> [Attribute]) -> (LNode a -> [Attribute])-                  -> (LEdge b -> [Attribute]) -> DotGraph-clusterGraphToDot graph gAttrs clusterBy fmtCluster fmtNode fmtEdge+--   The 'Bool' argument is 'True' for directed graphs, 'False' otherwise.+clusterGraphToDot :: (Ord c, Graph gr) => Bool -> gr a b+                     -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)+                     -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+                     -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+                     -> DotGraph Node+clusterGraphToDot dirGraph graph gAttrs clusterBy cID fmtCluster fmtNode fmtEdge     = DotGraph { strictGraph     = False                , directedGraph   = dirGraph                , graphID         = Nothing-               , graphAttributes = gAttrs-               , graphNodes      = ns-               , graphEdges      = es+               , graphStatements = stmts                }       where-        dirGraph = not $ isUndir graph-        ns = clustersToNodes clusterBy fmtCluster fmtNode graph+        stmts = DotStmts { attrStmts = gAttrs+                         , subGraphs = cs+                         , nodeStmts = ns+                         , edgeStmts = es+                         }+        (cs, ns) = clustersToNodes clusterBy cID fmtCluster fmtNode graph         es = mapMaybe mkDotEdge . labEdges $ graph         mkDotEdge e@(f,t,_) = if dirGraph || f <= t-                              then Just DotEdge {edgeHeadNodeID = f-                                                ,edgeTailNodeID = t-                                                ,edgeAttributes = fmtEdge e-                                                ,directedEdge = dirGraph}+                              then Just DotEdge { edgeFromNodeID = f+                                                , edgeToNodeID   = t+                                                , edgeAttributes = fmtEdge e+                                                , directedEdge   = dirGraph+                                                }                               else Nothing +-- | Convert a graph to /Dot/ format, using the specified clustering function+--   to group nodes into clusters.+--   Clusters can be nested to arbitrary depth.+--   Graph direction is automatically inferred.+clusterGraphToDot'    :: (Ord c, Ord b, Graph gr) => gr a b+                         -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)+                         -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+                         -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+                         -> DotGraph Node+clusterGraphToDot' gr = clusterGraphToDot (isDirected gr) gr+ -- ----------------------------------------------------------------------------- -type AttributeNode a = ([Attribute], a)-type AttributeEdge b = ([Attribute], b)+type AttributeNode a = (Attributes, a)+type AttributeEdge b = (Attributes, b) --- | Run the graph via dot to get positional information and then---   combine that information back into the original graph.---   Note that this doesn't support graphs with clusters.-graphToGraph :: (Ord b, Graph gr) => gr a b -> [Attribute]-                -> (LNode a -> [Attribute]) -> (LEdge b -> [Attribute])+-- | Run the appropriate GraphViz command on the graph to get+--   positional information and then combine that information back+--   into the original graph.  Note that for the edge information to+--   be parsed properly when using multiple edges, each edge between+--   two nodes needs to have a unique label.+--+--   The 'Bool' argument is 'True' for directed graphs, 'False'+--   otherwise.  Directed graphs are passed through /dot/, and+--   undirected graphs through /neato/.+graphToGraph :: (Graph gr) => Bool -> gr a b -> [GlobalAttributes]+                -> (LNode a -> Attributes) -> (LEdge b -> Attributes)                 -> IO (gr (AttributeNode a) (AttributeEdge b))-graphToGraph gr gAttributes fmtNode fmtEdge+graphToGraph isDir gr gAttributes fmtNode fmtEdge+    = dotAttributes isDir gr dot+    where+      dot = graphToDot isDir gr gAttributes fmtNode fmtEdge++dotAttributes :: (Graph gr) => Bool -> gr a b -> DotGraph Node+                 -> IO (gr (AttributeNode a) (AttributeEdge b))+dotAttributes isDir gr dot     = do output <- graphvizWithHandle command dot DotOutput hGetContents          let res = fromJust output          length res `seq` return ()          return $ rebuildGraphWithAttributes res     where-      undirected = isUndir gr-      command = if undirected then undirCommand else dirCommand-      dot = graphToDot gr gAttributes fmtNode fmtEdge+      command = if isDir then dirCommand else undirCommand       rebuildGraphWithAttributes dotResult = mkGraph lnodes ledges           where             lnodes = map (\(n, l) -> (n, (fromJust $ Map.lookup n nodeMap, l)))                      $ labNodes gr             ledges = map createEdges $ labEdges gr-            createEdges (f, t, l) = if undirected && f > t-                                    then (f, t, getLabel (t,f))-                                    else (f, t, getLabel (f,t))+            createEdges (f, t, l) = if isDir || f <= t+                                    then (f, t, getLabel (f,t))+                                    else (f, t, getLabel (t,f))                 where                   getLabel c = (fromJust $ Map.lookup c edgeMap, l)-            DotGraph { graphNodes = ns, graphEdges = es}-                = fst . runParser parseDotGraph $ dotResult+            g' = parseDotGraph dotResult+            ns = graphNodes g'+            es = graphEdges g'             nodeMap = Map.fromList $ map (nodeID &&& nodeAttributes) ns-            edgeMap = Map.fromList $ map (\e -> ( ( edgeTailNodeID e-                                                  , edgeHeadNodeID e)-                                                , edgeAttributes e)-                                         ) es+            edgeMap = Map.fromList $ map ( (edgeFromNodeID &&& edgeToNodeID)+                                           &&& edgeAttributes) es --- | Pass the plain graph through 'graphToGraph'.  This is an @IO@ action,---   however since the state doesn't change it's safe to use 'unsafePerformIO'---   to convert this to a normal function.-dotizeGraph   :: (DynGraph gr, Ord b) => gr a b-              -> gr (AttributeNode a) (AttributeEdge b)-dotizeGraph g = unsafePerformIO-                $ graphToGraph g gAttrs noAttrs noAttrs+-- | Run the appropriate GraphViz command on the graph to get+--   positional information and then combine that information back+--   into the original graph.+--+--   Graph direction is automatically inferred.+graphToGraph'    :: (Ord b, Graph gr) => gr a b -> [GlobalAttributes]+                    -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+                    -> IO (gr (AttributeNode a) (AttributeEdge b))+graphToGraph' gr = graphToGraph (isDirected gr) gr++-- | Run the appropriate GraphViz command on the clustered graph to+--   get positional information and then combine that information back+--   into the original graph.  Note that for the edge information to+--   be parsed properly when using multiple edges, each edge between+--   two nodes needs to have a unique label.+--+--   The 'Bool' argument is 'True' for directed graphs, 'False'+--   otherwise.  Directed graphs are passed through /dot/, and+--   undirected graphs through /neato/.+clusterGraphToGraph :: (Ord c, Graph gr) => Bool -> gr a b+                       -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)+                       -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+                       -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+                       -> IO (gr (AttributeNode a) (AttributeEdge b))+clusterGraphToGraph isDir gr gAtts clBy cID fmtClust fmtNode fmtEdge+    = dotAttributes isDir gr dot     where+      dot = clusterGraphToDot isDir gr gAtts clBy cID fmtClust fmtNode fmtEdge++-- | Run the appropriate GraphViz command on the clustered graph to+--   get positional information and then combine that information back+--   into the original graph.+--+--   Graph direction is automatically inferred.+clusterGraphToGraph'    :: (Ord b, Ord c, Graph gr) => gr a b+                           -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)+                           -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+                           -> (LNode a -> Attributes) -> (LEdge b -> Attributes)+                           -> IO (gr (AttributeNode a) (AttributeEdge b))+clusterGraphToGraph' gr = clusterGraphToGraph (isDirected gr) gr+++-- | Pass the graph through 'graphToGraph' with no 'Attribute's.  This+--   is an @'IO'@ action, however since the state doesn't change it's+--   safe to use 'unsafePerformIO' to convert this to a normal+--   function.+--+--   The 'Bool' argument is 'True' for directed graphs, 'False'+--   otherwise.  Directed graphs are passed through /dot/, and+--   undirected graphs through /neato/.+dotizeGraph         :: (Graph gr) => Bool -> gr a b+                       -> gr (AttributeNode a) (AttributeEdge b)+dotizeGraph isDir g = unsafePerformIO+                      $ graphToGraph isDir g gAttrs noAttrs noAttrs+    where       gAttrs = []       noAttrs = const []++-- | Pass the graph through 'graphToGraph' with no 'Attribute's.  This+--   is an @'IO'@ action, however since the state doesn't change it's+--   safe to use 'unsafePerformIO' to convert this to a normal+--   function.+--+--   The graph direction is automatically inferred.+dotizeGraph'   :: (Graph gr, Ord b) => gr a b+                  -> gr (AttributeNode a) (AttributeEdge b)+dotizeGraph' g = dotizeGraph (isDirected g) g++-- | Pass the clustered graph through 'clusterGraphToGraph' with no+--   'Attribute's.  This is an @'IO'@ action, however since the state+--   doesn't change it's safe to use 'unsafePerformIO' to convert this+--   to a normal function.+--+--   The 'Bool' argument is 'True' for directed graphs, 'False'+--   otherwise.  Directed graphs are passed through /dot/, and+--   undirected graphs through /neato/.+dotizeClusterGraph                 :: (Ord c, Graph gr) => Bool -> gr a b+                                      -> (LNode a -> NodeCluster c a)+                                      -> gr (AttributeNode a) (AttributeEdge b)+dotizeClusterGraph isDir g clustBy = unsafePerformIO+                                     $ clusterGraphToGraph isDir   g+                                                           gAttrs  clustBy+                                                           cID     cAttrs+                                                           noAttrs noAttrs+    where+      gAttrs = []+      cID = const Nothing+      cAttrs = const gAttrs+      noAttrs = const []++-- | Pass the clustered graph through 'graphToGraph' with no+--   'Attribute's.  This is an @'IO'@ action, however since the state+--   doesn't change it's safe to use 'unsafePerformIO' to convert this+--   to a normal function.+--+--   The graph direction is automatically inferred.+dotizeClusterGraph'   :: (Ord b, Ord c, Graph gr) => gr a b+                         -> (LNode a -> NodeCluster c a)+                         -> gr (AttributeNode a) (AttributeEdge b)+dotizeClusterGraph' g = dotizeClusterGraph (isDirected g) g

@@ -8,1852 +8,2198 @@    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:--   * Parsing of quoted strings might not always work if they are a-     sub-part of another Attribute (e.g. a quoted name in 'LayerList').-     In fact, parsing with quotes is iffy for everything; specifically-     when they are and aren't allowed.--   * 'ColorScheme' is ignored when parsing 'Color' values--   * ColorList and PointfList are defined as actual lists (but-     'LayerList' is not).--   * 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, and feature support for pure-     'Int'-based co-ordinates as well as 'Double' ones (i.e. no floating-     point-only points for Point).  The optional '!' and third value-     for Point are not available.--   * 'Rect' uses two 'Point' values to denote the lower-left and-     top-right corners.--   * The two 'LabelLoc' attributes have been combined.--   * The defined 'LayerSep' is not used to parse 'LayerRange' or-     'LayerList'; the default (@[' ', ':', '\t']@) is instead used.--   * @SplineType@ has been replaced with @['Spline']@.--   * Only polygon-based 'Shape's are available.--   * Device-dependent 'StyleName' values are not available.--   * 'PortPos' only has the 'CompassPoint' option, not-     @PortName[:CompassPoint]@ (since record shapes aren't allowed,-     and parsing HTML-like labels could be problematic).--   * Not every 'Attribute' is fully documented/described.  In-     particular, a lot of them are listed as having a 'String' value,-     when actually only certain Strings are allowed.--   * Deprecated 'Overlap' algorithms are not defined.-- -}--module Data.GraphViz.Attributes where--import Data.GraphViz.ParserCombinators--import Data.Char(isDigit, isHexDigit)-import Data.Word-import Numeric-import Control.Monad-import Data.Maybe---- -------------------------------------------------------------------------------{- |--   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.--   Note also that the default values are taken from the specification-   page listed above, and might not correspond fully with the names of-   the permitted values.--}-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 URL                          -- ^ /Valid for/: ENGC; /Default/: \<none\>; /Notes/: svg, postscript, map only-    | 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-    | Aspect AspectType                -- ^ /Valid for/: G; /Notes/: dot only-    | Bb Rect                          -- ^ /Valid for/: G; /Notes/: write only-    | BgColor Color                    -- ^ /Valid for/: GC; /Default/: \<none\>-    | Center Bool                      -- ^ /Valid for/: G; /Default/: false-    | Charset String                   -- ^ /Valid for/: G; /Default/: \"UTF-8\"-    | ClusterRank ClusterMode          -- ^ /Valid for/: G; /Default/: local; /Notes/: dot only-    | Color [Color]                    -- ^ /Valid for/: ENC; /Default/: black-    | ColorScheme String               -- ^ /Valid for/: ENCG; /Default/: \"\"-    | Comment String                   -- ^ /Valid for/: ENG; /Default/: \"\"-    | Compound Bool                    -- ^ /Valid for/: G; /Default/: false; /Notes/: dot only-    | Concentrate Bool                 -- ^ /Valid for/: G; /Default/: false-    | Constraint Bool                  -- ^ /Valid for/: E; /Default/: true; /Notes/: dot only-    | Decorate Bool                    -- ^ /Valid for/: E; /Default/: false-    | DefaultDist Double               -- ^ /Valid for/: G; /Default/: 1+(avg. len)*sqrt(|V|); /Minimum/: epsilon; /Notes/: neato only-    | 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)/none(undirected)-    | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: false; /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-    | EdgeURL URL                      -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only-    | EdgeTarget String                -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only-    | EdgeTooltip String               -- ^ /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/: +3; /Notes/: not dot-    | FillColor Color                  -- ^ /Valid for/: NC; /Default/: lightgrey(nodes) | black(clusters)-    | FixedSize Bool                   -- ^ /Valid for/: N; /Default/: false-    | FontColor Color                  -- ^ /Valid for/: ENGC; /Default/: black-    | FontName String                  -- ^ /Valid for/: ENGC; /Default/: \"Times-Roman\"-    | FontNames String                 -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: svg only-    | FontPath String                  -- ^ /Valid for/: G; /Default/: system-dependent-    | FontSize Double                  -- ^ /Valid for/: ENGC; /Default/: 14.0; /Minimum/: 1.0-    | Group String                     -- ^ /Valid for/: N; /Default/: \"\"; /Notes/: dot only-    | HeadURL URL                      -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only-    | HeadClip Bool                    -- ^ /Valid for/: E; /Default/: true-    | HeadLabel Label                  -- ^ /Valid for/: E; /Default/: \"\"-    | HeadPort PortPos                 -- ^ /Valid for/: E; /Default/: center-    | HeadTarget QuotedString          -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only-    | HeadTooltip QuotedString         -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only-    | Height Double                    -- ^ /Valid for/: N; /Default/: 0.5; /Minimum/: 0.02-    | ID Label                         -- ^ /Valid for/: GNE; /Default/: \"\"; /Notes/: svg, postscript, map only-    | Image String                     -- ^ /Valid for/: N; /Default/: \"\"-    | ImageScale ScaleType             -- ^ /Valid for/: N; /Default/: false-    | Label Label                      -- ^ /Valid for/: ENGC; /Default/: \"\N\" (nodes) Nothing | \"\" (otherwise) Nothing-    | LabelURL URL                     -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only-    | 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-    | LabelFontColor Color             -- ^ /Valid for/: E; /Default/: black-    | LabelFontName String             -- ^ /Valid for/: E; /Default/: \"Times-Roman\"-    | LabelFontSize Double             -- ^ /Valid for/: E; /Default/: 14.0; /Minimum/: 1.0-    | LabelJust Justification          -- ^ /Valid for/: GC; /Default/: \"c\"-    | LabelLoc VerticalPlacement       -- ^ /Valid for/: GCN; /Default/: \"t\"(clusters) | \"b\"(root graphs) | \"c\"(clusters)-    | LabelTarget String               -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only-    | LabelTooltip String              -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only-    | Landscape Bool                   -- ^ /Valid for/: G; /Default/: false-    | Layer LayerRange                 -- ^ /Valid for/: EN; /Default/: \"\"-    | Layers LayerList                 -- ^ /Valid for/: G; /Default/: \"\"-    | LayerSep String                  -- ^ /Valid for/: G; /Default/: \" :\t\"-    | Layout String                    -- ^ /Valid for/: G; /Default/: \"\"-    | Len Double                       -- ^ /Valid for/: E; /Default/: 1.0(neato)/0.3(fdp); /Notes/: fdp, neato only-    | Levels Int                       -- ^ /Valid for/: G; /Default/: MAXINT; /Minimum/: 0.0; /Notes/: sfdp only-    | LevelsGap Double                 -- ^ /Valid for/: G; /Default/: 0.0; /Notes/: neato only-    | LHead String                     -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only-    | LP Point                         -- ^ /Valid for/: EGC; /Notes/: write only-    | LTail String                     -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only-    | 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 String                      -- ^ /Valid for/: G; /Default/: \"major\"; /Notes/: neato only-    | Model String                     -- ^ /Valid for/: G; /Default/: \"shortpath\"; /Notes/: neato only-    | Mosek Bool                       -- ^ /Valid for/: G; /Default/: false; /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-    | Normalize Bool                   -- ^ /Valid for/: G; /Default/: false; /Notes/: not dot-    | Nslimit Double                   -- ^ /Valid for/: G; /Notes/: dot only-    | Nslimit1 Double                  -- ^ /Valid for/: G; /Notes/: dot only-    | Ordering String                  -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: dot only-    | Orientation Double               -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: 360.0-    | OrientationGraph String          -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: Landscape if \"[lL]*\" and rotate not defined-    | OutputOrder OutputMode           -- ^ /Valid for/: G; /Default/: breadthfirst-    | Overlap Overlap                  -- ^ /Valid for/: G; /Default/: true; /Notes/: not dot-    | OverlapScaling Double            -- ^ /Valid for/: G; /Default/: -4; /Minimum/: -1.0e10; /Notes/: prism only-    | Pack Pack                        -- ^ /Valid for/: G; /Default/: false; /Notes/: not dot-    | PackMode PackMode                -- ^ /Valid for/: G; /Default/: node; /Notes/: not dot-    | Pad DPoint                       -- ^ /Valid for/: G; /Default/: 0.0555 (4 points)-    | Page Point                       -- ^ /Valid for/: G-    | PageDir PageDir                  -- ^ /Valid for/: G; /Default/: BL-    | PenColor Color                   -- ^ /Valid for/: C; /Default/: 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; /Notes/: fdp, neato only-    | Pos Pos                          -- ^ /Valid for/: EN-    | QuadTree QuadType                -- ^ /Valid for/: G; /Default/: \"normal\"; /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/: TB; /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-    | ReMinCross Bool                  -- ^ /Valid for/: G; /Default/: false; /Notes/: dot only-    | RepulsiveForce Double            -- ^ /Valid for/: G; /Default/: 1.0; /Minimum/: 0.0; /Notes/: sfdp only-    | Resolution Double                -- ^ /Valid for/: G; /Default/: 96.0 | 0.0; /Notes/: svg, bitmap output only-    | Root Root                        -- ^ /Valid for/: GN; /Default/: \"\"(graphs) | false(nodes); /Notes/: circo, twopi only-    | Rotate Int                       -- ^ /Valid for/: G; /Default/: 0-    | SameHead String                  -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only-    | SameTail String                  -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only-    | SamplePoints Int                 -- ^ /Valid for/: N; /Default/: 8(output) | 20(overlap and image maps)-    | SearchSize Int                   -- ^ /Valid for/: G; /Default/: 30; /Notes/: dot only-    | Sep DPoint                       -- ^ /Valid for/: G; /Default/: +4; /Notes/: not dot-    | Shape Shape                      -- ^ /Valid for/: N; /Default/: ellipse-    | ShapeFile String                 -- ^ /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/: \"none\"; /Notes/: sfdp only-    | SortV Int                        -- ^ /Valid for/: GCN; /Default/: 0; /Minimum/: 0-    | Splines EdgeType                 -- ^ /Valid for/: G-    | Start StartType                  -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: fdp, neato only-    | Style Style                      -- ^ /Valid for/: ENC-    | StyleSheet String                -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: svg only-    | TailURL URL                      -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only-    | TailClip Bool                    -- ^ /Valid for/: E; /Default/: true-    | TailLabel Label                  -- ^ /Valid for/: E; /Default/: \"\"-    | TailPort PortPos                 -- ^ /Valid for/: E; /Default/: center-    | TailTarget String                -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only-    | TailTooltip String               -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only-    | Target String                    -- ^ /Valid for/: ENGC; /Default/: \<none\>; /Notes/: svg, map only-    | Tooltip String                   -- ^ /Valid for/: NEC; /Default/: \"\"; /Notes/: svg, cmap only-    | TrueColor Bool                   -- ^ /Valid for/: G; /Notes/: bitmap output only-    | Vertices [Point]                 -- ^ /Valid for/: N; /Notes/: write only-    | ViewPort ViewPort                -- ^ /Valid for/: G; /Default/: \"\"-    | 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-    | Z Double                         -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: -MAXFLOAT | -1000-      deriving (Eq, Read)--instance Show Attribute where-    show (Damping v)            = "Damping=" ++ show v-    show (K v)                  = "K=" ++ show v-    show (URL v)                = "URL=" ++ show v-    show (ArrowHead v)          = "arrowhead=" ++ show v-    show (ArrowSize v)          = "arrowsize=" ++ show v-    show (ArrowTail v)          = "arrowtail=" ++ show v-    show (Aspect v)             = "aspect=" ++ show v-    show (Bb v)                 = "bb=" ++ show v-    show (BgColor v)            = "bgcolor=" ++ show v-    show (Center v)             = "center=" ++ show v-    show (Charset v)            = "charset=" ++ v-    show (ClusterRank v)        = "clusterrank=" ++ show v-    show (Color v)              = "color=" ++ show v-    show (ColorScheme v)        = "colorscheme=" ++ v-    show (Comment v)            = "comment=" ++ v-    show (Compound v)           = "compound=" ++ show v-    show (Concentrate v)        = "concentrate=" ++ show v-    show (Constraint v)         = "constraint=" ++ show v-    show (Decorate v)           = "decorate=" ++ show v-    show (DefaultDist v)        = "defaultdist=" ++ show v-    show (Dim v)                = "dim=" ++ show v-    show (Dimen v)              = "dimen=" ++ show v-    show (Dir v)                = "dir=" ++ show v-    show (DirEdgeConstraints v) = "diredgeconstraints=" ++ show v-    show (Distortion v)         = "distortion=" ++ show v-    show (DPI v)                = "dpi=" ++ show v-    show (EdgeURL v)            = "edgeURL=" ++ show v-    show (EdgeTarget v)         = "edgetarget=" ++ v-    show (EdgeTooltip v)        = "edgetooltip=" ++ v-    show (Epsilon v)            = "epsilon=" ++ show v-    show (ESep v)               = "esep=" ++ show v-    show (FillColor v)          = "fillcolor=" ++ show v-    show (FixedSize v)          = "fixedsize=" ++ show v-    show (FontColor v)          = "fontcolor=" ++ show v-    show (FontName v)           = "fontname=" ++ v-    show (FontNames v)          = "fontnames=" ++ v-    show (FontPath v)           = "fontpath=" ++ v-    show (FontSize v)           = "fontsize=" ++ show v-    show (Group v)              = "group=" ++ v-    show (HeadURL v)            = "headURL=" ++ show v-    show (HeadClip v)           = "headclip=" ++ show v-    show (HeadLabel v)          = "headlabel=" ++ show v-    show (HeadPort v)           = "headport=" ++ show v-    show (HeadTarget v)         = "headtarget=" ++ show v-    show (HeadTooltip v)        = "headtooltip=" ++ show v-    show (Height v)             = "height=" ++ show v-    show (ID v)                 = "id=" ++ show v-    show (Image v)              = "image=" ++ v-    show (ImageScale v)         = "imagescale=" ++ show v-    show (Label v)              = "label=" ++ show v-    show (LabelURL v)           = "labelURL=" ++ show v-    show (LabelAngle v)         = "labelangle=" ++ show v-    show (LabelDistance v)      = "labeldistance=" ++ show v-    show (LabelFloat v)         = "labelfloat=" ++ show v-    show (LabelFontColor v)     = "labelfontcolor=" ++ show v-    show (LabelFontName v)      = "labelfontname=" ++ v-    show (LabelFontSize v)      = "labelfontsize=" ++ show v-    show (LabelJust v)          = "labeljust=" ++ show v-    show (LabelLoc v)           = "labelloc=" ++ show v-    show (LabelTarget v)        = "labeltarget=" ++ v-    show (LabelTooltip v)       = "labeltooltip=" ++ v-    show (Landscape v)          = "landscape=" ++ show v-    show (Layer v)              = "layer=" ++ show v-    show (Layers v)             = "layers=" ++ show v-    show (LayerSep v)           = "layersep=" ++ v-    show (Layout v)             = "layout=" ++ v-    show (Len v)                = "len=" ++ show v-    show (Levels v)             = "levels=" ++ show v-    show (LevelsGap v)          = "levelsgap=" ++ show v-    show (LHead v)              = "lhead=" ++ v-    show (LP v)                 = "lp=" ++ show v-    show (LTail v)              = "ltail=" ++ v-    show (Margin v)             = "margin=" ++ show v-    show (MaxIter v)            = "maxiter=" ++ show v-    show (MCLimit v)            = "mclimit=" ++ show v-    show (MinDist v)            = "mindist=" ++ show v-    show (MinLen v)             = "minlen=" ++ show v-    show (Mode v)               = "mode=" ++ v-    show (Model v)              = "model=" ++ v-    show (Mosek v)              = "mosek=" ++ show v-    show (NodeSep v)            = "nodesep=" ++ show v-    show (NoJustify v)          = "nojustify=" ++ show v-    show (Normalize v)          = "normalize=" ++ show v-    show (Nslimit v)            = "nslimit=" ++ show v-    show (Nslimit1 v)           = "nslimit1=" ++ show v-    show (Ordering v)           = "ordering=" ++ v-    show (Orientation v)        = "orientation=" ++ show v-    show (OrientationGraph v)   = "orientation=" ++ v-    show (OutputOrder v)        = "outputorder=" ++ show v-    show (Overlap v)            = "overlap=" ++ show v-    show (OverlapScaling v)     = "overlap_scaling=" ++ show v-    show (Pack v)               = "pack=" ++ show v-    show (PackMode v)           = "packmode=" ++ show v-    show (Pad v)                = "pad=" ++ show v-    show (Page v)               = "page=" ++ show v-    show (PageDir v)            = "pagedir=" ++ show v-    show (PenColor v)           = "pencolor=" ++ show v-    show (PenWidth v)           = "penwidth=" ++ show v-    show (Peripheries v)        = "peripheries=" ++ show v-    show (Pin v)                = "pin=" ++ show v-    show (Pos v)                = "pos=" ++ show v-    show (QuadTree v)           = "quadtree=" ++ show v-    show (Quantum v)            = "quantum=" ++ show v-    show (Rank v)               = "rank=" ++ show v-    show (RankDir v)            = "rankdir=" ++ show v-    show (Ranksep v)            = "ranksep=" ++ show v-    show (Ratio v)              = "ratio=" ++ show v-    show (Rects v)              = "rects=" ++ show v-    show (Regular v)            = "regular=" ++ show v-    show (ReMinCross v)         = "remincross=" ++ show v-    show (RepulsiveForce v)     = "repulsiveforce=" ++ show v-    show (Resolution v)         = "resolution=" ++ show v-    show (Root v)               = "root=" ++ show v-    show (Rotate v)             = "rotate=" ++ show v-    show (SameHead v)           = "samehead=" ++ v-    show (SameTail v)           = "sametail=" ++ v-    show (SamplePoints v)       = "samplepoints=" ++ show v-    show (SearchSize v)         = "searchsize=" ++ show v-    show (Sep v)                = "sep=" ++ show v-    show (Shape v)              = "shape=" ++ show v-    show (ShapeFile v)          = "shapefile=" ++ v-    show (ShowBoxes v)          = "showboxes=" ++ show v-    show (Sides v)              = "sides=" ++ show v-    show (Size v)               = "size=" ++ show v-    show (Skew v)               = "skew=" ++ show v-    show (Smoothing v)          = "smoothing=" ++ show v-    show (SortV v)              = "sortv=" ++ show v-    show (Splines v)            = "splines=" ++ show v-    show (Start v)              = "start=" ++ show v-    show (Style v)              = "style=" ++ show v-    show (StyleSheet v)         = "stylesheet=" ++ v-    show (TailURL v)            = "tailURL=" ++ show v-    show (TailClip v)           = "tailclip=" ++ show v-    show (TailLabel v)          = "taillabel=" ++ show v-    show (TailPort v)           = "tailport=" ++ show v-    show (TailTarget v)         = "tailtarget=" ++ v-    show (TailTooltip v)        = "tailtooltip=" ++ v-    show (Target v)             = "target=" ++ v-    show (Tooltip v)            = "tooltip=" ++ v-    show (TrueColor v)          = "truecolor=" ++ show v-    show (Vertices v)           = "vertices=" ++ show v-    show (ViewPort v)           = "viewport=" ++ show v-    show (VoroMargin v)         = "voro_margin=" ++ show v-    show (Weight v)             = "weight=" ++ show v-    show (Width v)              = "width=" ++ show v-    show (Z v)                  = "z=" ++ show v--instance Parseable Attribute where-    parse = oneOf [ liftM Damping            $ parseField "Damping"-                  , liftM K                  $ parseField "K"-                  , liftM URL                $ oneOf (map parseField ["URL", "href"])-                  , liftM ArrowHead          $ parseField "arrowhead"-                  , liftM ArrowSize          $ parseField "arrowsize"-                  , liftM ArrowTail          $ parseField "arrowtail"-                  , liftM Aspect             $ parseField "aspect"-                  , liftM Bb                 $ parseField "bb"-                  , liftM BgColor            $ parseField "bgcolor"-                  , liftM Center             $ parseBoolField "center"-                  , liftM Charset            $ parseField "charset"-                  , liftM ClusterRank        $ parseField "clusterrank"-                  , liftM Color              $ parseField "color"-                  , liftM ColorScheme        $ parseField "colorscheme"-                  , liftM Comment            $ parseField "comment"-                  , liftM Compound           $ parseBoolField "compound"-                  , liftM Concentrate        $ parseBoolField "concentrate"-                  , liftM Constraint         $ parseBoolField "constraint"-                  , liftM Decorate           $ parseBoolField "decorate"-                  , liftM DefaultDist        $ parseField "defaultdist"-                  , liftM Dim                $ parseField "dim"-                  , liftM Dimen              $ parseField "dimen"-                  , liftM Dir                $ parseField "dir"-                  , liftM DirEdgeConstraints $ parseFieldDef (DEBool True) "diredgeconstraints"-                  , liftM Distortion         $ parseField "distortion"-                  , liftM DPI                $ parseField "dpi"-                  , liftM EdgeURL            $ oneOf (map parseField ["edgeURL", "edgehref"])-                  , liftM EdgeTarget         $ parseField "edgetarget"-                  , liftM EdgeTooltip        $ parseField "edgetooltip"-                  , liftM Epsilon            $ parseField "epsilon"-                  , liftM ESep               $ parseField "esep"-                  , liftM FillColor          $ parseField "fillcolor"-                  , liftM FixedSize          $ parseBoolField "fixedsize"-                  , liftM FontColor          $ parseField "fontcolor"-                  , liftM FontName           $ parseField "fontname"-                  , liftM FontNames          $ parseField "fontnames"-                  , liftM FontPath           $ parseField "fontpath"-                  , liftM FontSize           $ parseField "fontsize"-                  , liftM Group              $ parseField "group"-                  , liftM HeadURL            $ oneOf (map parseField ["headURL", "headhref"])-                  , liftM HeadClip           $ parseBoolField "headclip"-                  , liftM HeadLabel          $ parseField "headlabel"-                  , liftM HeadPort           $ parseField "headport"-                  , liftM HeadTarget         $ parseField "headtarget"-                  , liftM HeadTooltip        $ parseField "headtooltip"-                  , liftM Height             $ parseField "height"-                  , liftM ID                 $ parseField "id"-                  , liftM Image              $ parseField "image"-                  , liftM ImageScale         $ parseFieldDef UniformScale "imagescale"-                  , liftM Label              $ parseField "label"-                  , liftM LabelURL           $ oneOf (map parseField ["labelURL", "labelhref"])-                  , liftM LabelAngle         $ parseField "labelangle"-                  , liftM LabelDistance      $ parseField "labeldistance"-                  , liftM LabelFloat         $ parseBoolField "labelfloat"-                  , liftM LabelFontColor     $ parseField "labelfontcolor"-                  , liftM LabelFontName      $ parseField "labelfontname"-                  , liftM LabelFontSize      $ parseField "labelfontsize"-                  , liftM LabelJust          $ parseField "labeljust"-                  , liftM LabelLoc           $ parseField "labelloc"-                  , liftM LabelTarget        $ parseField "labeltarget"-                  , liftM LabelTooltip       $ parseField "labeltooltip"-                  , liftM Landscape          $ parseBoolField "landscape"-                  , liftM Layer              $ parseField "layer"-                  , liftM Layers             $ parseField "layers"-                  , liftM LayerSep           $ parseField "layersep"-                  , liftM Layout             $ parseField "layout"-                  , liftM Len                $ parseField "len"-                  , liftM Levels             $ parseField "levels"-                  , liftM LevelsGap          $ parseField "levelsgap"-                  , liftM LHead              $ parseField "lhead"-                  , liftM LP                 $ parseField "lp"-                  , liftM LTail              $ parseField "ltail"-                  , liftM Margin             $ parseField "margin"-                  , liftM MaxIter            $ parseField "maxiter"-                  , liftM MCLimit            $ parseField "mclimit"-                  , liftM MinDist            $ parseField "mindist"-                  , liftM MinLen             $ parseField "minlen"-                  , liftM Mode               $ parseField "mode"-                  , liftM Model              $ parseField "model"-                  , liftM Mosek              $ parseBoolField "mosek"-                  , liftM NodeSep            $ parseField "nodesep"-                  , liftM NoJustify          $ parseBoolField "nojustify"-                  , liftM Normalize          $ parseBoolField "normalize"-                  , liftM Nslimit            $ parseField "nslimit"-                  , liftM Nslimit1           $ parseField "nslimit1"-                  , liftM Ordering           $ parseField "ordering"-                  , liftM Orientation        $ parseField "orientation"-                  , liftM OrientationGraph   $ parseField "orientation"-                  , liftM OutputOrder        $ parseField "outputorder"-                  , liftM Overlap            $ parseFieldDef KeepOverlaps "overlap"-                  , liftM OverlapScaling     $ parseField "overlap_scaling"-                  , liftM Pack               $ parseFieldDef DoPack "pack"-                  , liftM PackMode           $ parseField "packmode"-                  , liftM Pad                $ parseField "pad"-                  , liftM Page               $ parseField "page"-                  , liftM PageDir            $ parseField "pagedir"-                  , liftM PenColor           $ parseField "pencolor"-                  , liftM PenWidth           $ parseField "penwidth"-                  , liftM Peripheries        $ parseField "peripheries"-                  , liftM Pin                $ parseBoolField "pin"-                  , liftM Pos                $ parseField "pos"-                  , liftM QuadTree           $ parseFieldDef NormalQT "quadtree"-                  , liftM Quantum            $ parseField "quantum"-                  , liftM Rank               $ parseField "rank"-                  , liftM RankDir            $ parseField "rankdir"-                  , liftM Ranksep            $ parseField "ranksep"-                  , liftM Ratio              $ parseField "ratio"-                  , liftM Rects              $ parseField "rects"-                  , liftM Regular            $ parseBoolField "regular"-                  , liftM ReMinCross         $ parseBoolField "remincross"-                  , liftM RepulsiveForce     $ parseField "repulsiveforce"-                  , liftM Resolution         $ parseField "resolution"-                  , liftM Root               $ parseFieldDef IsCentral "root"-                  , liftM Rotate             $ parseField "rotate"-                  , liftM SameHead           $ parseField "samehead"-                  , liftM SameTail           $ parseField "sametail"-                  , liftM SamplePoints       $ parseField "samplepoints"-                  , liftM SearchSize         $ parseField "searchsize"-                  , liftM Sep                $ parseField "sep"-                  , liftM Shape              $ parseField "shape"-                  , liftM ShapeFile          $ parseField "shapefile"-                  , liftM ShowBoxes          $ parseField "showboxes"-                  , liftM Sides              $ parseField "sides"-                  , liftM Size               $ parseField "size"-                  , liftM Skew               $ parseField "skew"-                  , liftM Smoothing          $ parseField "smoothing"-                  , liftM SortV              $ parseField "sortv"-                  , liftM Splines            $ parseFieldDef SplineEdges "splines"-                  , liftM Start              $ parseField "start"-                  , liftM Style              $ parseField "style"-                  , liftM StyleSheet         $ parseField "stylesheet"-                  , liftM TailURL            $ oneOf (map parseField ["tailURL", "tailhref"])-                  , liftM TailClip           $ parseBoolField "tailclip"-                  , liftM TailLabel          $ parseField "taillabel"-                  , liftM TailPort           $ parseField "tailport"-                  , liftM TailTarget         $ parseField "tailtarget"-                  , liftM TailTooltip        $ parseField "tailtooltip"-                  , liftM Target             $ parseField "target"-                  , liftM Tooltip            $ parseField "tooltip"-                  , liftM TrueColor          $ parseBoolField "truecolor"-                  , liftM Vertices           $ parseField "vertices"-                  , liftM ViewPort           $ parseField "viewport"-                  , liftM VoroMargin         $ parseField "voro_margin"-                  , liftM Weight             $ parseField "weight"-                  , liftM Width              $ parseField "width"-                  , liftM Z                  $ parseField "z"-                  ]---- | 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 Bb{}                 = True-usedByGraphs BgColor{}            = True-usedByGraphs Center{}             = True-usedByGraphs Charset{}            = 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 ID{}                 = True-usedByGraphs Label{}              = True-usedByGraphs LabelJust{}          = True-usedByGraphs LabelLoc{}           = True-usedByGraphs Landscape{}          = True-usedByGraphs Layers{}             = True-usedByGraphs LayerSep{}           = True-usedByGraphs Layout{}             = True-usedByGraphs Levels{}             = True-usedByGraphs LevelsGap{}          = True-usedByGraphs LP{}                 = 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 OrientationGraph{}   = 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 Resolution{}         = True-usedByGraphs Root{}               = True-usedByGraphs Rotate{}             = 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 _                    = False---- | Determine if this Attribute is valid for use with Clusters.-usedByClusters               :: Attribute -> Bool-usedByClusters K{}           = True-usedByClusters URL{}         = True-usedByClusters BgColor{}     = True-usedByClusters Color{}       = True-usedByClusters ColorScheme{} = True-usedByClusters FillColor{}   = True-usedByClusters FontColor{}   = True-usedByClusters FontName{}    = True-usedByClusters FontSize{}    = True-usedByClusters Label{}       = True-usedByClusters LabelJust{}   = True-usedByClusters LabelLoc{}    = True-usedByClusters LP{}          = 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 _             = False---- | Determine if this Attribute is valid for use with SubGraphs.-usedBySubGraphs        :: Attribute -> Bool-usedBySubGraphs Rank{} = True-usedBySubGraphs _      = False---- | Determine if this Attribute is valid for use with Nodes.-usedByNodes                :: Attribute -> Bool-usedByNodes URL{}          = 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 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 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 Z{}            = 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 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 LP{}             = 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 _                = False---- -------------------------------------------------------------------------------newtype URL = UStr { urlString :: String }-    deriving (Eq, Read)--instance Show URL where-    show u = '<' : urlString u ++ ">"--instance Parseable URL where-    parse = do char open-               cnt <- many1 $ satisfy ((/=) close)-               char close-               return $ UStr cnt-        where-          open = '<'-          close = '>'---- -------------------------------------------------------------------------------data ArrowType = Normal   | Inv-               | DotArrow | InvDot-               | ODot     | InvODot-               | NoArrow  | Tee-               | Empty    | InvEmpty-               | Diamond  | ODiamond-               | EDiamond | Crow-               | Box      | OBox-               | Open     | HalfOpen-               | Vee-                 deriving (Eq, Read)--instance Show ArrowType where-    show Normal   = "normal"-    show Inv      = "inv"-    show DotArrow = "dot"-    show InvDot   = "invdot"-    show ODot     = "odot"-    show InvODot  = "invodot"-    show NoArrow  = "none"-    show Tee      = "tee"-    show Empty    = "empty"-    show InvEmpty = "invempty"-    show Diamond  = "diamond"-    show ODiamond = "odiamond"-    show EDiamond = "ediamond"-    show Crow     = "crow"-    show Box      = "box"-    show OBox     = "obox"-    show Open     = "open"-    show HalfOpen = "halfopen"-    show Vee      = "vee"--instance Parseable ArrowType where-    parse = optionalQuoted-            $ oneOf [ string "normal"   >> return Normal-                    , string "inv"      >> return Inv-                    , string "dot"      >> return DotArrow-                    , string "invdot"   >> return InvDot-                    , string "odot"     >> return ODot-                    , string "invodot"  >> return InvODot-                    , string "none"     >> return NoArrow-                    , string "tee"      >> return Tee-                    , string "empty"    >> return Empty-                    , string "invempty" >> return InvEmpty-                    , string "diamond"  >> return Diamond-                    , string "odiamond" >> return ODiamond-                    , string "ediamond" >> return EDiamond-                    , string "crow"     >> return Crow-                    , string "box"      >> return Box-                    , string "obox"     >> return OBox-                    , string "open"     >> return Open-                    , string "halfopen" >> return HalfOpen-                    , string "vee"      >> return Vee-                    ]---- -------------------------------------------------------------------------------data AspectType = RatioOnly Double-                | RatioPassCount Double Int-                  deriving (Eq, Read)--instance Show AspectType where-    show (RatioOnly r)        = show r-    show (RatioPassCount r p) = show $ show r ++ ',' : show p--instance Parseable AspectType where-    parse = oneOf [ liftM RatioOnly parse-                  , quotedParse $ do r <- parse-                                     char ','-                                     whitespace'-                                     p <- parse-                                     return $ RatioPassCount r p-                  ]---- -------------------------------------------------------------------------------data Rect = Rect Point Point-            deriving (Eq, Read)--instance Show Rect where-    show (Rect p1 p2) = show $ show p1 ++ ',' : show p2--instance Parseable Rect where-    parse = liftM (uncurry Rect) . quotedParse-            $ commaSep' parsePoint parsePoint---- -------------------------------------------------------------------------------data Color = RGB { red   :: Word8-                 , green :: Word8-                 , blue  :: Word8-                 }-           | RGBA { red   :: Word8-                  , green :: Word8-                  , blue  :: Word8-                  , alpha :: Word8-                  }-           | HSV { hue        :: Int-                 , saturation :: Int-                 , value      :: Int-                 }-           | ColorName String-             deriving (Eq, Read)--instance Show Color where-    show = show . showColor--    showList cs s = show $ go cs-        where-          go []      = s-          go [c]     = showColor c ++ s-          go (c:cs') = showColor c ++ ':' : go cs'--showColor :: Color -> String-showColor (RGB r g b)      = '#' : foldr showWord8Pad "" [r,g,b]-showColor (RGBA r g b a)   = '#' : foldr showWord8Pad "" [r,g,b,a]-showColor (HSV h s v)      = show h ++ " " ++ show s ++ " " ++ show v-showColor (ColorName name) = name--showWord8Pad :: Word8 -> String -> String-showWord8Pad w s = padding ++ simple ++ s-    where-      simple = showHex w ""-      padding = replicate count '0'-      count = 2 - findCols 1 w-      findCols :: Int -> Word8 -> Int-      findCols c n-          | n < 16 = c-          | otherwise = findCols (c+1) (n `div` 16)--instance Parseable Color where-    parse = quotedParse parseColor--    parseList = quotedParse $ sepBy1 parseColor (char ':')--parseColor :: Parse Color-parseColor = oneOf [ parseHexBased-                   , parseHSV-                   , liftM ColorName parse -- Should we check it is a colour?-                   ]-    where-      parseHexBased-          = do char '#'-               cs <- many1 parse2Hex-               return $ case cs of-                          [r,g,b] -> RGB r g b-                          [r,g,b,a] -> RGBA r g b a-                          _ -> error $ "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 ","-                       , whitespace-                       ]-      parse2Hex = do c1 <- satisfy isHexDigit-                     c2 <- satisfy isHexDigit-                     let [(n, [])] = readHex [c1, c2]-                     return n---- -------------------------------------------------------------------------------data ClusterMode = Local-                 | Global-                 | NoCluster-                   deriving (Eq, Read)--instance Show ClusterMode where-    show Local     = "local"-    show Global    = "global"-    show NoCluster = "none"--instance Parseable ClusterMode where-    parse = optionalQuoted-            . oneOf-            $ [ string "local"  >> return Local-              , string "global" >> return Global-              , string "none"   >> return NoCluster-              ]---- -------------------------------------------------------------------------------data DirType = Forward | Back | Both | NoDir-               deriving (Eq, Read)--instance Show DirType where-    show Forward = "forward"-    show Back    = "back"-    show Both    = "both"-    show NoDir   = "none"--instance Parseable DirType where-    parse = optionalQuoted-            $ oneOf [ string "forward" >> return Forward-                    , string "back"    >> return Back-                    , string "both"    >> return Both-                    , string "none"    >> return NoDir-                    ]---- --------------------------------------------------------------------------------- | Only when @mode=ipsep@.-data DEConstraints = DEBool Bool-                   | Hier-                     deriving (Eq, Read)--instance Show DEConstraints where-    show (DEBool b) = show b-    show Hier       = "hier"--instance Parseable DEConstraints where-    parse = optionalQuoted-            $ oneOf [ liftM DEBool parse-                    , string "hier" >> return Hier-                    ]---- --------------------------------------------------------------------------------- | Either a 'Double' or a 'Point'.-data DPoint = DVal Double-            | PVal Point-             deriving (Eq, Read)--instance Show DPoint where-    show (DVal d) = show d-    show (PVal p) = show p--instance Parseable DPoint where-    parse = oneOf [ liftM DVal parse-                  , liftM PVal parsePoint-                  ]---- -------------------------------------------------------------------------------data Label = StrLabel String-           | URLLabel URL-             deriving (Eq, Read)--instance Show Label where-    show (StrLabel s) = s-    show (URLLabel u) = show u--instance Parseable Label where-    parse = oneOf [ liftM StrLabel parse-                  , liftM URLLabel parse-                  ]---- -------------------------------------------------------------------------------data Point = Point Int Int-           | PointD Double Double-             deriving (Eq, Read)--instance Show Point where-    show = show . showPoint--    showList ps s = unwords (map showPoint ps) ++ s--showPoint :: Point -> String-showPoint (Point  x y) = show x ++ ',' : show y-showPoint (PointD x y) = show x ++ ',' : show y--instance Parseable Point where-    parse = quotedParse parsePoint--    parseList = quotedParse $ sepBy1 parsePoint whitespace--parsePoint :: Parse Point-parsePoint = oneOf [ liftM (uncurry Point)  commaSep-                   , liftM (uncurry PointD) commaSep-                   ]---- -------------------------------------------------------------------------------data Overlap = KeepOverlaps-             | RemoveOverlaps-             | ScaleOverlaps-             | ScaleXYOverlaps-             | PrismOverlap (Maybe Int) -- ^ Only when sfdp is available, @Int@ is non-negative-             | CompressOverlap-             | VpscOverlap-             | IpsepOverlap -- ^ Only when @mode="ipsep"@-               deriving (Eq, Read)--instance Show Overlap where-    show KeepOverlaps     = "true"-    show RemoveOverlaps   = "false"-    show ScaleOverlaps    = "scale"-    show ScaleXYOverlaps  = "scalexy"-    show (PrismOverlap i) = maybe id (flip (++) . show) i $ "prism"-    show CompressOverlap  = "compress"-    show VpscOverlap      = "vpsc"-    show IpsepOverlap     = "ipsep"--instance Parseable Overlap where-    parse = optionalQuoted-            $ oneOf [ string "true" >> return KeepOverlaps-                    , string "false" >> return RemoveOverlaps-                    , string "scale" >> return ScaleOverlaps-                    , string "scalexy" >> return ScaleXYOverlaps-                    , string "prism" >> liftM PrismOverlap (optional parse)-                    , string "compress" >> return CompressOverlap-                    , string "vpsc" >> return VpscOverlap-                    , string "ipsep" >> return IpsepOverlap-                    ]---- -------------------------------------------------------------------------------data LayerRange = LRID LayerID-                | LRS LayerID String LayerID-                  deriving (Eq, Read)--instance Show LayerRange where-    show (LRID lid)        = show lid-    show (LRS id1 sep id2) = show $ show id1 ++ sep ++ show id2--instance Parseable LayerRange where-    parse = oneOf [ liftM LRID parse-                  , do id1 <- parse-                       sep <- parseLayerSep-                       id2 <- parse-                       return $ LRS id1 sep id2-                  ]--parseLayerSep :: Parse String-parseLayerSep = many1 . oneOf-                $ map char defLayerSep--defLayerSep :: [Char]-defLayerSep = [' ', ':', '\t']--parseLayerName :: Parse String-parseLayerName = many1 $ satisfy (flip notElem defLayerSep)--data LayerID = AllLayers-             | LRInt Int-             | LRName String-               deriving (Eq, Read)--instance Show LayerID where-    show AllLayers   = "all"-    show (LRInt n)   = show n-    show (LRName nm) = nm--instance Parseable LayerID where-    parse = oneOf [ optionalQuotedString "all" >> return AllLayers-                  , liftM LRInt $ optionalQuoted parse-                  , liftM LRName parseLayerName-                  ]---- | The list represent (Separator, Name)-data LayerList = LL String [(String, String)]-                 deriving (Eq, Read)--instance Show LayerList where-    show (LL l1 ols) = l1 ++ concatMap (uncurry (++)) ols--instance Parseable LayerList where-    parse = do l1 <- parseLayerName-               ols <- many $ do sep <- parseLayerSep-                                lnm <- parseLayerName-                                return (sep, lnm)-               return $ LL l1 ols---- -------------------------------------------------------------------------------data OutputMode = BreadthFirst | NodesFirst | EdgesFirst-                  deriving (Eq, Read)--instance Show OutputMode where-    show BreadthFirst = "breadthfirst"-    show NodesFirst = "nodesfirst"-    show EdgesFirst = "edgesfirst"--instance Parseable OutputMode where-    parse = optionalQuoted-            $ oneOf [ string "breadthfirst" >> return BreadthFirst-                    , string "nodesfirst"   >> return NodesFirst-                    , string "edgesfirst"   >> return EdgesFirst-                    ]---- -------------------------------------------------------------------------------data Pack = DoPack-          | DontPack-          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.-            deriving (Eq, Read)--instance Show Pack where-    show DoPack         = "true"-    show DontPack       = "false"-    show (PackMargin m) = show m--instance Parseable Pack where-    parse = optionalQuoted-            $ oneOf [ liftM (bool DoPack DontPack) parse-                    , liftM PackMargin parse-                    ]---- -------------------------------------------------------------------------------data PackMode = PackNode-              | PackClust-              | PackGraph-              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort-                                                -- by user, number of-                                                -- rows/cols-                deriving (Eq, Read)--instance Show PackMode where-    show PackNode           = "node"-    show PackClust          = "clust"-    show PackGraph          = "graph"-    show (PackArray c u mi) = addNum . isU . isC . isUnder-                              $ "array"-        where-          addNum = maybe id (flip (++) . show) mi-          isUnder = if c || u-                    then flip (++) "_"-                    else id-          isC = if c-                then flip (++) "c"-                else id-          isU = if u-                then flip (++) "u"-                else id--instance Parseable PackMode where-    parse = optionalQuoted-            $ oneOf [ string "node" >> return PackNode-                    , string "clust" >> return PackClust-                    , string "graph" >> return PackGraph-                    , do string "array"-                         mcu <- optional $ do char '_'-                                              many1 $ satisfy (not . isDigit)-                         let c = hasChar mcu 'c'-                             u = hasChar mcu 'u'-                         mi <- optional parse-                         return $ PackArray c u mi-                    ]-        where-          hasChar ms c = maybe False (elem c) ms---- -------------------------------------------------------------------------------data Pos = PointPos Point-         | SplinePos [Spline]-           deriving (Eq, Read)--instance Show Pos where-    show (PointPos p)   = show p-    show (SplinePos ss) = show ss--instance Parseable Pos where-    -- [Spline] must be quoted, so use the quoted parser for Point as-    -- well.-    parse = oneOf [ liftM PointPos parse-                  , liftM SplinePos parse-                  ]---- --------------------------------------------------------------------------------- | Controls how (and if) edges are represented.-data EdgeType = SplineEdges-              | LineEdges-              | NoEdges-              | PolyLine-              | CompoundEdge -- ^ fdp only-                deriving (Eq, Read)--instance Show EdgeType where-    show SplineEdges  = "true"-    show LineEdges    = "false"-    show NoEdges      = "\"\""-    show PolyLine     = "polyline"-    show CompoundEdge = "compound"--instance Parseable EdgeType where-    parse = optionalQuoted-            $ oneOf [ liftM (bool SplineEdges LineEdges) parse-                    , string "spline"   >> return SplineEdges-                    , string "line"     >> return LineEdges-                    , string "\"\""     >> return NoEdges-                    , string "polyline" >> return PolyLine-                    , string "compound" >> return CompoundEdge-                    ]---- --------------------------------------------------------------------------------- | 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, Read)--instance Show PageDir where-    show Bl = "BL"-    show Br = "BR"-    show Tl = "TL"-    show Tr = "TR"-    show Rb = "RB"-    show Rt = "RT"-    show Lb = "LB"-    show Lt = "LT"--instance Parseable PageDir where-    parse = optionalQuoted-            $ oneOf [ string "BL" >> return Bl-                    , string "BR" >> return Br-                    , string "TL" >> return Tl-                    , string "TR" >> return Tr-                    , string "RB" >> return Rb-                    , string "RT" >> return Rt-                    , string "LB" >> return Lb-                    , string "LT" >> return 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, Read)--instance Show Spline where-    show = show . showSpline--    showList ss o = show $ go ss-        where-          go []      = o-          go [s]     = showSpline s ++ o-          go (s:ss') = showSpline s ++ ';' : go ss'--showSpline                   :: Spline -> String-showSpline (Spline ms me ps) = addS . addE-                               . unwords-                               $ map showPoint ps-    where-      addP t = maybe id (\p -> (++) $ t : ',' : show p)-      addS = addP 's' ms-      addE = addP 'e' me--instance Parseable Spline where-    parse = quotedParse parseSpline--    parseList = quotedParse $ sepBy1 parseSpline (char ';')--parseSpline :: Parse Spline-parseSpline = do ms <- parseP 's'-                 whitespace-                 me <- parseP 'e'-                 whitespace-                 ps <- sepBy1 parsePoint whitespace-                 return $ Spline ms me ps-    where-      parseP t = optional $ do char t-                               char ';'-                               parse---- -------------------------------------------------------------------------------data QuadType = NormalQT-              | FastQT-              | NoQT-                deriving (Eq, Read)--instance Show QuadType where-    show NormalQT = "normal"-    show FastQT   = "fast"-    show NoQT     = "none"--instance Parseable QuadType where-    -- Have to take into account the slightly different interpretation-    -- of Bool used as an option for parsing QuadType-    parse = optionalQuoted-            $ oneOf [ string "normal" >> return NormalQT-                    , string "fast"   >> return FastQT-                    , string "none"   >> return NoQT-                    , char '2' >> return FastQT -- weird bool-                    , liftM (bool NormalQT NoQT) 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 String -- ^ For Graphs only-            deriving (Eq, Read)--instance Show Root where-    show IsCentral    = "true"-    show NotCentral   = "false"-    show (NodeName n) = n--instance Parseable Root where-    parse = optionalQuoted-            $ oneOf [ liftM (bool IsCentral NotCentral) parse-                    , liftM NodeName parse-                    ]---- -------------------------------------------------------------------------------data RankType = SameRank-              | MinRank-              | SourceRank-              | MaxRank-              | SinkRank-                deriving (Eq, Read)--instance Show RankType where-    show SameRank   = "same"-    show MinRank    = "min"-    show SourceRank = "source"-    show MaxRank    = "max"-    show SinkRank   = "sink"--instance Parseable RankType where-    parse = optionalQuoted-            $ oneOf [ string "same"   >> return SameRank-                    , string "min"    >> return MinRank-                    , string "source" >> return SourceRank-                    , string "max"    >> return MaxRank-                    , string "sink"   >> return SinkRank-                    ]---- -------------------------------------------------------------------------------data RankDir = FromTop-             | FromLeft-             | FromBottom-             | FromRight-               deriving (Eq, Read)--instance Show RankDir where-    show FromTop    = "TB"-    show FromLeft   = "LR"-    show FromBottom = "BT"-    show FromRight  = "RL"--instance Parseable RankDir where-    parse = optionalQuoted-            $ oneOf [ string "TB" >> return FromTop-                    , string "LR" >> return FromLeft-                    , string "BT" >> return FromBottom-                    , string "RL" >> return FromRight-                    ]---- -------------------------------------------------------------------------------data Shape-    = BoxShape-    | Polygon-    | Ellipse-    | Circle-    | PointShape-    | Egg-    | Triangle-    | Plaintext-    | DiamondShape-    | Trapezium-    | Parallelogram-    | House-    | Pentagon-    | Hexagon-    | Septagon-    | Octagon-    | Doublecircle-    | Doubleoctagon-    | Tripleoctagon-    | Invtriangle-    | Invtrapezium-    | Invhouse-    | Mdiamond-    | Msquare-    | Mcircle-    | Rectangle-    | NoShape-    | Note-    | Tab-    | Folder-    | Box3d-    | Component-      deriving (Eq, Read)--instance Show Shape where-    show BoxShape      = "box"-    show Polygon       = "polygon"-    show Ellipse       = "ellipse"-    show Circle        = "circle"-    show PointShape    = "point"-    show Egg           = "egg"-    show Triangle      = "triangle"-    show Plaintext     = "plaintext"-    show DiamondShape  = "diamond"-    show Trapezium     = "trapezium"-    show Parallelogram = "parallelogram"-    show House         = "house"-    show Pentagon      = "pentagon"-    show Hexagon       = "hexagon"-    show Septagon      = "septagon"-    show Octagon       = "octagon"-    show Doublecircle  = "doublecircle"-    show Doubleoctagon = "doubleoctagon"-    show Tripleoctagon = "tripleoctagon"-    show Invtriangle   = "invtriangle"-    show Invtrapezium  = "invtrapezium"-    show Invhouse      = "invhouse"-    show Mdiamond      = "mdiamond"-    show Msquare       = "msquare"-    show Mcircle       = "mcircle"-    show Rectangle     = "rectangle"-    show NoShape       = "none"-    show Note          = "note"-    show Tab           = "tab"-    show Folder        = "folder"-    show Box3d         = "box3d"-    show Component     = "component"--instance Parseable Shape where-    parse = optionalQuoted-            $ oneOf [ string "box"           >> return BoxShape-                    , string "polygon"       >> return Polygon-                    , string "ellipse"       >> return Ellipse-                    , string "circle"        >> return Circle-                    , string "point"         >> return PointShape-                    , string "egg"           >> return Egg-                    , string "triangle"      >> return Triangle-                    , string "plaintext"     >> return Plaintext-                    , string "diamond"       >> return DiamondShape-                    , string "trapezium"     >> return Trapezium-                    , string "parallelogram" >> return Parallelogram-                    , string "house"         >> return House-                    , string "pentagon"      >> return Pentagon-                    , string "hexagon"       >> return Hexagon-                    , string "septagon"      >> return Septagon-                    , string "octagon"       >> return Octagon-                    , string "doublecircle"  >> return Doublecircle-                    , string "doubleoctagon" >> return Doubleoctagon-                    , string "tripleoctagon" >> return Tripleoctagon-                    , string "invtriangle"   >> return Invtriangle-                    , string "invtrapezium"  >> return Invtrapezium-                    , string "invhouse"      >> return Invhouse-                    , string "mdiamond"      >> return Mdiamond-                    , string "msquare"       >> return Msquare-                    , string "mcircle"       >> return Mcircle-                    , string "rectangle"     >> return Rectangle-                    , string "none"          >> return NoShape-                    , string "note"          >> return Note-                    , string "tab"           >> return Tab-                    , string "folder"        >> return Folder-                    , string "box3d"         >> return Box3d-                    , string "component"     >> return Component-                    ]---- -------------------------------------------------------------------------------data SmoothType = NoSmooth-                | AvgDist-                | GraphDist-                | PowerDist-                | RNG-                | Spring-                | TriangleSmooth-                  deriving (Eq, Read)--instance Show SmoothType where-    show NoSmooth       = "none"-    show AvgDist        = "avg_dist"-    show GraphDist      = "graph_dist"-    show PowerDist      = "power_dist"-    show RNG            = "rng"-    show Spring         = "spring"-    show TriangleSmooth = "triangle"--instance Parseable SmoothType where-    parse = optionalQuoted-            $ oneOf [ string "none"       >> return NoSmooth-                    , string "avg_dist"   >> return AvgDist-                    , string "graph_dist" >> return GraphDist-                    , string "power_dist" >> return PowerDist-                    , string "rng"        >> return RNG-                    , string "spring"     >> return Spring-                    , string "triangle"   >> return TriangleSmooth-                    ]---- --------------------------------------------------------------------------------- | It it assumed that at least one of these is @Just{}@.-data StartType = ST (Maybe STStyle) (Maybe Int) -- Use a Word?-                 deriving (Eq, Read)--instance Show StartType where-    show (ST ms mi) = maybe id ((++) . show) ms-                      $ maybe "" show mi--instance Parseable StartType where-    parse = optionalQuoted-            $ do ms <- optional parse-                 mi <- optional parse-                 return $ ST ms mi--data STStyle = RegularStyle-             | Self-             | Random-               deriving (Eq, Read)--instance Show STStyle where-    show RegularStyle = "regular"-    show Self         = "self"-    show Random       = "random"--instance Parseable STStyle where-    parse = oneOf [ string "regular" >> return RegularStyle-                  , string "self"    >> return Self-                  , string "random"  >> return Random-                  ]---- -------------------------------------------------------------------------------data Style = Stl StyleName (Maybe String)-             deriving (Eq, Read)--instance Show Style where-    show (Stl nm marg) = maybe snm-                               (\arg -> show $ snm ++ '(' : arg ++ ")")-                               marg-        where-          snm = show nm--instance Parseable Style where-    parse = oneOf [ optionalQuoted $ liftM (\nm -> Stl nm Nothing) parse-                  , quotedParse $ do nm <- parse-                                     char '('-                                     arg <- many1-                                            $ satisfy (flip notElem "()")--                                     char ')'-                                     return $ Stl nm (Just arg)-                  ]--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-                 deriving (Eq, Read)--instance Show StyleName where-    show Filled    = "filled"-    show Invisible = "invis"-    show Diagonals = "diagonals"-    show Rounded   = "rounded"-    show Dashed    = "dashed"-    show Dotted    = "dotted"-    show Solid     = "solid"-    show Bold      = "bold"--instance Parseable StyleName where-    parse = optionalQuoted-            $ oneOf [ string "filled"    >> return Filled-                    , string "invis"     >> return Invisible-                    , string "diagonals" >> return Diagonals-                    , string "rounded"   >> return Rounded-                    , string "dashed"    >> return Dashed-                    , string "dotted"    >> return Dotted-                    , string "solid"     >> return Solid-                    , string "bold"      >> return Bold-                    ]---- -------------------------------------------------------------------------------newtype PortPos = PP CompassPoint-    deriving (Eq, Read)--instance Show PortPos where-    show (PP cp) = show cp--instance Parseable PortPos where-    parse = liftM PP parse--data CompassPoint = North-                  | NorthEast-                  | East-                  | SouthEast-                  | South-                  | SouthWest-                  | West-                  | NorthWest-                  | CenterPoint-                  | NoCP-                    deriving (Eq, Read)--instance Show CompassPoint where-    show North       = "n"-    show NorthEast   = "ne"-    show East        = "e"-    show SouthEast   = "se"-    show South       = "s"-    show SouthWest   = "sw"-    show West        = "w"-    show NorthWest   = "nw"-    show CenterPoint = "c"-    show NoCP        = "_"--instance Parseable CompassPoint where-    parse = optionalQuoted-            $ oneOf [ string "n"  >> return North-                    , string "ne" >> return NorthEast-                    , string "e"  >> return East-                    , string "se" >> return SouthEast-                    , string "s"  >> return South-                    , string "sw" >> return SouthWest-                    , string "w"  >> return West-                    , string "nw" >> return NorthWest-                    , string "c"  >> return CenterPoint-                    , string "_"  >> return NoCP-                    ]---- -------------------------------------------------------------------------------data ViewPort = VP { wVal  :: Double-                   , hVal  :: Double-                   , zVal  :: Double-                   , focus :: Maybe FocusType-                   }-                deriving (Eq, Read)--instance Show ViewPort where-    show vp = show-              . maybe id (flip (++) . show) (focus vp)-              $ show (wVal vp)-              ++ ',' : show (hVal vp)-              ++ ',' : show (zVal vp)--instance Parseable ViewPort where-    parse = quotedParse-            $ do wv <- parse-                 char ','-                 hv <- parse-                 char ','-                 zv <- parse-                 mf <- optional $ char ',' >> parse-                 return $ VP wv hv zv mf--data FocusType = XY Point-               | NodeFocus String-                 deriving (Eq, Read)--instance Show FocusType where-    show (XY p)        = showPoint p-    show (NodeFocus nm) = nm--instance Parseable FocusType where-    parse = oneOf [ liftM XY parsePoint-                  , liftM NodeFocus stringBlock-                  ]---- --------------------------------------------------------------------------------- | Note that 'VCenter' is only valid for Nodes.-data VerticalPlacement = VTop-                       | VCenter-                       | VBottom-                         deriving (Eq, Read)--instance Show VerticalPlacement where-    show VTop    = "t"-    show VCenter = "c"-    show VBottom = "b"--instance Parseable VerticalPlacement where-    parse = optionalQuoted-            $ oneOf [ string "t" >> return VTop-                    , string "c" >> return VCenter-                    , string "b" >> return VBottom-                    ]----- -------------------------------------------------------------------------------data ScaleType = UniformScale-               | NoScale-               | FillWidth-               | FillHeight-               | FillBoth-                 deriving (Eq, Read)--instance Show ScaleType where-    show UniformScale = "true"-    show NoScale      = "false"-    show FillWidth    = "width"-    show FillHeight   = "height"-    show FillBoth     = "both"--instance Parseable ScaleType where-    parse = optionalQuoted-            $ oneOf [ string "true"   >> return UniformScale-                    , string "false"  >> return NoScale-                    , string "width"  >> return FillWidth-                    , string "height" >> return FillHeight-                    , string "both"   >> return FillBoth-                    ]---- -------------------------------------------------------------------------------data Justification = JLeft-                   | JRight-                   | JCenter-                     deriving (Eq, Read)--instance Show Justification where-    show JLeft   = "l"-    show JRight  = "r"-    show JCenter = "c"--instance Parseable Justification where-    parse = optionalQuoted-            $ oneOf [ string "l" >> return JLeft-                    , string "r" >> return JRight-                    , string "c" >> return JCenter-                    ]---- -------------------------------------------------------------------------------data Ratios = AspectRatio Double-            | FillRatio-            | CompressRatio-            | ExpandRatio-            | AutoRatio-              deriving (Eq, Read)--instance Show Ratios where-    show (AspectRatio r) = show r-    show FillRatio       = "fill"-    show CompressRatio   = "compress"-    show ExpandRatio     = "expand"-    show AutoRatio       = "auto"--instance Parseable Ratios where-    parse = optionalQuoted-            $ oneOf [ liftM AspectRatio parse-                    , string "fill"     >> return FillRatio-                    , string "compress" >> return CompressRatio-                    , string "expand"   >> return ExpandRatio-                    , string "auto"     >> return AutoRatio-                    ]---- --------------------------------------------------------------------------------- | Represents 'String's that definitely have quotes around them.-newtype QuotedString = QS { qStr :: String }-    deriving (Eq, Read)--instance Show QuotedString where-    show = show . qStr--instance Parseable QuotedString where-    parse = liftM (QS . tail . init) quotedString---- --------------------------------------------------------------------------------- Utility Functions---- | Fold over 'Bool's.-bool       :: a -> a -> Bool -> a-bool t f b = if b-             then t-             else f+     <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:++   * There might still be a few cases where quotes are still not+     escaped/parsed correctly; if you find such a situation, please+     let me know; however, you should be able to use 'String' values+     directly without having to worry about when quotes are required+     or extra escaping of quote characters as 'PrintDot' and+     'ParseDot' instances for 'String' should take care of that+     for you.++   * 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).++   * GraphViz says that a number like @/.02/@ is valid; this library+     disagrees.++   * When parsing named 'Color' values, the entire value entered is+     kept as-is; this library as yet has no understanding of different+     color schemes, etc.++   * ColorList and PointfList are defined as actual lists (but+     'LayerList' is not).  Note that for the Color 'Attribute' for+     node values, only a single Color is valid; edges are allowed+     multiple colors with one spline/arrow per color in the list (but+     you must have at least one 'Color' in the list).  This might be+     changed in future.++   * 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, and feature support for pure+     'Int'-based co-ordinates as well as 'Double' ones (i.e. no floating+     point-only points for Point).  The optional '!' and third value+     for Point are not available.++   * 'Rect' uses two 'Point' values to denote the lower-left and+     top-right corners.++   * The two 'LabelLoc' attributes have been combined.++   * The defined 'LayerSep' is not used to parse 'LayerRange' or+     'LayerList'; the default (@[' ', ':', '\t']@) is instead used.++   * @SplineType@ has been replaced with @['Spline']@.++   * Only polygon-based 'Shape's are available.++   * 'PortPos' only has the 'CompassPoint' option, not+     @PortName[:CompassPoint]@ (since record shapes aren't allowed,+     and parsing HTML-like labels could be problematic).++   * Not every 'Attribute' is fully documented/described.  However,+     all those which have specific allowed values should be covered.++   * Deprecated 'Overlap' algorithms are not defined.++ -}+module Data.GraphViz.Attributes+    ( -- * The actual /Dot/ attributes.+      Attribute(..)+    , Attributes+      -- ** Validity functions on @Attribute@ values.+    , usedByGraphs+    , usedBySubGraphs+    , usedByClusters+    , usedByNodes+    , usedByEdges+      -- * Value types for @Attribute@s.+    , EscString+    , URL(..)+    , ArrowType(..)+    , AspectType(..)+    , Rect(..)+    , Color(..)+    , ClusterMode(..)+    , DirType(..)+    , DEConstraints(..)+    , DPoint(..)+    , ModeType(..)+    , Model(..)+    , Label(..)+    , Point(..)+    , Overlap(..)+    , LayerRange(..)+    , LayerID(..)+    , LayerList(..)+    , OutputMode(..)+    , Pack(..)+    , PackMode(..)+    , Pos(..)+    , EdgeType(..)+    , PageDir(..)+    , Spline(..)+    , QuadType(..)+    , Root(..)+    , RankType(..)+    , RankDir(..)+    , Shape(..)+    , SmoothType(..)+    , StartType(..)+    , STStyle(..)+    , StyleItem(..)+    , StyleName(..)+    , PortPos(..)+    , CompassPoint(..)+    , ViewPort(..)+    , FocusType(..)+    , VerticalPlacement(..)+    , ScaleType(..)+    , Justification(..)+    , Ratios(..)+    -- * Types representing the Dot grammar for @ArrowType@.+    , ArrowShape(..)+    , ArrowModifier(..)+    , ArrowFill(..)+    , ArrowSide(..)+    -- ** Default @ArrowType@ aliases.+    -- *** The 9 primitive @ArrowShape@s.+    , box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee+    -- *** 5 derived Arrows.+    , oDot, invDot, invODot, oBox, oDiamond+    -- *** 5 supported cases for backwards compatibility+    , eDiamond, openArr, halfOpen, emptyArr, invEmpty+    -- ** @ArrowModifier@ instances+    , noMods, openMod+    ) where++import Data.GraphViz.Types.Internal+import Data.GraphViz.Types.Parsing+import Data.GraphViz.Types.Printing++import Data.Char(isDigit, isHexDigit)+import Data.Maybe(isJust, maybe)+import Data.Word(Word8)+import Numeric(showHex, readHex)+import Control.Monad(liftM)++-- -----------------------------------------------------------------------------++{- |++   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.+-}+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 URL                          -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only+    | 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'@+    | Aspect AspectType                -- ^ /Valid for/: G; /Notes/: dot only+    | Bb Rect                          -- ^ /Valid for/: G; /Notes/: write only+    | BgColor Color                    -- ^ /Valid for/: GC; /Default/: none+    | Center Bool                      -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+    | Charset String                   -- ^ /Valid for/: G; /Default/: @\"UTF-8\"@+    | ClusterRank ClusterMode          -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only+    | Color [Color]                    -- ^ /Valid for/: ENC; /Default/: @black@+    | ColorScheme String               -- ^ /Valid for/: ENCG; /Default/: @\"\"@+    | Comment String                   -- ^ /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+    | 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 URL                      -- ^ /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/: @+3@; /Notes/: not dot+    | FillColor Color                  -- ^ /Valid for/: NC; /Default/: @lightgrey@ (nodes), @black@ (clusters)+    | FixedSize Bool                   -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'+    | FontColor Color                  -- ^ /Valid for/: ENGC; /Default/: @black@+    | FontName String                  -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@+    | FontNames String                 -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only+    | FontPath String                  -- ^ /Valid for/: G; /Default/: system-dependent+    | FontSize Double                  -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@+    | Group String                     -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only+    | HeadURL URL                      -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+    | HeadClip Bool                    -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'+    | HeadLabel Label                  -- ^ /Valid for/: E; /Default/: @\"\"@+    | HeadPort PortPos                 -- ^ /Valid for/: E; /Default/: @'PP' '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 Label                         -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only+    | Image String                     -- ^ /Valid for/: N; /Default/: @\"\"@+    | ImageScale ScaleType             -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'+    | Label Label                      -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)+    | LabelURL URL                     -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+    | 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/: @black@+    | LabelFontName String             -- ^ /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; /Default/: @\"\"@+    | Layers LayerList                 -- ^ /Valid for/: G; /Default/: @\"\"@+    | LayerSep String                  -- ^ /Valid for/: G; /Default/: @\" :\t\"@+    | Layout String                    -- ^ /Valid for/: G; /Default/: @\"\"@+    | Len Double                       -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only+    | Levels Int                       -- ^ /Valid for/: G; /Default/: @MAXINT@; /Minimum/: @0@; /Notes/: sfdp only+    | LevelsGap Double                 -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only+    | LHead String                     -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+    | LPos Point                       -- ^ /Valid for/: EGC; /Notes/: write only+    | LTail String                     -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+    | 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 String                  -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: dot only+    | Orientation Double               -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@+    | OrientationGraph String          -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: Landscape if \"[lL]*\" and rotate not defined+    | 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/: @'False'@; /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/: @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/: @'TB'@; /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@+    | SameHead String                  -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+    | SameTail String                  -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+    | SamplePoints Int                 -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)+    | SearchSize Int                   -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only+    | Sep DPoint                       -- ^ /Valid for/: G; /Default/: @+4@; /Notes/: not dot+    | Shape Shape                      -- ^ /Valid for/: N; /Default/: @'Ellipse'@+    | ShapeFile String                 -- ^ /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 Int                        -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@+    | Splines EdgeType                 -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges'+    | Start StartType                  -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: fdp, neato only+    | Style [StyleItem]                -- ^ /Valid for/: ENC+    | StyleSheet String                -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only+    | TailURL URL                      -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+    | TailClip Bool                    -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'+    | TailLabel Label                  -- ^ /Valid for/: E; /Default/: @\"\"@+    | TailPort PortPos                 -- ^ /Valid for/: E; /Default/: center+    | 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@+    | Z Double                         -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-MAXFLOAT@, @-1000@+      deriving (Eq, Show, Read)++type Attributes = [Attribute]++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 (Bb v)                 = printField "bb" v+    unqtDot (BgColor v)            = printField "bgcolor" v+    unqtDot (Center v)             = printField "center" v+    unqtDot (Charset v)            = printField "charset" 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 (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 (ImageScale v)         = printField "imagescale" v+    unqtDot (Label v)              = printField "label" v+    unqtDot (LabelURL v)           = printField "labelURL" 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 (Levels v)             = printField "levels" v+    unqtDot (LevelsGap v)          = printField "levelsgap" v+    unqtDot (LHead v)              = printField "lhead" v+    unqtDot (LPos v)               = printField "lp" v+    unqtDot (LTail v)              = printField "ltail" 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 (OrientationGraph 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 (SameHead v)           = printField "samehead" v+    unqtDot (SameTail v)           = printField "sametail" v+    unqtDot (SamplePoints v)       = printField "samplepoints" 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 (Z v)                  = printField "z" v++    listToDot = unqtListToDot++instance ParseDot Attribute where+    parseUnqt = oneOf [ liftM Damping            $ parseField "Damping"+                      , liftM K                  $ parseField "K"+                      , liftM URL                $ parseFields ["URL", "href"]+                      , liftM ArrowHead          $ parseField "arrowhead"+                      , liftM ArrowSize          $ parseField "arrowsize"+                      , liftM ArrowTail          $ parseField "arrowtail"+                      , liftM Aspect             $ parseField "aspect"+                      , liftM Bb                 $ parseField "bb"+                      , liftM BgColor            $ parseField "bgcolor"+                      , liftM Center             $ parseFieldBool "center"+                      , liftM Charset            $ parseField "charset"+                      , liftM ClusterRank        $ parseField "clusterrank"+                      , liftM Color              $ parseField "color"+                      , liftM ColorScheme        $ parseField "colorscheme"+                      , liftM Comment            $ parseField "comment"+                      , liftM Compound           $ parseFieldBool "compound"+                      , liftM Concentrate        $ parseFieldBool "concentrate"+                      , liftM Constraint         $ parseFieldBool "constraint"+                      , liftM Decorate           $ parseFieldBool "decorate"+                      , liftM DefaultDist        $ parseField "defaultdist"+                      , liftM Dim                $ parseField "dim"+                      , liftM Dimen              $ parseField "dimen"+                      , liftM Dir                $ parseField "dir"+                      , liftM DirEdgeConstraints $ parseFieldDef EdgeConstraints "diredgeconstraints"+                      , liftM Distortion         $ parseField "distortion"+                      , liftM DPI                $ parseFields ["dpi", "resolution"]+                      , liftM EdgeURL            $ parseFields ["edgeURL", "edgehref"]+                      , liftM EdgeTarget         $ parseField "edgetarget"+                      , liftM EdgeTooltip        $ parseField "edgetooltip"+                      , liftM Epsilon            $ parseField "epsilon"+                      , liftM ESep               $ parseField "esep"+                      , liftM FillColor          $ parseField "fillcolor"+                      , liftM FixedSize          $ parseFieldBool "fixedsize"+                      , liftM FontColor          $ parseField "fontcolor"+                      , liftM FontName           $ parseField "fontname"+                      , liftM FontNames          $ parseField "fontnames"+                      , liftM FontPath           $ parseField "fontpath"+                      , liftM FontSize           $ parseField "fontsize"+                      , liftM Group              $ parseField "group"+                      , liftM HeadURL            $ parseFields ["headURL", "headhref"]+                      , liftM HeadClip           $ parseFieldBool "headclip"+                      , liftM HeadLabel          $ parseField "headlabel"+                      , liftM HeadPort           $ parseField "headport"+                      , liftM HeadTarget         $ parseField "headtarget"+                      , liftM HeadTooltip        $ parseField "headtooltip"+                      , liftM Height             $ parseField "height"+                      , liftM ID                 $ parseField "id"+                      , liftM Image              $ parseField "image"+                      , liftM ImageScale         $ parseFieldDef UniformScale "imagescale"+                      , liftM Label              $ parseField "label"+                      , liftM LabelURL           $ parseFields ["labelURL", "labelhref"]+                      , liftM LabelAngle         $ parseField "labelangle"+                      , liftM LabelDistance      $ parseField "labeldistance"+                      , liftM LabelFloat         $ parseFieldBool "labelfloat"+                      , liftM LabelFontColor     $ parseField "labelfontcolor"+                      , liftM LabelFontName      $ parseField "labelfontname"+                      , liftM LabelFontSize      $ parseField "labelfontsize"+                      , liftM LabelJust          $ parseField "labeljust"+                      , liftM LabelLoc           $ parseField "labelloc"+                      , liftM LabelTarget        $ parseField "labeltarget"+                      , liftM LabelTooltip       $ parseField "labeltooltip"+                      , liftM Landscape          $ parseFieldBool "landscape"+                      , liftM Layer              $ parseField "layer"+                      , liftM Layers             $ parseField "layers"+                      , liftM LayerSep           $ parseField "layersep"+                      , liftM Layout             $ parseField "layout"+                      , liftM Len                $ parseField "len"+                      , liftM Levels             $ parseField "levels"+                      , liftM LevelsGap          $ parseField "levelsgap"+                      , liftM LHead              $ parseField "lhead"+                      , liftM LPos               $ parseField "lp"+                      , liftM LTail              $ parseField "ltail"+                      , liftM Margin             $ parseField "margin"+                      , liftM MaxIter            $ parseField "maxiter"+                      , liftM MCLimit            $ parseField "mclimit"+                      , liftM MinDist            $ parseField "mindist"+                      , liftM MinLen             $ parseField "minlen"+                      , liftM Mode               $ parseField "mode"+                      , liftM Model              $ parseField "model"+                      , liftM Mosek              $ parseFieldBool "mosek"+                      , liftM NodeSep            $ parseField "nodesep"+                      , liftM NoJustify          $ parseFieldBool "nojustify"+                      , liftM Normalize          $ parseFieldBool "normalize"+                      , liftM Nslimit            $ parseField "nslimit"+                      , liftM Nslimit1           $ parseField "nslimit1"+                      , liftM Ordering           $ parseField "ordering"+                      , liftM Orientation        $ parseField "orientation"+                      , liftM OrientationGraph   $ parseField "orientation"+                      , liftM OutputOrder        $ parseField "outputorder"+                      , liftM Overlap            $ parseFieldDef KeepOverlaps "overlap"+                      , liftM OverlapScaling     $ parseField "overlap_scaling"+                      , liftM Pack               $ parseFieldDef DoPack "pack"+                      , liftM PackMode           $ parseField "packmode"+                      , liftM Pad                $ parseField "pad"+                      , liftM Page               $ parseField "page"+                      , liftM PageDir            $ parseField "pagedir"+                      , liftM PenColor           $ parseField "pencolor"+                      , liftM PenWidth           $ parseField "penwidth"+                      , liftM Peripheries        $ parseField "peripheries"+                      , liftM Pin                $ parseFieldBool "pin"+                      , liftM Pos                $ parseField "pos"+                      , liftM QuadTree           $ parseFieldDef NormalQT "quadtree"+                      , liftM Quantum            $ parseField "quantum"+                      , liftM Rank               $ parseField "rank"+                      , liftM RankDir            $ parseField "rankdir"+                      , liftM Ranksep            $ parseField "ranksep"+                      , liftM Ratio              $ parseField "ratio"+                      , liftM Rects              $ parseField "rects"+                      , liftM Regular            $ parseFieldBool "regular"+                      , liftM ReMinCross         $ parseFieldBool "remincross"+                      , liftM RepulsiveForce     $ parseField "repulsiveforce"+                      , liftM Root               $ parseFieldDef IsCentral "root"+                      , liftM Rotate             $ parseField "rotate"+                      , liftM SameHead           $ parseField "samehead"+                      , liftM SameTail           $ parseField "sametail"+                      , liftM SamplePoints       $ parseField "samplepoints"+                      , liftM SearchSize         $ parseField "searchsize"+                      , liftM Sep                $ parseField "sep"+                      , liftM Shape              $ parseField "shape"+                      , liftM ShapeFile          $ parseField "shapefile"+                      , liftM ShowBoxes          $ parseField "showboxes"+                      , liftM Sides              $ parseField "sides"+                      , liftM Size               $ parseField "size"+                      , liftM Skew               $ parseField "skew"+                      , liftM Smoothing          $ parseField "smoothing"+                      , liftM SortV              $ parseField "sortv"+                      , liftM Splines            $ parseFieldDef SplineEdges "splines"+                      , liftM Start              $ parseField "start"+                      , liftM Style              $ parseField "style"+                      , liftM StyleSheet         $ parseField "stylesheet"+                      , liftM TailURL            $ parseFields ["tailURL", "tailhref"]+                      , liftM TailClip           $ parseFieldBool "tailclip"+                      , liftM TailLabel          $ parseField "taillabel"+                      , liftM TailPort           $ parseField "tailport"+                      , liftM TailTarget         $ parseField "tailtarget"+                      , liftM TailTooltip        $ parseField "tailtooltip"+                      , liftM Target             $ parseField "target"+                      , liftM Tooltip            $ parseField "tooltip"+                      , liftM TrueColor          $ parseFieldBool "truecolor"+                      , liftM Vertices           $ parseField "vertices"+                      , liftM ViewPort           $ parseField "viewport"+                      , liftM VoroMargin         $ parseField "voro_margin"+                      , liftM Weight             $ parseField "weight"+                      , liftM Width              $ parseField "width"+                      , liftM Z                  $ parseField "z"+                      ]++    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 Bb{}                 = True+usedByGraphs BgColor{}            = True+usedByGraphs Center{}             = True+usedByGraphs Charset{}            = 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 ID{}                 = True+usedByGraphs Label{}              = True+usedByGraphs LabelJust{}          = True+usedByGraphs LabelLoc{}           = True+usedByGraphs Landscape{}          = True+usedByGraphs Layers{}             = True+usedByGraphs LayerSep{}           = True+usedByGraphs Layout{}             = True+usedByGraphs Levels{}             = True+usedByGraphs LevelsGap{}          = True+usedByGraphs LPos{}               = 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 OrientationGraph{}   = 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 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 _                    = False++-- | Determine if this Attribute is valid for use with Clusters.+usedByClusters               :: Attribute -> Bool+usedByClusters K{}           = True+usedByClusters URL{}         = True+usedByClusters BgColor{}     = True+usedByClusters Color{}       = True+usedByClusters ColorScheme{} = True+usedByClusters FillColor{}   = True+usedByClusters FontColor{}   = True+usedByClusters FontName{}    = True+usedByClusters FontSize{}    = True+usedByClusters Label{}       = True+usedByClusters LabelJust{}   = True+usedByClusters LabelLoc{}    = True+usedByClusters LPos{}        = 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 _             = False++-- | Determine if this Attribute is valid for use with SubGraphs.+usedBySubGraphs        :: Attribute -> Bool+usedBySubGraphs Rank{} = True+usedBySubGraphs _      = False++-- | Determine if this Attribute is valid for use with Nodes.+usedByNodes                :: Attribute -> Bool+usedByNodes URL{}          = 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 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 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 Z{}            = 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 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 _                = False++{- Delete to here -}+-- -----------------------------------------------------------------------------++{- |++   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 'String' 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 'String's):++     [@\\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 = String++-- -----------------------------------------------------------------------------++newtype URL = UStr { urlString :: EscString }+    deriving (Eq, Show, Read)++instance PrintDot URL where+    unqtDot = wrap (char '<') (char '>')+              -- Explicitly use text here... no quotes!+              . text . urlString++instance ParseDot URL where+    parseUnqt = liftM UStr+                $ bracket (character open)+                          (character close)+                          (liftM return $ satisfy ((/=) close))+        where+          open = '<'+          close = '>'++    -- No quotes+    parse = parseUnqt++-- -----------------------------------------------------------------------------++-- | /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, Show, Read)++box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: ArrowType+oDot, invDot, invODot, oBox, oDiamond :: ArrowType+eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType++normal = AType [(noMods, Normal)]+inv = AType [(noMods, Inv)]+dotArrow = AType [(noMods, DotArrow)]+invDot = AType [ (noMods, Inv)+               , (noMods, DotArrow)]+oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)]+invODot = AType [ (noMods, Inv)+                , (openMod, DotArrow)]+noArrow = AType [(noMods, NoArrow)]+tee = AType [(noMods, Tee)]+emptyArr = AType [(openMod, Normal)]+invEmpty = AType [ (noMods, Inv)+                 , (openMod, Normal)]+diamond = AType [(noMods, Diamond)]+oDiamond = AType [(openMod, Diamond)]+eDiamond = oDiamond+crow = AType [(noMods, Crow)]+box = AType [(noMods, Box)]+oBox = AType [(openMod, Box)]+openArr = vee+halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]+vee = AType [(noMods, Vee)]++instance PrintDot ArrowType where+    unqtDot (AType mas) = hcat $ map appMod mas+        where+          appMod (m, a) = unqtDot m <> unqtDot a++instance ParseDot ArrowType where+    parseUnqt = do mas <- many1 $ do m <- parseUnqt+                                     a <- parseUnqt+                                     return (m,a)+                   return $ AType mas+                `onFail`+                specialArrowParse++specialArrowParse :: Parse ArrowType+specialArrowParse = oneOf [ stringRep eDiamond "ediamond"+                          , stringRep openArr "open"+                          , stringRep halfOpen "halfopen"+                          , stringRep emptyArr "empty"+                          , stringRep invEmpty "invempty"+                          ]++data ArrowShape = Box+                | Crow+                | Diamond+                | DotArrow+                | Inv+                | NoArrow+                | Normal+                | Tee+                | Vee+                  deriving (Eq, Show, Read)++instance PrintDot ArrowShape where+    unqtDot Box      = unqtDot "box"+    unqtDot Crow     = unqtDot "crow"+    unqtDot Diamond  = unqtDot "diamond"+    unqtDot DotArrow = unqtDot "dot"+    unqtDot Inv      = unqtDot "inv"+    unqtDot NoArrow  = unqtDot "none"+    unqtDot Normal   = unqtDot "normal"+    unqtDot Tee      = unqtDot "tee"+    unqtDot Vee      = unqtDot "vee"++instance ParseDot ArrowShape where+    parseUnqt = oneOf [ stringRep Box "box"+                      , stringRep Crow "crow"+                      , stringRep Diamond "diamond"+                      , stringRep DotArrow "dot"+                      , stringRep Inv "inv"+                      , stringRep NoArrow "none"+                      , stringRep Normal "normal"+                      , stringRep Tee "tee"+                      , stringRep Vee "vee"+                      ]++-- | What modifications to apply to an 'ArrowShape'.+data ArrowModifier = ArrMod { arrowFill :: ArrowFill+                            , arrowSide :: ArrowSide+                            }+                     deriving (Eq, 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, Show, Read)++instance PrintDot ArrowFill where+    unqtDot OpenArrow   = char 'o'+    unqtDot FilledArrow = empty++instance ParseDot ArrowFill where+    parseUnqt = liftM (bool OpenArrow FilledArrow . 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, 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 LeftSide RightSide . (==) 'l')++    -- Not used individually+    parse = parseUnqt++-- -----------------------------------------------------------------------------++data AspectType = RatioOnly Double+                | RatioPassCount Double Int+                  deriving (Eq, 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{} = doubleQuotes $ unqtDot at++instance ParseDot AspectType where+    parseUnqt = liftM (uncurry RatioPassCount) commaSep+                `onFail`+                liftM RatioOnly parse+++    parse = quotedParse (liftM (uncurry RatioPassCount) commaSep)+            `onFail`+            optionalQuoted (liftM RatioOnly parse)++-- -----------------------------------------------------------------------------++data Rect = Rect Point Point+            deriving (Eq, Show, Read)++instance PrintDot Rect where+    unqtDot (Rect p1 p2) = commaDel p1 p2++    toDot = doubleQuotes . unqtDot++instance ParseDot Rect where+    parseUnqt = liftM (uncurry Rect)+                $ commaSep' parseUnqt parseUnqt++    parse = liftM (uncurry Rect) . quotedParse+            $ commaSep' parseUnqt parseUnqt++-- -----------------------------------------------------------------------------++data Color = RGB { red   :: Word8+                 , green :: Word8+                 , blue  :: Word8+                 }+           | RGBA { red   :: Word8+                  , green :: Word8+                  , blue  :: Word8+                  , alpha :: Word8+                  }+           | HSV { hue        :: Double+                 , saturation :: Double+                 , value      :: Double+                 }+           | ColorName String+             deriving (Eq, Show, Read)++instance PrintDot Color where+    unqtDot (RGB  r g b)     = hexColor [r,g,b]+    unqtDot (RGBA r g b a)   = hexColor [r,g,b,a]+    unqtDot (HSV  h s v)     = hcat . punctuate comma $ map unqtDot [h,s,v]+    unqtDot (ColorName name) = unqtDot name++    toDot (ColorName name) = toDot name+    toDot c                = doubleQuotes $ unqtDot c++    unqtListToDot = hcat . punctuate colon . map unqtDot++    listToDot [ColorName nm] = toDot nm+    listToDot cs             = doubleQuotes $ unqtListToDot cs++hexColor :: [Word8] -> DotCode+hexColor = (<>) (char '#') . hcat . map word8Doc++word8Doc   :: Word8 -> DotCode+word8Doc w = text $ padding ++ simple+    where+      simple = showHex w ""+      padding = replicate count '0'+      count = 2 - findCols 1 w+      findCols :: Int -> Word8 -> Int+      findCols c n+          | n < 16 = c+          | otherwise = findCols (c+1) (n `div` 16)++instance ParseDot Color where+    parseUnqt = oneOf [ parseHexBased+                      , parseHSV+                      , liftM ColorName parse -- Should we check it+                                              -- is a colour?+                      ]+        where+          parseHexBased+              = do character '#'+                   cs <- many1 parse2Hex+                   return $ case cs of+                              [r,g,b] -> RGB r g b+                              [r,g,b,a] -> RGBA r g b a+                              _ -> error $ "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 ","+                           , whitespace+                           ]+          parse2Hex = do c1 <- satisfy isHexDigit+                         c2 <- satisfy isHexDigit+                         let [(n, [])] = readHex [c1, c2]+                         return n+++    parse = liftM ColorName stringBlock -- unquoted Color Name+            `onFail`+            quotedParse parseUnqt++    parseUnqtList = sepBy1 parseUnqt (character ':')++    parseList = liftM (return . ColorName) stringBlock -- unquoted single+                                                       -- ColorName+                `onFail`+                quotedParse parseUnqtList++-- -----------------------------------------------------------------------------++data ClusterMode = Local+                 | Global+                 | NoCluster+                   deriving (Eq, Show, Read)++instance PrintDot ClusterMode where+    unqtDot Local     = unqtDot "local"+    unqtDot Global    = unqtDot "global"+    unqtDot NoCluster = unqtDot "none"++++instance ParseDot ClusterMode where+    parseUnqt = oneOf [ stringRep Local "local"+                      , stringRep Global "global"+                      , stringRep NoCluster "none"+                      ]++-- -----------------------------------------------------------------------------++data DirType = Forward | Back | Both | NoDir+               deriving (Eq, Show, Read)++instance PrintDot DirType where+    unqtDot Forward = unqtDot "forward"+    unqtDot Back    = unqtDot "back"+    unqtDot Both    = unqtDot "both"+    unqtDot NoDir   = unqtDot "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, 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 EdgeConstraints NoConstraints) parse+                `onFail`+                stringRep HierConstraints "hier"++-- -----------------------------------------------------------------------------++-- | Either a 'Double' or a 'Point'.+data DPoint = DVal Double+            | PVal Point+             deriving (Eq, 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 DVal parseUnqt+                `onFail`+                liftM PVal parseUnqt++    parse = liftM DVal parse+            `onFail`+            liftM PVal parse++-- -----------------------------------------------------------------------------++data ModeType = Major+              | KK+              | Hier+              | IpSep+                deriving (Eq, 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, 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+           | URLLabel URL+             deriving (Eq, Show, Read)++instance PrintDot Label where+    unqtDot (StrLabel s) = unqtDot s+    unqtDot (URLLabel u) = unqtDot u++    toDot (StrLabel s) = toDot s+    toDot (URLLabel u) = toDot u++instance ParseDot Label where+    parseUnqt = liftM StrLabel parseUnqt+                `onFail`+                liftM URLLabel parseUnqt++    parse = liftM StrLabel parse+            `onFail`+            liftM URLLabel parse++-- -----------------------------------------------------------------------------++data Point = Point Int Int+           | PointD Double Double+             deriving (Eq, Show, Read)++instance PrintDot Point where+    unqtDot (Point  x y) = commaDel x y+    unqtDot (PointD x y) = commaDel x y++    toDot = doubleQuotes . unqtDot++    unqtListToDot = hsep . map unqtDot++    listToDot = doubleQuotes . unqtListToDot++instance ParseDot Point where+    parseUnqt = liftM (uncurry Point)  commaSep+                `onFail`+                liftM (uncurry PointD) commaSep++    parse = quotedParse parseUnqt++    parseUnqtList = sepBy1 parseUnqt whitespace++-- -----------------------------------------------------------------------------++data Overlap = KeepOverlaps+             | RemoveOverlaps+             | ScaleOverlaps+             | ScaleXYOverlaps+             | PrismOverlap (Maybe Int) -- ^ Only when sfdp is available, 'Int' is non-negative+             | CompressOverlap+             | VpscOverlap+             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@+               deriving (Eq, Show, Read)++instance PrintDot Overlap where+    unqtDot KeepOverlaps     = unqtDot True+    unqtDot RemoveOverlaps   = unqtDot False+    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 RemoveOverlaps "false"+                      , stringRep ScaleOverlaps "scale"+                      , stringRep ScaleXYOverlaps "scalexy"+                      , string "prism" >> liftM PrismOverlap (optional parse)+                      , stringRep CompressOverlap "compress"+                      , stringRep VpscOverlap "vpsc"+                      , stringRep IpsepOverlap "ipsep"+                      ]++-- -----------------------------------------------------------------------------++data LayerRange = LRID LayerID+                | LRS LayerID String LayerID+                  deriving (Eq, Show, Read)++instance PrintDot LayerRange where+    unqtDot (LRID lid)      = unqtDot lid+    unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2++    toDot (LRID lid) = toDot lid+    toDot lrs        = doubleQuotes $ unqtDot lrs++instance ParseDot LayerRange where+    parseUnqt = liftM LRID parseUnqt+                `onFail`+                do id1 <- parseUnqt+                   s   <- parseLayerSep+                   id2 <- parseUnqt+                   return $ LRS id1 s id2++    parse = liftM LRID parse+            `onFail`+            quotedParse ( do id1 <- parseUnqt+                             s   <- parseLayerSep+                             id2 <- parseUnqt+                             return $ LRS id1 s id2+                        )+++parseLayerSep :: Parse String+parseLayerSep = many1 . oneOf+                $ map character defLayerSep++defLayerSep :: [Char]+defLayerSep = [' ', ':', '\t']++parseLayerName :: Parse String+parseLayerName = many1 $ satisfy (flip notElem defLayerSep)++data LayerID = AllLayers+             | LRInt Int+             | LRName String+               deriving (Eq, 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++instance ParseDot LayerID where+    parseUnqt = oneOf [ stringRep AllLayers "all"+                      , liftM LRInt parseUnqt+                      , liftM LRName parseLayerName+                      ]++    parse = oneOf [ optionalQuoted $ stringRep AllLayers "all"+                  , liftM LRInt parse -- Has optionalQuoted in it+                  , quotedParse $ liftM LRName parseLayerName+                  ]++-- | The list represent (Separator, Name)+data LayerList = LL String [(String, String)]+                 deriving (Eq, Show, Read)++instance PrintDot LayerList where+    unqtDot (LL l1 ols) = unqtDot l1 <> hsep (map subLL ols)+        where+          subLL (s, l) = unqtDot s <> unqtDot l++    -- Might not need quotes, but probably will.+    toDot = doubleQuotes . unqtDot++instance ParseDot LayerList where+    parseUnqt = do l1 <- parseLayerName+                   ols <- many $ do s   <- parseLayerSep+                                    lnm <- parseLayerName+                                    return (s, lnm)+                   return $ LL l1 ols++    parse = quotedParse parseUnqt++-- -----------------------------------------------------------------------------++data OutputMode = BreadthFirst | NodesFirst | EdgesFirst+                  deriving (Eq, 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, 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 (bool DoPack DontPack) parseUnqt+                      , liftM PackMargin parseUnqt+                      ]++-- -----------------------------------------------------------------------------++data PackMode = PackNode+              | PackClust+              | PackGraph+              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort+                                                -- by user, number of+                                                -- rows/cols+                deriving (Eq, 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 (not . isDigit)+                           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++-- -----------------------------------------------------------------------------++data Pos = PointPos Point+         | SplinePos [Spline]+           deriving (Eq, 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+    parseUnqt = oneOf [ liftM PointPos parseUnqt+                      , liftM SplinePos parseUnqt+                      ]++    parse = quotedParse parseUnqt++-- -----------------------------------------------------------------------------++-- | Controls how (and if) edges are represented.+data EdgeType = SplineEdges+              | LineEdges+              | NoEdges+              | PolyLine+              | CompoundEdge -- ^ fdp only+                deriving (Eq, 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 = doubleQuotes empty+    toDot et      = unqtDot et++instance ParseDot EdgeType where+    -- Can't parse NoEdges without quotes.+    parseUnqt = oneOf [ liftM (bool SplineEdges LineEdges) 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, 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 = oneOf [ stringRep Bl "BL"+                      , stringRep Br "BR"+                      , stringRep Tl "TL"+                      , stringRep Tr "TR"+                      , stringRep Rb "RB"+                      , stringRep Rt "RT"+                      , stringRep Lb "LB"+                      , stringRep 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, Show, Read)++instance PrintDot Spline where+    unqtDot (Spline ms me ps) = addS . addE+                               . hsep+                               $ map unqtDot ps+        where+          addP t = maybe id ((<>) . commaDel t)+          addS = addP 's' ms+          addE = addP 'e' me++    toDot = doubleQuotes . unqtDot++    unqtListToDot = hsep . punctuate semi . map unqtDot++    listToDot = doubleQuotes . unqtListToDot++instance ParseDot Spline where+    parseUnqt = do ms <- parseP 's'+                   whitespace+                   me <- parseP 'e'+                   whitespace+                   ps <- sepBy1 parseUnqt whitespace+                   return $ Spline ms me ps+        where+          parseP t = optional $ do character t+                                   character ';'+                                   parse++    parse = quotedParse parseUnqt++    parseUnqtList = sepBy1 parseUnqt (character ';')++-- -----------------------------------------------------------------------------++data QuadType = NormalQT+              | FastQT+              | NoQT+                deriving (Eq, 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 NormalQT NoQT) 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 String -- ^ For Graphs only+            deriving (Eq, 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 IsCentral NotCentral) parse+                `onFail`+                liftM NodeName parse++-- -----------------------------------------------------------------------------++data RankType = SameRank+              | MinRank+              | SourceRank+              | MaxRank+              | SinkRank+                deriving (Eq, 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 = oneOf [ stringRep SameRank "same"+                      , stringRep MinRank "min"+                      , stringRep SourceRank "source"+                      , stringRep MaxRank "max"+                      , stringRep SinkRank "sink"+                      ]++-- -----------------------------------------------------------------------------++data RankDir = FromTop+             | FromLeft+             | FromBottom+             | FromRight+               deriving (Eq, 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+    | Polygon+    | Ellipse+    | Circle+    | PointShape+    | Egg+    | Triangle+    | Plaintext+    | DiamondShape+    | Trapezium+    | Parallelogram+    | House+    | Pentagon+    | Hexagon+    | Septagon+    | Octagon+    | Doublecircle+    | Doubleoctagon+    | Tripleoctagon+    | Invtriangle+    | Invtrapezium+    | Invhouse+    | Mdiamond+    | Msquare+    | Mcircle+    | Rectangle+    | NoShape+    | Note+    | Tab+    | Folder+    | Box3d+    | Component+      deriving (Eq, 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 Rectangle     = text "rectangle"+    unqtDot NoShape       = text "none"+    unqtDot Note          = text "note"+    unqtDot Tab           = text "tab"+    unqtDot Folder        = text "folder"+    unqtDot Box3d         = text "box3d"+    unqtDot Component     = text "component"++instance ParseDot Shape where+    parseUnqt = oneOf [ stringRep BoxShape "box"+                      , stringRep Polygon "polygon"+                      , stringRep Ellipse "ellipse"+                      , stringRep Circle "circle"+                      , stringRep PointShape "point"+                      , stringRep Egg "egg"+                      , stringRep Triangle "triangle"+                      , stringRep Plaintext "plaintext"+                      , stringRep DiamondShape "diamond"+                      , stringRep Trapezium "trapezium"+                      , stringRep Parallelogram "parallelogram"+                      , stringRep House "house"+                      , stringRep Pentagon "pentagon"+                      , stringRep Hexagon "hexagon"+                      , stringRep Septagon "septagon"+                      , stringRep Octagon "octagon"+                      , stringRep Doublecircle "doublecircle"+                      , stringRep Doubleoctagon "doubleoctagon"+                      , stringRep Tripleoctagon "tripleoctagon"+                      , stringRep Invtriangle "invtriangle"+                      , stringRep Invtrapezium "invtrapezium"+                      , stringRep Invhouse "invhouse"+                      , stringRep Mdiamond "Mdiamond"+                      , stringRep Msquare "Msquare"+                      , stringRep Mcircle "Mcircle"+                      , stringRep Rectangle "rectangle"+                      , stringRep NoShape "none"+                      , stringRep Note "note"+                      , stringRep Tab "tab"+                      , stringRep Folder "folder"+                      , stringRep Box3d "box3d"+                      , stringRep Component "component"+                      ]++-- -----------------------------------------------------------------------------++data SmoothType = NoSmooth+                | AvgDist+                | GraphDist+                | PowerDist+                | RNG+                | Spring+                | TriangleSmooth+                  deriving (Eq, 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"+                      ]++-- -----------------------------------------------------------------------------++-- | It is assumed that at least one of these is @Just{}@.+data StartType = StartStyle STStyle+               | StartSeed Int+               | StartStyleSeed STStyle Int+                 deriving (Eq, 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, 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"+                      ]++-- -----------------------------------------------------------------------------++data StyleItem = SItem StyleName [String]+             deriving (Eq, 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 $ map unqtDot args++    toDot si@(SItem nm args)+        | null args = toDot nm+        | otherwise = doubleQuotes $ unqtDot si++    unqtListToDot = hcat . punctuate comma . map unqtDot++    listToDot [SItem nm []] = toDot nm+    listToDot sis           = doubleQuotes $ unqtListToDot sis++instance ParseDot StyleItem where+    parseUnqt = do nm <- parseUnqt+                   args <- tryParseList' parseArgs+                   return $ SItem nm args+        where+          parseArgs = bracketSep (character '(')+                                 parseComma+                                 (character ')')+                                 parseStyleName++    -- Ignore quotations for the DD case atm, since I'm not sure how+    -- to deal with it.++    parseUnqtList = sepBy1 parseUnqt parseComma++    -- Might not necessarily need to be quoted if a singleton...+    parseList = liftM return parse+                `onFail`+                parseUnqtList++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+               | DD String -- ^ Device Dependent+                 deriving (Eq, Show, Read)++instance PrintDot StyleName where+    unqtDot Filled    = text "filled"+    unqtDot Invisible = text "invis"+    unqtDot Diagonals = text "diagonals"+    unqtDot Rounded   = text "rounded"+    unqtDot Dashed    = text "dashed"+    unqtDot Dotted    = text "dotted"+    unqtDot Solid     = text "solid"+    unqtDot Bold      = text "bold"+    unqtDot (DD nm)   = unqtDot nm++    toDot (DD nm) = toDot nm+    toDot sn      = unqtDot sn++instance ParseDot StyleName where+    parseUnqt = oneOf [ stringRep Filled "filled"+                      , stringRep Invisible "invis"+                      , stringRep Diagonals "diagonals"+                      , stringRep Rounded "rounded"+                      , stringRep Dashed "dashed"+                      , stringRep Dotted "dotted"+                      , stringRep Solid "solid"+                      , stringRep Bold "bold"+                      , liftM DD parseStyleName+                      ]++    -- Never used on its own, so not bothering with a separate parse+    -- implementation (which is iffy due to the DD case).++parseStyleName :: Parse String+parseStyleName = do f <- noneOf ['(', ')', ',', ' ']+                    r <- many (noneOf ['(', ')', ','])+                    return $ f:r++-- -----------------------------------------------------------------------------++newtype PortPos = PP CompassPoint+    deriving (Eq, Show, Read)++instance PrintDot PortPos where+    unqtDot (PP cp) = unqtDot cp++    toDot (PP cp) = toDot cp++instance ParseDot PortPos where+    parseUnqt = liftM PP parseUnqt++data CompassPoint = North+                  | NorthEast+                  | East+                  | SouthEast+                  | South+                  | SouthWest+                  | West+                  | NorthWest+                  | CenterPoint+                  | NoCP+                    deriving (Eq, Show, Read)++instance PrintDot CompassPoint where+    unqtDot NorthEast   = text "ne"+    unqtDot NorthWest   = text "nw"+    unqtDot North       = text "n"+    unqtDot East        = text "e"+    unqtDot SouthEast   = text "se"+    unqtDot SouthWest   = text "sw"+    unqtDot South       = text "s"+    unqtDot West        = text "w"+    unqtDot CenterPoint = text "c"+    unqtDot NoCP        = text "_"++instance ParseDot CompassPoint where+    parseUnqt = oneOf [ stringRep North "n"+                      , stringRep NorthEast "ne"+                      , stringRep East "e"+                      , stringRep SouthEast "se"+                      , stringRep South "s"+                      , stringRep SouthWest "sw"+                      , stringRep West "w"+                      , stringRep NorthWest "nw"+                      , stringRep CenterPoint "c"+                      , stringRep NoCP "_"+                      ]++-- -----------------------------------------------------------------------------++data ViewPort = VP { wVal  :: Double+                   , hVal  :: Double+                   , zVal  :: Double+                   , focus :: Maybe FocusType+                   }+                deriving (Eq, Show, Read)++instance PrintDot ViewPort where+    unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)+                 $ focus vp+        where+          vs = hcat . punctuate comma+               $ map (unqtDot . flip ($) vp) [wVal, hVal, zVal]++    toDot = doubleQuotes . 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++data FocusType = XY Point+               | NodeFocus String+                 deriving (Eq, 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 stringBlock++-- -----------------------------------------------------------------------------++data VerticalPlacement = VTop+                       | VCenter -- ^ Only valid for Nodes.+                       | VBottom+                         deriving (Eq, 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"+                      ]++-- -----------------------------------------------------------------------------++data ScaleType = UniformScale+               | NoScale+               | FillWidth+               | FillHeight+               | FillBoth+                 deriving (Eq, 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, 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, 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"+                      ]

@@ -33,6 +33,7 @@ import Control.Exception.Extensible  import Data.GraphViz.Types+import Data.GraphViz.Types.Printing  -- | The available Graphviz commands. data GraphvizCommand = Dot | Neato | TwoPi | Circo | Fdp@@ -53,7 +54,7 @@ undirCommand = Neato  -- | The appropriate (default) GraphViz command for the given graph.-commandFor    :: DotGraph -> GraphvizCommand+commandFor    :: DotGraph a -> GraphvizCommand commandFor dg = if (directedGraph dg)                 then dirCommand                 else undirCommand@@ -149,14 +150,15 @@ -- | Run the recommended Graphviz command on this graph, saving the result --   to the file provided (note: file extensions are /not/ checked). --   Returns @True@ if successful, @False@ otherwise.-runGraphviz         :: DotGraph -> GraphvizOutput -> FilePath -> IO Bool+runGraphviz         :: (PrintDot n) => DotGraph n -> GraphvizOutput -> FilePath+                       -> IO Bool runGraphviz gr t fp = runGraphvizCommand (commandFor gr) gr t fp  -- | Run the chosen Graphviz command on this graph, saving the result --   to the file provided (note: file extensions are /not/ checked). --   Returns @True@ if successful, @False@ otherwise.-runGraphvizCommand :: GraphvizCommand -> DotGraph -> GraphvizOutput-                   -> FilePath -> IO Bool+runGraphvizCommand :: (PrintDot n) => GraphvizCommand -> DotGraph n+                      -> GraphvizOutput -> FilePath -> IO Bool runGraphvizCommand  cmd gr t fp     = do pipe <- tryJust (\(SomeException _) -> return ())                  $ openFile fp WriteMode@@ -174,11 +176,11 @@ -- | Run the chosen Graphviz command on this graph, but send the result to the --   given handle rather than to a file. --   The result is wrapped in 'Maybe' rather than throwing an error.-graphvizWithHandle :: (Show a) => GraphvizCommand -> DotGraph -> GraphvizOutput-                      -> (Handle -> IO a) -> IO (Maybe a)+graphvizWithHandle :: (PrintDot n, Show a) => GraphvizCommand -> DotGraph n+                      -> GraphvizOutput -> (Handle -> IO a) -> IO (Maybe a) graphvizWithHandle cmd gr t f     = do (inp, outp, errp, prc) <- runInteractiveCommand command-         forkIO $ hPrint inp gr >> hClose inp+         forkIO $ hPutStrLn inp (printDotGraph gr) >> hClose inp          forkIO $ (hGetContents errp >>= hPutStr stderr >> hClose errp)          a <- f outp          -- Don't close outp until f finishes.

@@ -1,239 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--{- |-   Module      : Data.GraphViz.ParserCombinators-   Description : Helper functions for Parsing.-   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines simple helper functions for use with-   "Text.ParserCombinators.Poly.Lazy".--   Note that the 'Parseable' instances for 'Bool', etc. match those-   specified for use with GraphViz (e.g. non-zero integers are-   equivalent to 'True').--   You should not be using this module; rather, it is here for-   informative/documentative reasons.  If you want to parse a-   @'Data.GraphViz.Types.DotGraph'@, you should use-   @'Data.GraphViz.Types.parseDotGraph'@ rather than its 'Parseable'-   instance.---}--module Data.GraphViz.ParserCombinators-    ( module Text.ParserCombinators.Poly.Lazy-    , Parse-    , Parseable(..)-    , stringBlock-    , quotedString-    , parseAndSpace-    , string-    , strings-    , hasString-    , char-    , whitespace-    , whitespace'-    , optionalQuotedString-    , optionalQuoted-    , quotedParse-    , newline-    , skipToNewline-    , parseField-    , parseBoolField-    , parseFieldDef-    , commaSep-    , commaSep'-    ) where--import Text.ParserCombinators.Poly.Lazy-import Data.Char( digitToInt-                , isAsciiLower-                , isAsciiUpper-                , isDigit-                , isSpace-                , toLower-                )-import Data.Function(on)-import Data.Maybe(isJust)-import Data.Ratio((%))-import Control.Monad---- -------------------------------------------------------------------------------- Based off code from Text.Parse in the polyparse library---- | A @ReadS@-like type alias.-type Parse a = Parser Char a--class Parseable a where-    parse :: Parse a--    parseList :: Parse [a]-    parseList = oneOf [ char '[' >> whitespace' >> char ']' >> return []-                      , bracketSep (parseAndSpace $ char '[')-                                   (parseAndSpace $ char ',')-                                   (parseAndSpace $ char ']')-                                   (parseAndSpace parse)-                      ]--instance Parseable Int where-    parse = parseInt--instance Parseable Double where-    parse = parseSigned parseFloat--instance Parseable Bool where-    parse = oneOf [ string "true" >> return True-                  , string "false" >> return False-                  , liftM (zero /=) parseInt-                  ]-        where-          zero :: Int-          zero = 0--instance Parseable Char where-    parse = next--    parseList = oneOf [ stringBlock-                      , quotedString-                      ]---- | Used when quotes are explicitly required;---   note that the quotes are not stripped off.--instance (Parseable a) => Parseable [a] where-    parse = parseList--stringBlock :: Parse String-stringBlock = do frst <- satisfy frstCond-                 rest <- many (satisfy restCond)-                 return $ frst : rest-    where-      frstCond c = any ($c) [ isAsciiUpper-                            , isAsciiLower-                            , (==) '_'-                            , \ x -> x >= '\200' && x <= '\377'-                            ]-      restCond c = frstCond c || isDigit c--quotedString :: Parse String-quotedString = do w <- word-                  if head w == '"'-                     then return w-                     else fail $ "Not a quoted string: " ++ w--word :: Parse String-word = P (\s-> case lex s of-                   []         -> Failure s  "no input? (impossible)"-                   [("","")]  -> Failure "" "no input?"-                   [("",s')]  -> Failure s' "lexing failed?"-                   ((x,s'):_) -> Success s' x-         )--parseSigned :: Real a => Parse a -> Parse a-parseSigned p = do '-' <- next; commit (fmap negate p)-                `onFail`-                p--parseInt :: (Integral a) => Parse a-parseInt = do cs <- many1 (satisfy isDigit)-              return (foldl1 (\n d-> n*radix+d)-                                   (map (fromIntegral . digitToInt) cs))-           `adjustErr` (++ "\nexpected one or more digits")-    where-      radix = 10--parseFloat :: (RealFrac a) => Parse a-parseFloat = do ds   <- many1 (satisfy isDigit)-                frac <- (do '.' <- next-                            many (satisfy isDigit)-                              `adjustErrBad` (++"expected digit after .")-                         `onFail` return [] )-                expn  <- parseExp `onFail` return 0-                ( return . fromRational . (* (10^^(expn - length frac)))-                  . (%1) . fst-                  . runParser parseInt) (ds++frac)-             `onFail`-             do w <- many (satisfy (not.isSpace))-                case map toLower w of-                  "nan"      -> return (0/0)-                  "infinity" -> return (1/0)-                  _          -> fail "expected a floating point number"-  where parseExp = do 'e' <- fmap toLower next-                      commit (do '+' <- next; parseInt-                              `onFail`-                              parseSigned parseInt)---- -------------------------------------------------------------------------------parseAndSpace   :: Parse a -> Parse a-parseAndSpace p = p `discard` whitespace'--string :: String -> Parse String-string = mapM char--strings :: [String] -> Parse String-strings = oneOf . map string--hasString :: String -> Parse Bool-hasString = liftM isJust . optional . string--char   :: Char -> Parse Char-char c = satisfy (((==) `on` toLower) c)-         `adjustErr`-         (++ "\nnot the expected char: " ++ [c])--noneOf :: (Eq a) => [a] -> Parser a a-noneOf t = satisfy (\x -> all (/= x) t)--whitespace :: Parse String-whitespace = many1 (satisfy isSpace)--whitespace' :: Parse String-whitespace' = many (satisfy isSpace)--optionalQuotedString :: String -> Parse String-optionalQuotedString = optionalQuoted . string--optionalQuoted   :: Parse a -> Parse a-optionalQuoted p = oneOf [ p-                         , quotedParse p-                         ]--quotedParse   :: Parse a -> Parse a-quotedParse p = char '"' >> p `discard` char '"'--newline :: Parse String-newline = oneOf . map string $ ["\r\n", "\n", "\r"]--skipToNewline :: Parse ()-skipToNewline = many (noneOf ['\n','\r']) >> newline >> return ()--parseField     :: (Parseable a) => String -> Parse a-parseField fld = do string fld-                    whitespace'-                    char '='-                    whitespace'-                    parse--parseBoolField :: String -> Parse Bool-parseBoolField = parseFieldDef True---- | For 'Bool'-like data structures where the presence of the field--- name without a value implies a default value.-parseFieldDef       :: (Parseable a) => a -> String -> Parse a-parseFieldDef d fld = oneOf [ parseField fld-                            , string fld >> return d-                            ]--commaSep :: (Parseable a, Parseable b) => Parse (a, b)-commaSep = commaSep' parse parse--commaSep'       :: Parse a -> Parse b -> Parse (a,b)-commaSep' pa pb = do a <- pa-                     whitespace'-                     char ','-                     whitespace'-                     b <- pb-                     return (a,b)

@@ -9,246 +9,599 @@    with them for the GraphViz library.  The specifications are based    loosely upon the information available at:      <http://graphviz.org/doc/info/lang.html>--} +   Printing of /Dot/ code is done as strictly as possible, whilst+   parsing is as permissive as possible.  For example, if the types+   allow it then @\"2\"@ will be parsed as an 'Int' value.  Note that+   quoting and escaping of 'String' values is done automagically.++   A summary of known limitations\/differences:++   * When creating 'GraphID' values for 'graphID' and 'subGraphID',+     you should ensure that none of them have the same printed value+     as one of the 'nodeID' values to avoid any possible problems.++   * Whilst 'DotGraph', etc. are polymorphic in their node type, you+     should ensure that you use a relatively simple node type (that+     is, it only covers a single line, etc.).++   * Also, whilst GraphViz allows you to mix the types used for nodes,+     this library requires\/assumes that they are all the same type.++   * 'DotEdge' defines an edge @(a, b)@ (with an edge going from @a@+     to @b@); in /Dot/ parlance the edge has a head at @a@ and a tail+     at @b@.  Care must be taken when using the related @Head*@ and+     @Tail*@ 'Attribute's.  See the differences section in+     "Data.GraphViz.Attributes" for more information.++   * It is common to see multiple edges defined on the one line in Dot+     (e.g. @n1 -> n2 -> n3@ means to create a directed edge from @n1@+     to @n2@ and from @n2@ to @n3@).  These types of edge definitions+     are parseable; however, they are converted to singleton edges.++   * Cannot create edges with subgraphs\/clusters as one of the+     end points.++   * When either creating a 'DotGraph' by hand or parsing one, it is+     possible to specify that @'directedGraph' = d@, but at lease one+     'DotEdge' has @'directedEdge' = 'not' d@.++   * Nodes cannot have Port values.++   * Cannot place items in an arbitrary order: in particular, this+     means that it is not possible to use the normal GraphViz hack of+     having graph attributes that do not apply to subgraphs\/clusters+     by listing them /after/ the subgraphs\/clusters.++   * The parser cannot as yet parse comments (in that it doesn't even+     know what comments are, and will throw an error).  Multiline+     statements and C pre-processor lines (that is, lines beginning+     with a @#@) are also not parseable.++   See "Data.GraphViz.Attributes" for more limitations.++-} module Data.GraphViz.Types-    ( DotGraph(..)-    , GraphID(..)-    , DotNode(..)-    , DotEdge(..)+    ( -- * The overall representation of a graph in /Dot/ format.+      DotGraph(..)+      -- ** Printing and parsing a @DotGraph@.+    , printDotGraph     , parseDotGraph+      -- ** Functions acting on a @DotGraph@.     , setID     , makeStrict+    , graphNodes+    , graphEdges+      -- ** Reporting of errors in a @DotGraph@.+    , DotError(..)     , isValidGraph-    , invalidAttributes+    , graphErrors+      -- * Sub-components of a @DotGraph@.+    , GraphID(..)+    , DotStatements(..)+    , GlobalAttributes(..)+    , DotSubGraph(..)+    , DotNode(..)+    , DotEdge(..)     ) where  import Data.GraphViz.Attributes-import Data.GraphViz.ParserCombinators+import Data.GraphViz.Types.Internal+import Data.GraphViz.Types.Parsing+import Data.GraphViz.Types.Printing -import Data.Maybe-import Control.Monad+import Data.Maybe(isJust)+import Control.Monad(liftM)  -- -----------------------------------------------------------------------------  -- | The internal representation of a graph in Dot form.-data DotGraph = DotGraph { strictGraph     :: Bool-                         , directedGraph   :: Bool-                         , graphID         :: Maybe GraphID-                         , graphAttributes :: [Attribute]-                         , graphNodes      :: [DotNode]-                         , graphEdges      :: [DotEdge]-                         }-                deriving (Eq, Read)+data DotGraph a = DotGraph { strictGraph     :: Bool  -- ^ If 'True', no multiple edges are drawn.+                           , directedGraph   :: Bool+                           , graphID         :: Maybe GraphID+                           , graphStatements :: DotStatements a+                           }+                  deriving (Eq, Show, Read)  -- | A strict graph disallows multiple edges.-makeStrict   :: DotGraph -> DotGraph+makeStrict   :: DotGraph a -> DotGraph a makeStrict g = g { strictGraph = True } -setID     :: GraphID -> DotGraph -> DotGraph+-- | Set the ID of the graph.+setID     :: GraphID -> DotGraph a -> DotGraph a setID i g = g { graphID = Just i } --- | Check if all the @Attribute@s are being used correctly.-isValidGraph   :: DotGraph -> Bool-isValidGraph g = null gas && null nas && null eas-    where-      (gas, nas, eas) = invalidAttributes g+-- | Return all the 'DotNode's contained within this 'DotGraph'.  Note+--   that it does not yet return all implicitly defined nodes+--   contained only within 'DotEdge's.+graphNodes :: DotGraph a -> [DotNode a]+graphNodes = statementNodes . graphStatements --- | Return all those @Attribute@s which aren't being used properly.-invalidAttributes   :: DotGraph -> ( [Attribute]-                                   , [(DotNode, Attribute)]-                                   , [(DotEdge, Attribute)]-                                   )-invalidAttributes g = ( invalidGraphAttributes g-                      , concatMap invalidNodeAttributes $ graphNodes g-                      , concatMap invalidEdgeAttributes $ graphEdges g-                      )+-- | Return all the 'DotEdge's contained within this 'DotGraph'.+graphEdges :: DotGraph a -> [DotEdge a]+graphEdges = statementEdges . graphStatements -invalidGraphAttributes :: DotGraph -> [Attribute]-invalidGraphAttributes = filter (not . usedByGraphs) . graphAttributes+-- | The actual /Dot/ code for a 'DotGraph'.  Note that it is expected+--   that @'parseDotGraph' . 'printDotGraph' == 'id'@ (this might not+--   be true the other way around due to un-parseable components).+printDotGraph :: (PrintDot a) => DotGraph a -> String+printDotGraph = renderDot . toDot -instance Show DotGraph where-    show g-        = unlines $ (hdr ++ " {") : (rest ++ ["}"])-        where-          hdr = strct . addId $ gType-          strct = if strictGraph g-                  then ("strict " ++)-                  else id-          addId = maybe id (\ i -> flip (++) $ ' ' : show i) $ graphID g-          gType = if directedGraph g then dirGraph else undirGraph-          rest = case graphAttributes g of-                   [] -> nodesEdges-                   a -> ("\tgraph " ++ show a ++ ";") : nodesEdges-          nodesEdges = map show (graphNodes g) ++ map show (graphEdges g)+-- | Parse a limited subset of the Dot language to form a 'DotGraph'+--   (that is, the caveats listed in "Data.GraphViz.Attributes" aside,+--   Dot graphs are parsed if they match the layout of 'DotGraph').+parseDotGraph :: (ParseDot a) => String -> DotGraph a+parseDotGraph = fst . runParser parse +-- | Check if all the 'Attribute's are being used correctly.+isValidGraph :: DotGraph a -> Bool+isValidGraph = null . graphErrors++-- | Return detectable errors in the 'DotGraph'.+graphErrors :: DotGraph a -> [DotError a]+graphErrors = invalidStmts usedByGraphs . graphStatements++instance (PrintDot a) => PrintDot (DotGraph a) where+    unqtDot = printStmtBased printGraphID graphStatements++printGraphID   :: (PrintDot a) => DotGraph a -> DotCode+printGraphID g = bool strGraph' empty (strictGraph g)+                 <+> bool dirGraph' undirGraph' (directedGraph g)+                 <+> maybe empty toDot (graphID g)++instance (ParseDot a) => ParseDot (DotGraph a) where+    parseUnqt = parseStmtBased parseGraphID++    parse = parseUnqt -- Don't want the option of quoting+            `adjustErr`+            (++ "\n\nNot a valid DotGraph")++parseGraphID :: (ParseDot a) => Parse (DotStatements a -> DotGraph a)+parseGraphID = do str <- liftM isJust+                         $ optional (parseAndSpace $ string strGraph)+                  dir <- parseAndSpace ( stringRep True dirGraph+                                         `onFail`+                                         stringRep False undirGraph+                                       )+                  gID <- optional parse+                  return $ DotGraph str dir gID+ dirGraph :: String dirGraph = "digraph" +dirGraph' :: DotCode+dirGraph' = text dirGraph+ undirGraph :: String undirGraph = "graph" --- | Parse a limited subset of the Dot language to form a 'DotGraph'---   (that is, the caveats listed in "Data.GraphViz.Attributes" aside,---   Dot graphs are parsed if they match the layout of DotGraph).-parseDotGraph :: Parse DotGraph-parseDotGraph = parse+undirGraph' :: DotCode+undirGraph' = text undirGraph -instance Parseable DotGraph where-    parse = do isStrict <- parseAndSpace $ hasString "strict"-               gType <- strings [dirGraph,undirGraph]-               gId <- optional (parse `discard` whitespace)-               whitespace-               char '{'-               skipToNewline-               as <- liftM concat $-                     many (whitespace' >>-                           oneOf [ string "edge" >> skipToNewline >> return []-                                 , string "node" >> skipToNewline >> return []-                                 , string "graph" >> whitespace-                                              >> parse `discard` skipToNewline-                                 ]-                          )-               ns <- many1 (whitespace' >> parse `discard` skipToNewline)-               es <- many1 (whitespace' >> parse `discard` skipToNewline)-               char '}'-               return DotGraph { strictGraph = isStrict-                               , directedGraph = gType == dirGraph-                               , graphID = gId-                               , graphAttributes = as-                               , graphNodes = ns-                               , graphEdges = es-                               }+strGraph :: String+strGraph = "strict" -            `adjustErr`-            (++ "\nNot a valid DotGraph")+strGraph' :: DotCode+strGraph' = text strGraph +instance Functor DotGraph where+    fmap f g = g { graphStatements = fmap f $ graphStatements g }+ -- ----------------------------------------------------------------------------- +-- | Used to record invalid 'Attribute' usage.  A 'Just' value denotes+--   that it was used in an explicit 'DotNode' or 'DotEdge' usage;+--   'Nothing' means that it was used in a 'GlobalAttributes' value.+data DotError a = GraphError Attribute+                | NodeError (Maybe a) Attribute+                | EdgeError (Maybe (a,a)) Attribute+                deriving (Eq, Show, Read)++-- -----------------------------------------------------------------------------++-- | 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 String-             | Num Double-             | QStr QuotedString+             | Int Int+             | Dbl Double              | HTML URL-               deriving (Eq, Read)+               deriving (Eq, Show, Read) -instance Show GraphID where-    show (Str str)  = str-    show (Num n)    = show n-    show (QStr str) = show str-    show (HTML url) = show url+instance PrintDot GraphID where+    unqtDot (Str str) = unqtDot str+    unqtDot (Int i)   = unqtDot i+    unqtDot (Dbl d)   = unqtDot d+    unqtDot (HTML u)  = unqtDot u -instance Parseable GraphID where-    parse = oneOf [ liftM Str stringBlock-                  , liftM Num parse-                  , liftM QStr parse+    toDot (Str str) = toDot str+    toDot gID       = unqtDot gID++instance ParseDot GraphID where+    parseUnqt = oneOf [ liftM Str  parseUnqt+                      , liftM Int  parseUnqt+                      , liftM Dbl  parseUnqt+                      , liftM HTML parseUnqt+                      ]++    parse = oneOf [ liftM Int  parse+                  , liftM Dbl  parse                   , liftM HTML parse+                  -- Parse last so that quoted numbers are parsed as numbers.+                  , liftM Str  parse                   ]             `adjustErr`-            (++ "\nNot a valid GraphID")+            (++ "Not a valid GraphID")  -- ----------------------------------------------------------------------------- --- | A node in 'DotGraph' is either a singular node, or a cluster---   containing nodes (or more clusters) within it.---   At the moment, clusters are not parsed.-data DotNode-    = DotNode { nodeID :: Int-              , nodeAttributes :: [Attribute]-              }-    | DotCluster { clusterID         :: String-                 , clusterAttributes :: [Attribute]-                 , clusterElems      :: [DotNode]-                 }-      deriving (Eq, Read)+data DotStatements a = DotStmts { attrStmts :: [GlobalAttributes]+                                , subGraphs :: [DotSubGraph a]+                                , nodeStmts :: [DotNode a]+                                , edgeStmts :: [DotEdge a]+                                }+                     deriving (Eq, Show, Read) -invalidNodeAttributes                :: DotNode -> [(DotNode, Attribute)]-invalidNodeAttributes n@DotNode{}    = map ((,) n)-                                       . filter (not . usedByNodes)-                                       $ nodeAttributes n-invalidNodeAttributes c@DotCluster{} = cErr ++ nErr+instance (PrintDot a) => PrintDot (DotStatements a) where+    unqtDot stmts = vcat [ toDot $ attrStmts stmts+                         , toDot $ subGraphs stmts+                         , toDot $ nodeStmts stmts+                         , toDot $ edgeStmts stmts+                         ]++instance (ParseDot a) => ParseDot (DotStatements a) where+    parseUnqt = do atts <- tryParseList+                   newline'+                   sGraphs <- tryParseList+                   newline'+                   nodes <- tryParseList+                   newline'+                   edges <- tryParseList+                   return $ DotStmts atts sGraphs nodes edges++    parse = parseUnqt -- Don't want the option of quoting+            `adjustErr`+            (++ "Not a valid set of statements")++instance Functor DotStatements where+    fmap f stmts = stmts { subGraphs = map (fmap f) $ subGraphs stmts+                         , nodeStmts = map (fmap f) $ nodeStmts stmts+                         , edgeStmts = map (fmap f) $ edgeStmts stmts+                         }++printStmtBased          :: (PrintDot n) => (a -> DotCode)+                           -> (a -> DotStatements n) -> a -> DotCode+printStmtBased ff fss a = vcat [ ff a <+> lbrace+                               , ind stmts+                               , rbrace+                               ]     where-      cErr = map ((,) c) . filter (not . usedByClusters)-             $ clusterAttributes c-      nErr = concatMap invalidNodeAttributes $ clusterElems c+      ind = nest 4+      stmts = toDot $ fss a -instance Show DotNode where-    show = init . unlines . addTabs . nodesToString+printStmtBasedList        :: (PrintDot n) => (a -> DotCode)+                             -> (a -> DotStatements n) -> [a] -> DotCode+printStmtBasedList ff fss = vcat . map (printStmtBased ff fss) -nodesToString :: DotNode -> [String]-nodesToString n@(DotNode {})-    | null nAs  = [nID ++ ";"]-    | otherwise = [nID ++ (' ':(show nAs ++ ";"))]+parseStmtBased   :: (ParseDot n) => Parse (DotStatements n -> a) -> Parse a+parseStmtBased p = do f <- p+                      whitespace'+                      character '{'+                      newline'+                      stmts <- parse+                      newline'+                      whitespace'+                      character '}'+                      return $ f stmts+                   `adjustErr`+                   (++ "\n\nNot a valid statement-based structure")++parseStmtBasedList   :: (ParseDot n) => Parse (DotStatements n -> a)+                        -> Parse [a]+parseStmtBasedList p = sepBy (whitespace' >> parseStmtBased p) newline'++-- | The function represents which function to use to check the+--   'GraphAttrs' values.+invalidStmts         :: (Attribute -> Bool) -> DotStatements a -> [DotError a]+invalidStmts f stmts = concatMap (invalidGlobal f) (attrStmts stmts)+                       ++ concatMap invalidSubGraph (subGraphs stmts)+                       ++ concatMap invalidNode (nodeStmts stmts)+                       ++ concatMap invalidEdge (edgeStmts stmts)++statementNodes       :: DotStatements a -> [DotNode a]+statementNodes stmts = concatMap subGraphNodes (subGraphs stmts)+                       ++ nodeStmts stmts++statementEdges       :: DotStatements a -> [DotEdge a]+statementEdges stmts = concatMap subGraphEdges (subGraphs stmts)+                       ++ edgeStmts stmts++-- -----------------------------------------------------------------------------++-- | 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 listen 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, Show, Read)++instance PrintDot GlobalAttributes where+    unqtDot = printAttrBased printGlobAttrType attrs++    unqtListToDot = printAttrBasedList printGlobAttrType attrs++    listToDot = unqtListToDot++printGlobAttrType              :: GlobalAttributes -> DotCode+printGlobAttrType GraphAttrs{} = text "graph"+printGlobAttrType NodeAttrs{}  = text "node"+printGlobAttrType EdgeAttrs{}  = text "edge"++instance ParseDot GlobalAttributes where+    parseUnqt = parseAttrBased parseGlobAttrType+                `onFail`+                liftM determineType parse `discard` optional lineEnd++    parse = parseUnqt -- Don't want the option of quoting+            `adjustErr`+            (++ "\n\nNot a valid listing of global attributes")++    -- Have to do this manually because of the special case+    parseUnqtList = sepBy (whitespace' >> parse) newline'++    parseList = parseUnqtList++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-      nID = show $ nodeID n-      nAs = nodeAttributes n-nodesToString c@(DotCluster {})-    = ["subgraph cluster_" ++ clusterID c ++ " {"] ++ addTabs inner ++ ["}"]+      attr' = [attr]++invalidGlobal                   :: (Attribute -> Bool) -> GlobalAttributes+                                   -> [DotError a]+invalidGlobal f (GraphAttrs as) = map GraphError $ filter (not . f) as+invalidGlobal _ (NodeAttrs  as) = map (NodeError Nothing)+                                  $ filter (not . usedByNodes) as+invalidGlobal _ (EdgeAttrs  as) = map (EdgeError Nothing)+                                  $ filter (not . usedByEdges) as++-- -----------------------------------------------------------------------------++data DotSubGraph a = DotSG { isCluster     :: Bool+                           , subGraphID    :: Maybe GraphID+                           , subGraphStmts :: DotStatements a+                           }+                   deriving (Eq, Show, Read)++instance (PrintDot a) => PrintDot (DotSubGraph a) where+    unqtDot = printStmtBased printSubGraphID subGraphStmts++    unqtListToDot = printStmtBasedList printSubGraphID subGraphStmts++    listToDot = unqtListToDot++printSubGraphID   :: DotSubGraph a -> DotCode+printSubGraphID s = sGraph'+                    <+> bool clust' empty isCl+                    <> maybe empty dtID (subGraphID s)     where-      inner = case clusterAttributes c of-                [] -> nodes-                a  -> ("graph " ++ show a ++ ";") : nodes-      nodes = concatMap nodesToString $ clusterElems c+      isCl = isCluster s+      dtID sId = bool (char '_') space isCl+                 <> toDot sId +instance (ParseDot a) => ParseDot (DotSubGraph a) where+    parseUnqt = parseStmtBased parseSubGraphID -instance Parseable DotNode where-    parse = do nId <- parse-               as <- optional (whitespace >> parse)-               char ';'-               return DotNode { nodeID = nId-                              , nodeAttributes = fromMaybe [] as }+    parse = parseUnqt -- Don't want the option of quoting             `adjustErr`-            (++ "\nNot a valid DotNode")+            (++ "\n\nNot a valid Sub Graph") --- | Prefix each 'String' with a tab character.-addTabs :: [String] -> [String]-addTabs = map ('\t':)+    parseUnqtList = parseStmtBasedList parseSubGraphID +    parseList = parseUnqtList++parseSubGraphID :: Parse (DotStatements a -> DotSubGraph a)+parseSubGraphID = do string sGraph+                     whitespace'+                     isCl <- liftM isJust+                             $ optional (string clust)+                               `discard` optional (character '_')+                     sId <- optional parse+                     return $ DotSG isCl sId++sGraph :: String+sGraph = "subgraph"++sGraph' :: DotCode+sGraph' = text sGraph++clust :: String+clust = "cluster"++clust' :: DotCode+clust' = text clust++instance Functor DotSubGraph where+    fmap f sg = sg { subGraphStmts = fmap f $ subGraphStmts sg }++invalidSubGraph    :: DotSubGraph a -> [DotError a]+invalidSubGraph sg = invalidStmts valFunc (subGraphStmts sg)+    where+      valFunc = bool usedByClusters usedBySubGraphs (isCluster sg)++subGraphNodes :: DotSubGraph a -> [DotNode a]+subGraphNodes = statementNodes . subGraphStmts++subGraphEdges :: DotSubGraph a -> [DotEdge a]+subGraphEdges = statementEdges . subGraphStmts+ -- ----------------------------------------------------------------------------- +-- | A node in 'DotGraph' is either a singular node, or a cluster+--   containing nodes (or more clusters) within it.+--   At the moment, clusters are not parsed.+data DotNode a = DotNode { nodeID :: a+                         , nodeAttributes :: Attributes+                         }+                 deriving (Eq, Show, Read)++instance (PrintDot a) => PrintDot (DotNode a) where+    unqtDot = printAttrBased printNodeID nodeAttributes++    unqtListToDot = printAttrBasedList printNodeID nodeAttributes++    listToDot = unqtListToDot++printNodeID :: (PrintDot a) => DotNode a -> DotCode+printNodeID = toDot . nodeID++instance (ParseDot a) => ParseDot (DotNode a) where+    parseUnqt = parseAttrBased parseNodeID++    parse = parseUnqt -- Don't want the option of quoting++    parseUnqtList = parseAttrBasedList parseNodeID++    parseList = parseUnqtList++parseNodeID :: (ParseDot a) => Parse (Attributes -> DotNode a)+parseNodeID = liftM DotNode parse++instance Functor DotNode where+    fmap f n = n { nodeID = f $ nodeID n }++invalidNode   :: DotNode a -> [DotError a]+invalidNode n = map (NodeError (Just $ nodeID n))+                $ filter (not . usedByNodes) (nodeAttributes n)++-- -----------------------------------------------------------------------------+ -- | An edge in 'DotGraph'.-data DotEdge = DotEdge { edgeHeadNodeID :: Int-                       , edgeTailNodeID :: Int-                       , edgeAttributes :: [Attribute]-                       , directedEdge   :: Bool-                       }-             deriving (Eq, Read)+data DotEdge a = DotEdge { edgeFromNodeID :: a+                         , edgeToNodeID   :: a+                         , directedEdge   :: Bool+                         , edgeAttributes :: Attributes+                         }+             deriving (Eq, Show, Read) -invalidEdgeAttributes   :: DotEdge -> [(DotEdge, Attribute)]-invalidEdgeAttributes e = map ((,) e)-                          . filter (not . usedByEdges)-                          $ edgeAttributes e+instance (PrintDot a) => PrintDot (DotEdge a) where+    unqtDot = printAttrBased printEdgeID edgeAttributes -instance Show DotEdge where-    show e-        = '\t' : (show (edgeHeadNodeID e)-                  ++ edge ++ show (edgeTailNodeID e) ++ attributes)-          where-            edge = " " ++ (if directedEdge e then dirEdge else undirEdge) ++ " "-            attributes = case edgeAttributes e of-                           [] -> ";"-                           a  -> ' ':(show a ++ ";")+    unqtListToDot = printAttrBasedList printEdgeID edgeAttributes +    listToDot = unqtListToDot++printEdgeID   :: (PrintDot a) => DotEdge a -> DotCode+printEdgeID e = unqtDot (edgeFromNodeID e)+                <+> bool dirEdge' undirEdge' (directedEdge e)+                <+> unqtDot (edgeToNodeID e)+++instance (ParseDot a) => ParseDot (DotEdge a) where+    parseUnqt = parseAttrBased 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+                    $ sepBy (whitespace' >> parseEdgeLine) newline'++    parseList = parseUnqtList++parseEdgeID :: (ParseDot a) => Parse (Attributes -> DotEdge a)+parseEdgeID = do eHead <- parse+                 whitespace'+                 eType <- parseEdgeType+                 whitespace'+                 eTail <- parse+                 return $ DotEdge eHead eTail eType++parseEdgeType :: Parse Bool+parseEdgeType = stringRep True dirEdge+                `onFail`+                stringRep False undirEdge++parseEdgeLine :: (ParseDot a) => Parse [DotEdge a]+parseEdgeLine = liftM return parse+                `onFail`+                do n1 <- parse+                   ens <- many1 $ do whitespace'+                                     eType <- parseEdgeType+                                     whitespace'+                                     n <- parse+                                     return (eType, n)+                   let ens' = (True, n1) : ens+                       efs = zipWith mkEdg ens' (tail ens')+                       ef = return $ \ as -> map ($as) efs+                   parseAttrBased ef+    where+      mkEdg (_, hn) (et, tn) = DotEdge hn tn et++instance Functor DotEdge where+    fmap f e = e { edgeFromNodeID = f $ edgeFromNodeID e+                 , edgeToNodeID   = f $ edgeToNodeID e+                 }+ dirEdge :: String dirEdge = "->" +dirEdge' :: DotCode+dirEdge' = text dirEdge+ undirEdge :: String undirEdge = "--" -instance Parseable DotEdge where-    parse = do whitespace'-               eHead <- parse-               whitespace-               edgeType <- strings [dirEdge,undirEdge]-               whitespace-               eTail <- parse-               as <- optional (whitespace >> parse)-               char ';'-               return DotEdge { edgeHeadNodeID = eHead-                              , edgeTailNodeID = eTail-                              , edgeAttributes = fromMaybe [] as-                              , directedEdge   = edgeType == dirEdge-                              }-            `adjustErr`-            (++ "\nNot a valid DotEdge")+undirEdge' :: DotCode+undirEdge' = text undirEdge +invalidEdge   :: DotEdge a -> [DotError a]+invalidEdge e = map (EdgeError eID)+                $ filter (not . usedByEdges) (edgeAttributes e)+    where+      eID = Just (edgeFromNodeID e, edgeToNodeID e)+ -- -----------------------------------------------------------------------------++-- Printing and parsing helpers.++printAttrBased          :: (a -> DotCode) -> (a -> Attributes) -> a -> DotCode+printAttrBased ff fas a = dc <> semi+    where+      f = ff a+      dc = case fas a of+             [] -> f+             as -> f <+> toDot as++printAttrBasedList        :: (a -> DotCode) -> (a -> Attributes)+                             -> [a] -> DotCode+printAttrBasedList ff fas = vcat . map (printAttrBased ff fas)++parseAttrBased   :: Parse (Attributes -> a) -> Parse a+parseAttrBased p = do f <- p+                      whitespace'+                      atts <- tryParseList+                      lineEnd+                      return $ f atts+                   `adjustErr`+                   (++ "\n\nNot a valid attribute-based structure")++parseAttrBasedList   :: Parse (Attributes -> a) -> Parse [a]+parseAttrBasedList p = sepBy (whitespace' >> parseAttrBased p) newline'++lineEnd :: Parse ()+lineEnd = whitespace' >> character ';' >> return ()

@@ -9,35 +9,35 @@     This module defines types for creating clusters. -}- module Data.GraphViz.Types.Clustering     ( NodeCluster(..)     , clustersToNodes     ) where --- LT is defined in Attributes-import Prelude hiding (LT)-import qualified Prelude as P- import Data.GraphViz.Types import Data.GraphViz.Attributes -import Data.List(groupBy, sortBy, mapAccumL)-import Data.Graph.Inductive.Graph(Graph, LNode, labNodes)+import Data.Either(partitionEithers)+import Data.List(groupBy, sortBy)+import Data.Graph.Inductive.Graph(Graph, Node, LNode, labNodes)  -- -----------------------------------------------------------------------------  -- | Define into which cluster a particular node belongs.---   Nodes can be nested to arbitrary depth.-data NodeCluster c a = N (LNode a) | C c (NodeCluster c a)+--   Clusters can be nested to arbitrary depth.+data NodeCluster c a = N (LNode a) -- ^ Indicates the actual Node in the Graph.+                     | C c (NodeCluster c a) -- ^ Indicates that the+                                             --   'NodeCluster' is in+                                             --   the Cluster /c/.                         deriving (Show) --- | Create the @'DotNode'@s for the given graph.+-- | Create the /Dot/ representation for the given graph. clustersToNodes :: (Ord c, Graph gr) => (LNode a -> NodeCluster c a)-                   -> (c -> [Attribute]) -> (LNode a -> [Attribute])-                   -> gr a b -> [DotNode]-clustersToNodes clusterBy fmtCluster fmtNode-    = treesToNodes fmtCluster fmtNode+                   -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+                   -> (LNode a -> Attributes) -> gr a b+                   -> ([DotSubGraph Node], [DotNode Node])+clustersToNodes clusterBy cID fmtCluster fmtNode+    = treesToDot cID fmtCluster fmtNode       . collapseNClusts       . map (clustToTree . clusterBy)       . labNodes@@ -45,7 +45,8 @@ -- -----------------------------------------------------------------------------  -- | A tree representation of a cluster.-data ClusterTree c a = NT (LNode a) | CT c [ClusterTree c a]+data ClusterTree c a = NT (LNode a)+                     | CT c [ClusterTree c a]                        deriving (Show)  -- | Convert a single node cluster into its tree representation.@@ -63,7 +64,7 @@ -- | Singleton nodes come first, and then ordering based upon the cluster. clustOrder :: (Ord c) => ClusterTree c a -> ClusterTree c a -> Ordering clustOrder (NT _)    (NT _)    = EQ-clustOrder (NT _)    (CT _ _)  = P.LT -- don't use the attribute LT+clustOrder (NT _)    (CT _ _)  = LT clustOrder (CT _ _)  (NT _)    = GT clustOrder (CT c1 _) (CT c2 _) = compare c1 c2 @@ -82,33 +83,33 @@       grpCls ns@((NT _):_)   = ns       grpCls cs@((CT c _):_) = [CT c (collapseNClusts $ concatMap getNodes cs)] ---- | Convert the cluster representation of the trees into @'DotNode'@s.---   Clusters will be labelled with @'Int'@s.-treesToNodes :: (c -> [Attribute]) -> (LNode a -> [Attribute])-             -> [ClusterTree c a] -> [DotNode]-treesToNodes fmtCluster fmtNode = snd . treesToNodesFrom fmtCluster fmtNode 0---- | Start labelling the clusters with this @'Int'@.-treesToNodesFrom :: (c -> [Attribute]) -> (LNode a -> [Attribute])-                 -> Int -> [ClusterTree c a] -> (Int,[DotNode])-treesToNodesFrom fmtCluster fmtNode n = mapAccumL mkNodes n-    where-      mkNodes = treeToNode fmtCluster fmtNode---- | Convert this 'ClusterTree' into its 'DotNode' representation.-treeToNode :: (c -> [Attribute]) -> (LNode a -> [Attribute])-           -> Int -> ClusterTree c a -> (Int, DotNode)-treeToNode _ fmtNode n (NT ln) = ( n-                                 , DotNode { nodeID = fst ln-                                           , nodeAttributes = fmtNode ln-                                           }-                                 )+-- | Convert the cluster representation of the trees into 'DotNode's+--   and 'DotSubGraph's (with @'isCluster' = 'True'@, and+--   @'subGraphID' = 'Nothing'@).+treesToDot :: (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+              -> (LNode a -> Attributes) -> [ClusterTree c a]+              -> ([DotSubGraph Node], [DotNode Node])+treesToDot cID fmtCluster fmtNode+    = partitionEithers+      . map (treeToDot cID fmtCluster fmtNode) -treeToNode fmtCluster fmtNode n (CT c nts) = (n',clust)+-- | Convert this 'ClusterTree' into its /Dot/ representation.+treeToDot :: (c -> Maybe GraphID) -> (c -> [GlobalAttributes])+             -> (LNode a -> Attributes) -> ClusterTree c a+             -> Either (DotSubGraph Node) (DotNode Node)+treeToDot _ _ fmtNode (NT ln)+    = Right DotNode { nodeID         = fst ln+                    , nodeAttributes = fmtNode ln+                    }+treeToDot cID fmtCluster fmtNode (CT c nts)+    = Left DotSG { isCluster     = True+                 , subGraphID    = cID c+                 , subGraphStmts = stmts+                 }     where-      (n', nts') = treesToNodesFrom fmtCluster fmtNode (n+1) nts-      clust = DotCluster { clusterID = show n-                         , clusterAttributes = fmtCluster c-                         , clusterElems = nts'-                         }+      stmts = DotStmts { attrStmts = fmtCluster c+                       , subGraphs = cs+                       , nodeStmts = ns+                       , edgeStmts = []+                       }+      (cs, ns) = treesToDot cID fmtCluster fmtNode nts

@@ -0,0 +1,63 @@+{- |+   Module      : Data.GraphViz.Types.Internal+   Description : Internal functions+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines internal functions.+-}+module Data.GraphViz.Types.Internal where++import Data.Char( isAsciiUpper+                , isAsciiLower+                , isDigit+                )++isIDString        :: String -> Bool+isIDString []     = True+isIDString (f:os) = frstIDString f+                    && all restIDString os++-- | First character of a non-quoted 'String' must match this.+frstIDString   :: Char -> Bool+frstIDString c = any ($c) [ isAsciiUpper+                          , isAsciiLower+                          , (==) '_'+                          , \ x -> x >= '\200' && x <= '\377'+                          ]++-- | 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     :: String -> Bool+isNumString ""  = False+isNumString str = case str of+                    ('-':str') -> go str'+                    _          -> go str+    where+      go [] = False+      go cs = case dropWhile isDigit cs of+                []       -> True+                ('.':ds) -> not (null ds) && all isDigit ds+                _        -> False++-- | 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++-- | Fold over 'Bool's.+bool       :: a -> a -> Bool -> a+bool t f b = if b+             then t+             else f

@@ -0,0 +1,285 @@+{- |+   Module      : Data.GraphViz.Types.Parsing+   Description : Helper functions for Parsing.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines simple helper functions for use with+   "Text.ParserCombinators.Poly.Lazy".++   Note that the 'ParseDot' instances for 'Bool', etc. match those+   specified for use with GraphViz (e.g. non-zero integers are+   equivalent to 'True').++   You should not be using this module; rather, it is here for+   informative/documentative reasons.  If you want to parse a+   @'Data.GraphViz.Types.DotGraph'@, you should use+   @'Data.GraphViz.Types.parseDotGraph'@ rather than its 'ParseDot'+   instance.+-}+module Data.GraphViz.Types.Parsing+    ( module Text.ParserCombinators.Poly.Lazy+    , Parse+    , ParseDot(..)+    , stringBlock+    , numString+    , quotedString+    , parseAndSpace+    , string+    , strings+    , hasString+    , character+    , noneOf+    , whitespace+    , whitespace'+    , optionalQuotedString+    , optionalQuoted+    , quotedParse+    , newline+    , newline'+    , parseComma+    , tryParseList+    , tryParseList'+    , skipToNewline+    , parseField+    , parseFields+    , parseFieldBool+    , parseFieldsBool+    , parseFieldDef+    , parseFieldsDef+    , commaSep+    , commaSep'+    , stringRep+    ) where++import Data.GraphViz.Types.Internal++import Text.ParserCombinators.Poly.Lazy+import Data.Char( digitToInt+                , isDigit+                , isSpace+                , toLower+                )+import Data.Function(on)+import Data.Maybe(isJust, fromMaybe)+import Data.Ratio((%))+import Control.Monad++-- -----------------------------------------------------------------------------+-- Based off code from Text.Parse in the polyparse library++-- | A @ReadS@-like type alias.+type Parse a = Parser Char a++class ParseDot a where+    parseUnqt :: Parse a++    parse :: Parse a+    parse = optionalQuoted parseUnqt++    parseUnqtList :: Parse [a]+    parseUnqtList = bracketSep (parseAndSpace $ character '[')+                               (parseAndSpace $ parseComma)+                               (parseAndSpace $ character ']')+                               (parseAndSpace parse)++    parseList :: Parse [a]+    parseList = quotedParse parseUnqtList++instance ParseDot Int where+    parseUnqt = parseInt'++instance ParseDot Double where+    parseUnqt = parseFloat'++instance ParseDot Bool where+    parseUnqt = oneOf [ stringRep True "true"+                      , stringRep False "false"+                      , liftM (zero /=) parseInt'+                      ]+        where+          zero :: Int+          zero = 0++instance ParseDot Char where+    -- Can't be a quote character.+    parseUnqt = satisfy ((/=) '"')++    parse = satisfy restIDString+            `onFail`+            quotedParse parseUnqt++    parseUnqtList = oneOf [ numString+                          , stringBlock+                          , quotedString+                          ]++    parseList = oneOf [numString, stringBlock]+                `onFail`+                -- This will also take care of quoted versions of+                -- above.+                quotedParse quotedString++instance (ParseDot a) => ParseDot [a] where+    parseUnqt = parseUnqtList++    parse = parseList++numString :: Parse String+numString = liftM show parseInt'+            `onFail`+            liftM show parseFloat'++stringBlock :: Parse String+stringBlock = do frst <- satisfy frstIDString+                 rest <- many (satisfy restIDString)+                 return $ frst : rest++-- | Used when quotes are explicitly required;+quotedString :: Parse String+quotedString = many $ oneOf [ stringRep '"' "\\\""+                            , satisfy ((/=) '"')+                            ]++parseSigned :: Real a => Parse a -> Parse a+parseSigned p = do '-' <- next; commit (fmap negate p)+                `onFail`+                p++parseInt :: (Integral a) => Parse a+parseInt = do cs <- many1 (satisfy isDigit)+              return (foldl1 (\n d-> n*radix+d)+                                   (map (fromIntegral . digitToInt) cs))+           `adjustErr` (++ "\nexpected one or more digits")+    where+      radix = 10++parseInt' :: Parse Int+parseInt' = parseSigned parseInt++parseFloat :: (RealFrac a) => Parse a+parseFloat = do ds   <- many1 (satisfy isDigit)+                frac <- (do '.' <- next+                            many (satisfy isDigit)+                              `adjustErrBad` (++"expected digit after .")+                         `onFail` return [] )+                expn  <- parseExp `onFail` return 0+                ( return . fromRational . (* (10^^(expn - length frac)))+                  . (%1) . fst+                  . runParser parseInt) (ds++frac)+             `onFail`+             do w <- many (satisfy (not.isSpace))+                case map toLower w of+                  "nan"      -> return (0/0)+                  "infinity" -> return (1/0)+                  _          -> fail "expected a floating point number"+  where parseExp = do 'e' <- fmap toLower next+                      commit (do '+' <- next; parseInt+                              `onFail`+                              parseSigned parseInt)++parseFloat' :: Parse Double+parseFloat' = parseSigned parseFloat++-- -----------------------------------------------------------------------------++parseAndSpace   :: Parse a -> Parse a+parseAndSpace p = p `discard` whitespace'++string :: String -> Parse String+string = mapM character++stringRep     :: a -> String -> Parse a+stringRep v s = string s >> return v++strings :: [String] -> Parse String+strings = oneOf . map string++hasString :: String -> Parse Bool+hasString = liftM isJust . optional . string++character   :: Char -> Parse Char+character c = satisfy (((==) `on` toLower) c)+              `adjustErr`+              (++ "\nnot the expected char: " ++ [c])++noneOf :: (Eq a) => [a] -> Parser a a+noneOf t = satisfy (\x -> all (/= x) t)++whitespace :: Parse String+whitespace = many1 (satisfy isSpace)++whitespace' :: Parse String+whitespace' = many (satisfy isSpace)++optionalQuotedString :: String -> Parse String+optionalQuotedString = optionalQuoted . string++optionalQuoted   :: Parse a -> Parse a+optionalQuoted p = p+                   `onFail`+                   quotedParse p++quotedParse   :: Parse a -> Parse a+quotedParse p = bracket quote quote p+    where+      quote = character '"'++newline :: Parse String+newline = oneOf $ map string ["\r\n", "\n", "\r"]++-- | Consume all whitespace and newlines until a line with+--   non-whitespace is reached.  The whitespace on that line is+--   not consumed.+newline' :: Parse ()+newline' = many (whitespace' >> newline) >> return ()++skipToNewline :: Parse ()+skipToNewline = many (noneOf ['\n','\r']) >> newline >> return ()++parseField     :: (ParseDot a) => String -> Parse a+parseField fld = do string fld+                    whitespace'+                    character '='+                    whitespace'+                    parse++parseFields :: (ParseDot a) => [String] -> Parse a+parseFields = oneOf . map parseField++parseFieldBool :: String -> Parse Bool+parseFieldBool = parseFieldDef True++parseFieldsBool :: [String] -> Parse Bool+parseFieldsBool = oneOf . map parseFieldBool++-- | For 'Bool'-like data structures where the presence of the field+--   name without a value implies a default value.+parseFieldDef       :: (ParseDot a) => a -> String -> Parse a+parseFieldDef d fld = parseField fld+                      `onFail`+                      stringRep d fld++parseFieldsDef   :: (ParseDot a) => a -> [String] -> Parse a+parseFieldsDef d = oneOf . map (parseFieldDef d)++commaSep :: (ParseDot a, ParseDot b) => Parse (a, b)+commaSep = commaSep' parse parse++commaSep'       :: Parse a -> Parse b -> Parse (a,b)+commaSep' pa pb = do a <- pa+                     whitespace'+                     parseComma+                     whitespace'+                     b <- pb+                     return (a,b)++parseComma :: Parse Char+parseComma = character ','++tryParseList :: (ParseDot a) => Parse [a]+tryParseList = tryParseList' parse++tryParseList' :: Parse [a] -> Parse [a]+tryParseList' = liftM (fromMaybe []) . optional

@@ -0,0 +1,151 @@+{- |+   Module      : Data.GraphViz.Types.Printing+   Description : Helper functions for converting to Dot format.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines simple helper functions for use with+   "Text.PrettyPrint".  It also re-exports all the pretty-printing+   combinators from that module.++   Note that the 'PrintDot' instances for 'Bool', etc. match those+   specified for use with GraphViz.++   You should only be using this module if you are writing custom node+   types for use with "Data.GraphViz.Types".  For actual printing of+   code, use @'Data.GraphViz.Types.printDotGraph'@ (which produces a+   'String' value).++   The Dot language specification specifies that any identifier is in+   one of four forms:++       * Any string of alphabetic ([a-zA-Z\200-\377]) characters, underscores ('_') or digits ([0-9]), not beginning with a digit;++       * a number [-]?(.[0-9]+ | [0-9]+(.[0-9]*)? );++       * any double-quoted string (\"...\") possibly containing escaped quotes (\");++       * an HTML string (<...>).++   Due to these restrictions, you should only use 'text' when you are+   sure that the 'String' in question is static and quotes are+   definitely needed/unneeded; it is better to use the 'String'+   instance for 'PrintDot'.  For more information, see the+   specification page:+      <http://graphviz.org/doc/info/lang.html>+-}+module Data.GraphViz.Types.Printing+    ( module Text.PrettyPrint+    , DotCode+    , renderDot+    , PrintDot(..)+    , wrap+    , commaDel+    , printField+    ) where++import Data.GraphViz.Types.Internal++-- Only implicitly import and re-export combinators.+import Text.PrettyPrint hiding ( Style(..)+                               , Mode(..)+                               , TextDetails(..)+                               , render+                               , style+                               , renderStyle+                               , fullRender+                               )+import qualified Text.PrettyPrint as PP++-- -----------------------------------------------------------------------------++-- | A type alias to indicate what is being produced.+type DotCode = Doc++-- | Correctly render GraphViz output.+renderDot :: DotCode -> String+renderDot = PP.renderStyle style'+    where+      style' = PP.style { PP.mode = PP.ZigZagMode }++-- | A class used to correctly print parts of the GraphViz Dot language.+--   Minimal implementation is 'unqtDot'.+class PrintDot a where+    -- | The unquoted representation, for use when composing values to+    --   produce a larger printing value.+    unqtDot :: a -> DotCode++    -- | The actual quoted representation; this should be quoted if it+    --   contains characters not permitted a plain ID String, a number+    --   or it is not an HTML string.+    --   Defaults to 'unqtDot'.+    toDot :: a -> DotCode+    toDot = unqtDot++    -- | The correct way of representing a list of this value when+    --   printed; not all Dot values require this to be implemented.+    --   Defaults to Haskell-like list representation.+    unqtListToDot :: [a] -> DotCode+    unqtListToDot = brackets . hsep . punctuate comma+                    . map unqtDot++    -- | The quoted form of 'unqtListToDot'; defaults to wrapping+    --   double quotes around the result of 'unqtListToDot' (since the+    --   default implementation has characters that must be quoted).+    listToDot :: [a] -> DotCode+    listToDot = doubleQuotes . unqtListToDot++instance PrintDot Int where+    unqtDot = int++instance PrintDot Double where+    unqtDot = double++instance PrintDot Bool where+    unqtDot True  = text "true"+    unqtDot False = text "false"++instance PrintDot Char where+    unqtDot = char++    toDot = qtChar++    unqtListToDot = unqtString++    listToDot = qtString++-- | Check to see if this 'Char' needs to be quoted or not.+qtChar :: Char -> DotCode+qtChar c+    | restIDString c = char c -- Could be a number as well.+    | otherwise      = doubleQuotes $ char c++-- | Escape quotes in Strings that need them.+unqtString :: String -> DotCode+unqtString str+    | isIDString str  = text str+    | isNumString str = text str+    | otherwise       = text $ escapeQuotes str++-- | Escape quotes and quote Strings that need them.+qtString :: String -> DotCode+qtString str+    | isIDString str  = text str+    | isNumString str = text str+                       -- Don't use unqtString as it re-runs isIDString+    | otherwise       = doubleQuotes . text $ escapeQuotes str++instance (PrintDot a) => PrintDot [a] where+    unqtDot = unqtListToDot++    toDot = listToDot++wrap       :: DotCode -> DotCode -> DotCode -> DotCode+wrap b a d = b <> d <> a++commaDel     :: (PrintDot a, PrintDot b) => a -> b -> DotCode+commaDel a b = unqtDot a <> comma <> unqtDot b++printField     :: (PrintDot a) => String -> a -> DotCode+printField f v = text f <> equals <> toDot v

@@ -2,15 +2,8 @@  * Utilise the generic graph class once it is finalised. -* Allow user to choose whether or not the graph is meant to be-  directed or undirected.--* Improve parsing to fully (or at least follow more closely) support Dot.--* Improve clustering/subgraph support.--* Use a PrettyPrinter rather than Show to generate Dot output.- * Improve Output support.  * Find and fix the handle closing bug with graphvizWithHandle.++* Improve support for named Colors.

@@ -1,10 +1,10 @@ Name:               graphviz-Version:            2999.1.0.2+Version:            2999.5.0.0 Stability:          Beta Synopsis:           GraphViz bindings for Haskell. Description:        Provides convenient functions to convert FGL                       graphs into the Dot language used by the-                      GraphViz <http://graphviz.org/> suite of+                      GraphViz (<http://graphviz.org/>) suite of                       programs with a large degree of customisation                       for layout, etc. @@ -33,15 +33,18 @@                            process,                            array,                            fgl,-                           polyparse >= 1.1+                           polyparse >= 1.1,+                           pretty          Exposed-Modules:   Data.GraphViz                            Data.GraphViz.Types+                           Data.GraphViz.Types.Parsing+                           Data.GraphViz.Types.Printing                            Data.GraphViz.Commands                            Data.GraphViz.Attributes-                           Data.GraphViz.ParserCombinators          Other-Modules:     Data.GraphViz.Types.Clustering+                           Data.GraphViz.Types.Internal          Ghc-Options:       -Wall         Ghc-Prof-Options:  -prof -auto-all