packages feed

graphviz 2999.11.0.0 → 2999.12.0.0

raw patch · 42 files changed

+10560/−7606 lines, 42 filesdep +dlistdep +textdep +wl-pprint-textdep −prettydep ~polyparse

Dependencies added: dlist, text, wl-pprint-text

Dependencies removed: pretty

Dependency ranges changed: polyparse

Files

Changelog view
@@ -7,6 +7,100 @@ The following is information about what major changes have gone into each release. +Changes in 2999.12.0.0+----------------------++Many large-level changes were done in this release; in rough+categories these are:++### Conversions from other types++* Can now more easily create Dot graphs from other graph-like data+  structures with the new `graphElemsToDot` function, which takes a+  list of nodes and edges.++* It is now no longer possible to use `graphToDot`, etc. to create Dot+  graphs with anonymous clusters; all clusters must now have explicit+  names (note that uniqueness is not enforced, and it is still+  possible to directly create Dot graphs with anonymous clusters).++### Dot graph representations++* The canonical graph representation has been moved to its own module:+  `Data.GraphViz.Types.Canonical`.++* The generalised representation has had all its "G" and "g" prefixes+  removed.++* Two new representations:++    - `Data.GraphViz.Types.Graph` allows graph-like manipulation of+      Dot code.++    - `Data.GraphViz.Types.Monadic` provides a monadic interface into+      building relatively static graphs, based upon the+      [_dotgen_](http://hackage.haskell.org/package/dotgen) library by+      Andy Gill.++* The `DotRepr` class has been expanded, and three pseudo-classes have+  been provided to reduce type-class contexts in type signatures.++### Using and manipulation Dot graphs++* Pure Haskell implementations of `dot -Tcanon` and `tred` are+  available in `Data.GraphViz.Algorithms`.++* A new module is available for more direct low-level I/O with Dot+  graphs, including the ability to run custom commands as opposed to+  being limited to the standard dot, neato, etc.++### Attributes++* `Data.GraphViz.Attributes` now contains a slimmed-down recommended+  list of attributes; the complete list can still be found in+  `Data.GraphViz.Attributes.Complete`.++* The `charset` attribute is no longer available.++* Functions for specifying custom attributes (for pre-processors,+  etc.) are available.++### Implementation++* Now uses [`Text`](http://hackage.haskell.org/package/text) values+  rather than `String`s.  Whilst performing this migration, the+  improvements in speed for both printing and parsing improved+  dramatically.++    - As part of this, human-readable Dot code is now produced by+      default.  As such, the `prettyPrint` and `prettyPrint'`+      functions have been removed.++* Now uses state-based printing and parsing, so that things like graph+  directedness, layer separators and color schemes can be taken into+  account.++* Parsing large data-types (e.g. `Attributes`) now uses less+  back-tracking.++* Now has a benchmarking script for testing printing and parsing+  speed.++* Uses a custom exception type rather than a mish-mash of error,+  `Maybe`, `Either`, exception types from used libraries, etc.++* Usage of UTF-8 is now enforced when doing I/O.  If another encoding+  is required, the `Text` value that's printed/parsed has to be+  written/read from disk/network/etc. manually.++### Bug-Fixes++* The `Rects` `Attribute` should be able to take a list of `Rect`+  values; error spotted by **Henning Gunther**.++* In some cases, global attribute names were being printed without+  even an empty list (which doesn't match what dot, etc. expect).+ Changes in 2999.11.0.0 ---------------------- @@ -28,9 +122,6 @@  * `LayerList` uses `LayerID` values, and now has a proper `shrink`   implementation in the test suite.--* The optional `z` coordinate and `!` argument for `Point` values are-  now supported.  Changes in 2999.10.0.1 ----------------------
Data/GraphViz.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE   MultiParamTypeClasses, FlexibleContexts #-}+{-# LANGUAGE   MultiParamTypeClasses, FlexibleContexts, OverloadedStrings #-}  {- |    Module      : Data.GraphViz@@ -26,10 +26,11 @@     , blankParams     , setDirectedness       -- *** Specifying clusters.-    , LNodeCluster     , NodeCluster(..)+    , LNodeCluster       -- ** Converting graphs.     , graphToDot+    , graphElemsToDot       -- ** Pseudo-inverse conversion.     , dotToGraph       -- * Graph augmentation.@@ -45,31 +46,37 @@       -- $manualAugment     , EdgeID     , addEdgeIDs-    , setEdgeComment+    , setEdgeIDAttribute     , dotAttributes     , augmentGraph       -- * Utility functions-    , prettyPrint-    , prettyPrint'-    , canonicalise     , preview       -- * Re-exporting other modules.     , module Data.GraphViz.Types+    , module Data.GraphViz.Types.Canonical     , module Data.GraphViz.Attributes     , module Data.GraphViz.Commands     ) where  import Data.GraphViz.Types-import Data.GraphViz.Types.Clustering+import Data.GraphViz.Types.Canonical( DotGraph(..), DotStatements(..)+                                    , DotSubGraph(..))+import Data.GraphViz.Algorithms.Clustering import Data.GraphViz.Util(uniq, uniqBy) import Data.GraphViz.Attributes+import Data.GraphViz.Attributes.Complete(CustomAttribute, AttributeName+                                        , customAttribute, findSpecifiedCustom+                                        , customValue) import Data.GraphViz.Commands+import Data.GraphViz.Commands.IO(hGetDot)  import Data.Graph.Inductive.Graph import qualified Data.Set as Set-import Control.Arrow((&&&))-import Data.Maybe(mapMaybe, isNothing)+import Control.Arrow((&&&), first)+import Data.Maybe(mapMaybe, fromJust) import qualified Data.Map as Map+import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text) import Control.Monad(liftM) import System.IO.Unsafe(unsafePerformIO) import Control.Concurrent(forkIO)@@ -79,11 +86,11 @@ -- | 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)+  where+    es = labEdges g+    eSet = Set.fromList es+    hasFlip e = Set.member (flippedEdge e) eSet+    flippedEdge (f,t,l) = (t,f,l)  -- ----------------------------------------------------------------------------- @@ -141,18 +148,22 @@     For more examples, see the source of 'dotizeGraph' and 'preview'. --}+ -}  -- | Defines the parameters used to convert a 'Graph' into a 'DotRepr'. -----   A value of type @'GraphvizParams' nl el cl l@ indicates that the---   'Graph' has node labels of type @nl@, edge labels of type @el@,---   corresponding clusters of type @cl@ and after clustering the---   nodes have a label of type @l@ (which may or may not be the same---   as @nl@).+--   A value of type @'GraphvizParams' n nl el cl l@ indicates that+--   the 'Graph' has a node type of @n@, node labels of type @nl@,+--   edge labels of type @el@, corresponding clusters of type @cl@ and+--   after clustering the nodes have a label of type @l@ (which may or+--   may not be the same as @nl@). --+--   The tuples ins the function types represent labelled nodes (for+--   @(n,nl)@ and @(n,l)@) and labelled edges (@(n,n,el)@; the value+--   @(f,t,ftl)@ is an edge from @f@ to @l@ with a label of @ftl@).+-- --   The clustering in 'clusterBy' can be to arbitrary depth.-data GraphvizParams nl el cl l+data GraphvizParams n nl el cl l      = Params { -- | @True@ if the graph is directed; @False@                 --   otherwise.                 isDirected       :: Bool@@ -160,19 +171,22 @@                 --   graph.               , globalAttributes :: [GlobalAttributes]                 -- | A function to specify which cluster a particular-                --   'LNode' is in.-              , clusterBy        :: (LNode nl -> LNodeCluster cl l)+                --   node is in.+              , clusterBy        :: ((n,nl) -> NodeCluster cl (n,l))                 -- | The name/identifier for a cluster.-              , clusterID        :: (cl -> Maybe GraphID)+              , clusterID        :: (cl -> GraphID)                 -- | Specify which global attributes are applied in                 --   the given cluster.               , fmtCluster       :: (cl -> [GlobalAttributes])                 -- | The specific @Attributes@ for a node.-              , fmtNode          :: (LNode l -> Attributes)+              , fmtNode          :: ((n,l) -> Attributes)                 -- | The specific @Attributes@ for an edge.-              , fmtEdge          :: (LEdge el -> Attributes)+              , fmtEdge          :: ((n,n,el) -> Attributes)               } +-- | An alias for 'NodeCluster' when dealing with FGL graphs.+type LNodeCluster cl l = NodeCluster cl (Node,l)+ -- | A default 'GraphvizParams' value which assumes the graph is --   directed, contains no clusters and has no 'Attribute's set. --@@ -180,11 +194,15 @@ --   type after applying 'clusterBy' from before clustering, then you --   will have to specify your own 'GraphvizParams' value from --   scratch (or use 'blankParams').-defaultParams :: GraphvizParams nl el cl nl+--+--   If you use a custom 'clusterBy' function (which if you actually+--   want clusters you should) then you should also override the+--   (nonsensical) default 'clusterID'.+defaultParams :: GraphvizParams n nl el cl nl defaultParams = Params { isDirected       = True                        , globalAttributes = []                        , clusterBy        = N-                       , clusterID        = const Nothing+                       , clusterID        = const (Int 0)                        , fmtCluster       = const []                        , fmtNode          = const []                        , fmtEdge          = const []@@ -194,7 +212,7 @@ --   type is @'()'@ (i.e.: no clustering); this avoids problems when --   using 'defaultParams' internally within a function without any --   constraint on what the clustering type is.-nonClusteredParams :: GraphvizParams nl el () nl+nonClusteredParams :: GraphvizParams n nl el () nl nonClusteredParams = defaultParams  -- | A 'GraphvizParams' value where every field is set to@@ -204,7 +222,7 @@ --   meantime.  This is especially useful when you are --   programmatically setting the clustering function (and as such do --   not know what the types might be).-blankParams :: GraphvizParams nl el cl l+blankParams :: GraphvizParams n nl el cl l blankParams = Params { isDirected       = undefined                      , globalAttributes = undefined                      , clusterBy        = undefined@@ -217,42 +235,48 @@ -- | Determine if the provided 'Graph' is directed or not and set the --   value of 'isDirected' appropriately. setDirectedness             :: (Ord el, Graph gr)-                               => (GraphvizParams nl el cl l -> gr nl el -> a)-                               -> GraphvizParams nl el cl l -> gr nl el -> a+                               => (GraphvizParams Node nl el cl l -> gr nl el -> a)+                               -> GraphvizParams Node nl el cl l -> gr nl el -> a setDirectedness f params gr = f params' gr   where     params' = params { isDirected = not $ isUndirected gr }  -- | Convert a graph to /Dot/ format, using the specified parameters --   to cluster the graph, etc.-graphToDot :: (Ord cl, Graph gr) => GraphvizParams nl el cl l+graphToDot :: (Ord cl, Graph gr) => GraphvizParams Node nl el cl l               -> gr nl el -> DotGraph Node-graphToDot params graph-    = DotGraph { strictGraph     = False-               , directedGraph   = dirGraph-               , graphID         = Nothing-               , graphStatements = stmts-               }-      where-        dirGraph = isDirected params-        stmts = DotStmts { attrStmts = globalAttributes params-                         , subGraphs = cs-                         , nodeStmts = ns-                         , edgeStmts = es-                         }-        (cs, ns) = clustersToNodes (clusterBy params) (clusterID params)-                                   (fmtCluster params) (fmtNode params)-                                   graph-        es = mapMaybe mkDotEdge . labEdges $ graph-        mkDotEdge e@(f,t,_) = if dirGraph || f <= t-                              then Just-                                   DotEdge { edgeFromNodeID = f-                                           , edgeToNodeID   = t-                                           , edgeAttributes = fmtEdge params e-                                           , directedEdge   = dirGraph-                                           }-                              else Nothing+graphToDot params graph = graphElemsToDot params (labNodes graph) (labEdges graph) +-- | As with 'graphToDot', but this allows you to easily convert other+--   graph-like formats to a Dot graph as long as you can get a list+--   of nodes and edges from it.+graphElemsToDot :: (Ord cl, Ord n) => GraphvizParams n nl el cl l+                   -> [(n,nl)] -> [(n,n,el)] -> DotGraph n+graphElemsToDot params lns les+  = DotGraph { strictGraph     = False+             , directedGraph   = dirGraph+             , graphID         = Nothing+             , graphStatements = stmts+             }+  where+    dirGraph = isDirected params+    stmts = DotStmts { attrStmts = globalAttributes params+                     , subGraphs = cs+                     , nodeStmts = ns+                     , edgeStmts = es+                     }+    (cs, ns) = clustersToNodes (clusterBy params) (clusterID params)+                               (fmtCluster params) (fmtNode params)+                               lns+    es = mapMaybe mkDotEdge les+    mkDotEdge e@(f,t,_) = if dirGraph || f <= t+                          then Just+                               DotEdge { fromNode       = f+                                       , toNode         = t+                                       , edgeAttributes = fmtEdge params e+                                       }+                          else Nothing+ -- | A pseudo-inverse to 'graphToDot'; \"pseudo\" in the sense that --   the original node and edge labels aren't able to be --   reconstructed.@@ -260,6 +284,7 @@                  -> gr Attributes Attributes dotToGraph dg = mkGraph ns' es   where+    d = graphIsDirected dg     -- Applying uniqBy just in case...     ns = uniqBy fst . map toLN $ graphNodes dg     es = concatMap toLE $ graphEdges dg@@ -273,7 +298,7 @@     ns' = ns ++ nEs     -- Conversion functions     toLN (DotNode n as) = (n,as)-    toLE (DotEdge f t d as) = (if d then id else (:) (t,f,as)) [(f,t,as)]+    toLE (DotEdge f t as) = (if d then id else (:) (t,f,as)) [(f,t,as)]  -- ----------------------------------------------------------------------------- @@ -282,10 +307,8 @@    through the appropriate 'GraphvizCommand' to augment the 'Graph' by    adding positional information, etc. -   Please note that there are some restrictions on this: to enable-   support for multiple edges between two nodes, the 'Comment'-   'Attribute' is used to provide a unique identifier for each edge.  As-   such, you should /not/ set this 'Attribute' for any 'LEdge'.+   A 'CustomAttribute' is used to distinguish multiple edges between+   two nodes from each other.     Note that the reason that most of these functions do not have    'unsafePerformIO' applied to them is because if you set a global@@ -313,13 +336,13 @@ -- | Run the appropriate Graphviz command on the graph to get --   positional information and then combine that information back --   into the original graph.-graphToGraph :: (Ord cl, Graph gr) => GraphvizParams nl el cl l -> gr nl el+graphToGraph :: (Ord cl, Graph gr) => GraphvizParams Node nl el cl l -> gr nl el                 -> IO (gr (AttributeNode nl) (AttributeEdge el)) graphToGraph params gr = dotAttributes (isDirected params) gr' dot-    where-      dot = graphToDot params' gr'-      params' = params { fmtEdge = setEdgeComment $ fmtEdge params }-      gr' = addEdgeIDs gr+  where+    dot = graphToDot params' gr'+    params' = params { fmtEdge = setEdgeIDAttribute $ fmtEdge params }+    gr' = addEdgeIDs gr  -- ----------------------------------------------------------------------------- @@ -329,15 +352,15 @@ -- --   Note that the provided 'GraphvizParams' is only used for --   'isDirected', 'clusterBy' and 'clusterID'.-dotizeGraph           :: (Ord cl, Graph gr) => GraphvizParams nl el cl l+dotizeGraph           :: (Ord cl, Graph gr) => GraphvizParams Node nl el cl l                          -> gr nl el -> gr (AttributeNode nl) (AttributeEdge el) dotizeGraph params gr = unsafePerformIO                         $ graphToGraph params' gr-    where-      params' = params { fmtCluster = const []-                       , fmtNode    = const []-                       , fmtEdge    = const []-                       }+  where+    params' = params { fmtCluster = const []+                     , fmtNode    = const []+                     , fmtEdge    = const []+                     }  -- ----------------------------------------------------------------------------- @@ -361,14 +384,14 @@    a 'Graph', then the behaviour of 'augmentGraph' (and all functions    that use it) is undefined.  The main point is to make sure that the    defined 'DotNode' and 'DotEdge' values aren't removed (or their ID-   values - or the 'Comment' 'Attribute' for the 'DotEdge's - altered) to+   values - or the 'Attributes' for the 'DotEdge's - altered) to    ensure that it is possible to match up the nodes and edges in the    'Graph' with those in the 'DotRepr'.  -}  -- | Used to augment an edge label with a unique identifier.-data EdgeID el = EID { eID  :: String+data EdgeID el = EID { eID  :: Text                      , eLbl :: el                      }                deriving (Eq, Ord, Show)@@ -384,28 +407,35 @@     ns = labNodes g     es = labEdges g     es' = zipWith addID es ([1..] :: [Int])-    addID (f,t,l) i = (f,t,EID (show i) l)+    addID (f,t,l) i = (f,t,EID (T.pack $ show i) l)  -- | Add the 'Comment' to the list of attributes containing the value --   of the unique edge identifier.-setEdgeComment     :: (LEdge el -> Attributes)-                      -> (LEdge (EdgeID el) -> Attributes)-setEdgeComment f = \ e@(_,_,eid) -> Comment (eID eid) : (f . stripID) e+setEdgeIDAttribute     :: (LEdge el -> Attributes)+                          -> (LEdge (EdgeID el) -> Attributes)+setEdgeIDAttribute f = \ e@(_,_,eid) -> identifierAttribute (eID eid)+                                        : (f . stripID) e +identifierAttrName :: AttributeName+identifierAttrName = "graphviz_distinguish_multiple_edges"++identifierAttribute :: Text -> CustomAttribute+identifierAttribute = customAttribute identifierAttrName+ -- | Remove the unique identifier from the 'LEdge'. stripID           :: LEdge (EdgeID el) -> LEdge el stripID (f,t,eid) = (f,t, eLbl eid)  -- | Pass the 'DotRepr' through the relevant command and then augment --   the 'Graph' that it came from.-dotAttributes :: (Graph gr, DotRepr dg Node) => Bool -> gr nl (EdgeID el)+dotAttributes :: (Graph gr, PPDotRepr dg Node) => Bool -> gr nl (EdgeID el)                  -> dg Node -> IO (gr (AttributeNode nl) (AttributeEdge el)) dotAttributes isDir gr dot-  = liftM (augmentGraph gr . parseDG . fromDotResult)-    $ graphvizWithHandle command dot DotOutput hGetContents'-    where-      parseDG = asTypeOf dot . parseDotGraph-      command = if isDir then dirCommand else undirCommand+  = liftM (augmentGraph gr . parseDG)+    $ graphvizWithHandle command dot DotOutput hGetDot+  where+    parseDG = asTypeOf dot+    command = if isDir then dirCommand else undirCommand  -- | Use the 'Attributes' in the provided 'DotGraph' to augment the --   node and edge labels in the provided 'Graph'.  The unique@@ -427,52 +457,14 @@     ns = graphNodes dg     es = graphEdges dg     nodeMap = Map.fromList $ map (nodeID &&& nodeAttributes) ns-    edgeMap = Map.fromList $ map (findID &&& edgeAttributes') es-    findID = head . mapMaybe commentID . edgeAttributes-    commentID (Comment s) = Just s-    commentID _           = Nothing-    -- Strip out the comment-    edgeAttributes' = filter (isNothing . commentID) . edgeAttributes-+    edgeMap = Map.fromList $ map edgeIDAttrs es+    edgeIDAttrs = first customValue . fromJust+                  . findSpecifiedCustom identifierAttrName+                  . edgeAttributes  -- ----------------------------------------------------------------------------- -- Utility Functions --- | Pretty-print the 'DotGraph' by passing it through the 'Canon'---   output type (which produces \"canonical\" output).  This is---   required because the 'printDotGraph' function (and all printing---   functions in "Data.GraphViz.Types.Printing") no longer uses---   indentation (this is to ensure the Dot code is printed correctly---   due to the limitations of the Pretty Printer used).------   This will call 'error' if an error occurs when calling the---   relevant 'GraphvizCommand': likely causes are that Graphviz suite---   isn't installed, or it has an 'Image' or 'HtmlImg' Attribute that---   references an image that can't be found from the working---   directory.-prettyPrint    :: (DotRepr dg n) => dg n -> IO String-prettyPrint dg = liftM fromDotResult-                 -- Note that the choice of command here should be-                 -- arbitrary.-                 $ graphvizWithHandle (commandFor dg)-                                      dg-                                      Canon-                                      hGetContents'---- | The 'unsafePerformIO'd version of 'prettyPrint'.  Graphviz should---   always produce the same pretty-printed output, so this should be---   safe.  However, it is not recommended to use it in production---   code, just for testing purposes.-prettyPrint' :: (DotRepr dg n) => dg n -> String-prettyPrint' = unsafePerformIO . prettyPrint---- | Convert the 'DotRepr' into its canonical form.  This /should/---   work as it appears that the 'prettyPrint'ed form is always in the---   format of a 'DotGraph', but the Graphviz code hasn't been---   examined to verify this.-canonicalise :: (DotRepr dg n, DotRepr DotGraph n) => dg n -> IO (DotGraph n)-canonicalise = liftM parseDotGraph . prettyPrint- -- | Quickly visualise a graph using the 'Xlib' 'GraphvizCanvas'.  If --   your label types are not (and cannot) be instances of 'Labellable', --   you may wish to use 'gmap', 'nmap' or 'emap' to set them to a value@@ -485,11 +477,3 @@                                 , fmtEdge = \ (_, _, l) -> [toLabel l]                                 }     ign = (>> return ())---- | Used for obtaining results from 'graphvizWithHandle', etc. when---   errors should only occur when Graphviz isn't installed.  If the---   value is @'Left' _@, then 'error' is used.-fromDotResult            :: Either String r -> r-fromDotResult (Right r)  = r-fromDotResult (Left err) = error $ "Error when running the relevant Graphviz\-                                   \ command:\n" ++ err
+ Data/GraphViz/Algorithms.hs view
@@ -0,0 +1,394 @@+{- |+   Module      : Data.GraphViz.Algorithms+   Description : Various algorithms on Graphviz graphs.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   Defines various algorithms for use on 'DotRepr' graphs.  These are+   typically re-implementations of behaviour found in existing Graphviz+   tools but without the I/O requirement.+ -}+module Data.GraphViz.Algorithms+       ( -- * Canonicalisation Options+         -- $options+         CanonicaliseOptions(..)+       , defaultCanonOptions+       , dotLikeOptions+         -- * Canonicalisation+       , canonicalise+       , canonicaliseOptions+         -- * Dealing with transitive edges+       , transitiveReduction+       , transitiveReductionOptions+       ) where++import Data.GraphViz.Attributes.Complete( Attributes, usedByClusters+                                        , defaultAttributeValue)+import Data.GraphViz.Attributes.Same+import Data.GraphViz.Types+import Data.GraphViz.Types.Canonical++import Data.Function(on)+import Data.List(groupBy, sortBy, partition, (\\), sort, deleteBy)+import Data.Maybe(listToMaybe, mapMaybe, fromMaybe)+import qualified Data.DList as DList+import qualified Data.Map as Map+import Data.Map(Map)+import qualified Data.Set as Set+import Data.Set(Set)+import qualified Data.Foldable as F+import Control.Arrow(first, second, (***))+import Control.Monad(unless)+import Control.Monad.Trans.State++-- -----------------------------------------------------------------------------++{- $options+   For simplicity, many algorithms end up using the canonicalisation+   functions to create the new 'DotGraph'.  'CanonicaliseOptions' allows+   you to configure how the output is generated.+ -}++data CanonicaliseOptions = COpts { -- | Place edges in the clusters+                                   --   where their nodes are rather+                                   --   than in the top-level graph.+                                   edgesInClusters :: Bool+                                   -- | Put common 'Attributes' as+                                   --   top-level 'GlobalAttributes'.+                                 , groupAttributes :: Bool+                                 }+                         deriving (Eq, Ord, Show, Read)++defaultCanonOptions :: CanonicaliseOptions+defaultCanonOptions = COpts { edgesInClusters = True+                            , groupAttributes = True+                            }++-- | Options that are more like how @dot -Tcanon@ works.+dotLikeOptions :: CanonicaliseOptions+dotLikeOptions = COpts { edgesInClusters = True+                       , groupAttributes = False+                       }++-- -----------------------------------------------------------------------------++-- | Implements similar functionality to @dot -Tcanon@.  However, this+--   method requires no IO and doesn't care about image locations, etc.+--+--   This function will create a single explicit definition for every+--   node in the original graph and place it in the appropriate+--   position in the cluster hierarchy.  All edges are found in the+--   deepest cluster that contains both nodes.  Currently node and+--   edge attributes are not grouped into global ones.+canonicalise :: (DotRepr dg n) => dg n -> DotGraph n+canonicalise = canonicaliseOptions defaultCanonOptions++-- | As with 'canonicalise', but allow custom 'CanonicaliseOptions'.+canonicaliseOptions :: (DotRepr dg n) => CanonicaliseOptions+                       -> dg n -> DotGraph n+canonicaliseOptions opts dg = cdg { strictGraph   = graphIsStrict dg+                                  , directedGraph = graphIsDirected dg+                                  , graphID       = getID dg+                                  }+  where+    cdg = createCanonical opts gas cl nl es++    (gas, cl) = graphStructureInformation dg+    nl = nodeInformation True dg+    es = edgeInformation True dg++createCanonical :: (Ord n) => CanonicaliseOptions -> GlobalAttributes+                   -> ClusterLookup -> NodeLookup n -> [DotEdge n] -> DotGraph n+createCanonical opts gas cl nl es+  = DotGraph { strictGraph     = undefined+             , directedGraph   = undefined+             , graphID         = undefined+             , graphStatements = gStmts+             }+  where+    gStmts = DotStmts { attrStmts = gas'+                      , subGraphs = sgs+                      , nodeStmts = topNs'+                      , edgeStmts = topEs'+                      }++    gas' = nonEmptyGAs [ gas+                       , NodeAttrs topNAs+                       , EdgeAttrs topEAs+                       ]+    nUnlook (n,(p,as)) = (F.toList p, DotNode n as)+    ns = sortBy (compLists `on` fst) . map nUnlook $ Map.toList nl+    (clustNs, topNs) = thisLevel ns+    (clustEL, topEs) = if edgesInClusters opts+                       then edgeClusters nl es+                       else (Map.empty, es)+    topClustAs = filter usedByClusters $ attrs gas+    topClustAs' = toSAttr topClustAs++    topNAs = mCommon nodeAttributes topNs+    topNAs' = toSAttr topNAs+    topNs' = map (\dn -> dn {nodeAttributes = nodeAttributes dn \\ topNAs}) topNs++    topEAs = mCommon edgeAttributes topEs+    topEAs' = toSAttr topEAs+    topEs' = map (\de -> de {edgeAttributes = edgeAttributes de \\ topEAs}) topEs++    sgs = clusts topClustAs topClustAs' topNAs topNAs' topEAs topEAs' clustNs++    clusts oAs oAsS nAs nAsS eAs eAsS = map (toClust oAs oAsS nAs nAsS eAs eAsS)+                                        . groupBy ((==) `on` (listToMaybe . fst))++    -- Create a new cluster.+    toClust oAs oAsS nAs nAsS eAs eAsS cns+      = DotSG { isCluster     = True+              , subGraphID    = cID+              , subGraphStmts = stmts+              }+      where+        cID = head . fst $ head cns+        (nested, here) = thisLevel $ map (first tail) cns+        stmts = DotStmts { attrStmts = sgAs+                         , subGraphs = subSGs+                         , nodeStmts = here'+                         , edgeStmts = edges'+                         }++        sgAs = nonEmptyGAs [ GraphAttrs as'+                           , NodeAttrs nas'+                           , EdgeAttrs eas'+                           ]++        subSGs = clusts as asS nas nasS eas easS nested++        as = attrs . snd $ cl Map.! cID+        asS = toSAttr as+        as' = innerAttributes oAs oAsS as++        nas = mCommon nodeAttributes here+        nasS = toSAttr nas+        nas' = innerAttributes nAs nAsS nas+        here' = map (\dn -> dn {nodeAttributes = nodeAttributes dn \\ nas}) here++        eas = mCommon edgeAttributes edges+        easS = toSAttr eas+        eas' = innerAttributes eAs eAsS eas+        edges' = map (\de -> de {edgeAttributes = edgeAttributes de \\ eas}) edges++        edges = fromMaybe [] $ cID `Map.lookup` clustEL++    thisLevel = second (map snd) . span (not . null . fst)++    mCommon f = if groupAttributes opts+                then commonAttrs f+                else const []+++-- Same as compare for lists, except shorter lists are GT+compLists :: (Ord a) => [a] -> [a] -> Ordering+compLists []     []     = EQ+compLists []     _      = GT+compLists _      []     = LT+compLists (x:xs) (y:ys) = case compare x y of+                            EQ  -> compLists xs ys+                            oth -> oth++nonEmptyGAs :: [GlobalAttributes] -> [GlobalAttributes]+nonEmptyGAs = filter (not . null . attrs)++-- Return all attributes found in every value.+commonAttrs         :: (a -> Attributes) -> [a] -> Attributes+commonAttrs _ []  = []+commonAttrs _ [_] = []+commonAttrs f xs  = Set.toList . foldr1 Set.intersection+                    $ map (Set.fromList . f) xs++-- Assign each edge into the cluster it belongs in.+edgeClusters    :: (Ord n) => NodeLookup n -> [DotEdge n]+                   -> (Map (Maybe GraphID) [DotEdge n], [DotEdge n])+edgeClusters nl = (toM *** map snd) . partition (not . null . fst)+                  . map inClust+  where+    nl' = Map.map (F.toList . fst) nl+    inClust de@(DotEdge n1 n2 _) = (flip (,) de)+                                   . map fst . takeWhile (uncurry (==))+                                   $ zip (nl' Map.! n1) (nl' Map.! n2)+    toM = Map.map DList.toList+          . Map.fromListWith (flip DList.append)+          . map (last *** DList.singleton)++-- Return only those attributes that are required within the inner+-- sub-graph.+innerAttributes                    :: Attributes -> SAttrs+                                      -> Attributes -> Attributes+innerAttributes outer outerS inner = sort $ inner' ++ override+  where+    -- Remove all Attributes that are also defined in the outer cluster+    inner' = inner \\ outer++    -- Need to consider those Attributes that were defined /after/ this value+    override = mapMaybe defAttr . unSame+               $ outerS `Set.difference` toSAttr inner++    -- A version of defaultAttributeValue that returns Nothing if the+    -- value it is replacing /is/ the default.+    defAttr a = case defaultAttributeValue a of+                  Just a' | a == a' -> Nothing+                  ma'               -> ma'++-- -----------------------------------------------------------------------------++{- $transitive++   In large, cluttered graphs, it can often be difficult to see what+   is happening due to the number of edges being drawn.  As such, it is+   often useful to remove transitive edges from the graph before+   visualising it.++   For example, consider the following Dot graph:++   > digraph {+   >     a -> b;+   >     a -> c;+   >     b -> c;+   > }++   This graph has the transitive edge @a -> c@ (as we can reach @c@ from @a@ via @b@).++   Graphviz comes with the @tred@ program to perform these transitive+   reductions.  'transitiveReduction' and 'transitiveReductionOptions'+   are pure Haskell re-implementations of @tred@ with the following differences:++   * @tred@ prints a message to stderr if a cycle is detected; these+     functions do not.++   * @tred@ preserves the original structure of the graph; these+     functions use the canonicalisation functions above to create the new+     graph (rather than re-implement creation functions for each one).++   When a graph contains cycles, an arbitrary edge from that cycle is+   ignored whilst calculating the transitive reduction.  Multiple edges+   are also reduced (such that only the first edge between two nodes is+   kept).++   Note that transitive reduction only makes sense for directed graphs;+   for undirected graphs these functions are identical to the+   canonicalisation functions above.+ -}++transitiveReduction :: (DotRepr dg n) => dg n -> DotGraph n+transitiveReduction = transitiveReductionOptions defaultCanonOptions++transitiveReductionOptions         :: (DotRepr dg n) => CanonicaliseOptions+                                      -> dg n -> DotGraph n+transitiveReductionOptions opts dg = cdg { strictGraph = graphIsStrict dg+                                         , directedGraph = graphIsDirected dg+                                         , graphID = getID dg+                                         }+  where+    cdg = createCanonical opts gas cl nl es'+    (gas, cl) = graphStructureInformation dg+    nl = nodeInformation True dg+    es = edgeInformation True dg+    es' | graphIsDirected dg = rmTransEdges es+        | otherwise          = es++rmTransEdges    :: (Ord n) => [DotEdge n] -> [DotEdge n]+rmTransEdges [] = []+rmTransEdges es = concatMap (map snd . outgoing) $ Map.elems esM+  where+    tes = tagEdges es++    esMS = do edgeGraph tes+              ns <- getsMap Map.keys+              mapM_ (traverse zeroTag) ns++    esM = fst $ execState esMS (Map.empty, Set.empty)++type Tag = Int+type TagSet = Set Int+type TaggedEdge n = (Tag, DotEdge n)++-- A "nonsense" tag to use as an initial value+zeroTag :: Tag+zeroTag = 0++tagEdges :: [DotEdge n] -> [TaggedEdge n]+tagEdges = zip [(succ zeroTag)..]++data TaggedValues n = TV { marked   :: Bool+                         , incoming :: [TaggedEdge n]+                         , outgoing :: [TaggedEdge n]+                         }+                    deriving (Eq, Ord, Show, Read)++defTV :: TaggedValues n+defTV = TV False [] []++type TagMap n = Map n (TaggedValues n)++type TagState n a = State (TagMap n, TagSet) a++getMap :: TagState n (TagMap n)+getMap = gets fst++getsMap   :: (TagMap n -> a) -> TagState n a+getsMap f = gets (f . fst)++modifyMap   :: (TagMap n -> TagMap n) -> TagState n ()+modifyMap f = modify (first f)++getSet :: TagState n TagSet+getSet = gets snd++modifySet   :: (TagSet -> TagSet) -> TagState n ()+modifySet f = modify (second f)++-- Create the Map representing the graph from the edges.+edgeGraph :: (Ord n) => [TaggedEdge n] -> TagState n ()+edgeGraph = mapM_ addEdge . reverse+  where+    addEdge te = addVal f tvOut >> addVal t tvIn+      where+        e = snd te+        f = fromNode e+        t = toNode e+        addVal n tv = modifyMap (Map.insertWith mergeTV n tv)+        tvIn  = defTV { incoming = [te] }+        tvOut = defTV { outgoing = [te] }+        mergeTV tvNew tv  = tv { incoming = incoming tvNew ++ incoming tv+                               , outgoing = outgoing tvNew ++ outgoing tv+                               }++-- Perform a DFS to determine whether or not to keep each edge.+traverse     :: (Ord n) => Tag -> n -> TagState n ()+traverse t n = do setMark True+                  checkIncoming+                  outEs <- getsMap (maybe [] outgoing . Map.lookup n)+                  mapM_ maybeRecurse outEs+                  setMark False++  where+    setMark mrk = modifyMap (Map.adjust (\tv -> tv { marked = mrk }) n)++    isMarked m n' = maybe False marked $ n' `Map.lookup` m++    checkIncoming = do m <- gets fst+                       let es = incoming $ m Map.! n+                           (keepEs, delEs) = partition (keepEdge m) es+                       modifyMap (Map.adjust (\tv -> tv {incoming = keepEs}) n)+                       modifySet (Set.union $ Set.fromList (map fst delEs))+                       mapM_ delOtherEdge delEs+      where+        keepEdge m (t',e) = t == t' || not (isMarked m $ fromNode e)++        delOtherEdge te = modifyMap (Map.adjust delE . fromNode $ snd te)+          where+            delE tv = tv {outgoing = deleteBy ((==) `on` fst) te $ outgoing tv}++    maybeRecurse (t',e) = do m <- getMap+                             delSet <- getSet+                             let n' = toNode e+                             unless (isMarked m n' || t' `Set.member` delSet)+                               $ traverse t' n'+
+ Data/GraphViz/Algorithms/Clustering.hs view
@@ -0,0 +1,113 @@+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Algorithms.Clustering+   Description : Definition of the clustering types for Graphviz.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines types for creating clusters.+-}+module Data.GraphViz.Algorithms.Clustering+    ( NodeCluster(..)+    , clustersToNodes+    ) where++import Data.GraphViz.Types.Canonical+import Data.GraphViz.Attributes.Complete(Attributes)++import Data.Either(partitionEithers)+import Data.List(groupBy, sortBy)++-- -----------------------------------------------------------------------------++-- | Define into which cluster a particular node belongs.+--   Clusters can be nested to arbitrary depth.+data NodeCluster c a = N a -- ^ Indicates the actual Node in the Graph.+                     | C c (NodeCluster c a) -- ^ Indicates that the+                                             --   'NodeCluster' is in+                                             --   the Cluster /c/.+                        deriving (Show)++-- | Extract the clusters and nodes from the list of nodes.+clustersToNodes :: (Ord c) => ((n,a) -> NodeCluster c (n,l))+                  -> (c -> GraphID) -> (c -> [GlobalAttributes])+                  -> ((n,l) -> Attributes) -> [(n,a)]+                  -> ([DotSubGraph n], [DotNode n])+clustersToNodes clusterBy cID fmtCluster fmtNode+    = treesToDot cID fmtCluster fmtNode+      . collapseNClusts+      . map (clustToTree . clusterBy)++-- -----------------------------------------------------------------------------++-- | A tree representation of a cluster.+data ClusterTree c a = NT a+                     | CT c [ClusterTree c a]+                     deriving (Show)++-- | Convert a single node cluster into its tree representation.+clustToTree          :: NodeCluster c a -> ClusterTree c a+clustToTree (N ln)   = NT ln+clustToTree (C c nc) = CT c [clustToTree nc]++-- | Two nodes are in the same "default" cluster; otherwise check if they+--   are in the same cluster.+sameClust :: (Eq c) => ClusterTree c a -> ClusterTree c a -> Bool+sameClust (NT _)    (NT _)    = True+sameClust (CT c1 _) (CT c2 _) = c1 == c2+sameClust _         _         = False++-- | 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 _ _)  = LT+clustOrder (CT _ _)  (NT _)    = GT+clustOrder (CT c1 _) (CT c2 _) = compare c1 c2++-- | Extract the sub-trees.+getNodes           :: ClusterTree c a -> [ClusterTree c a]+getNodes n@(NT _)  = [n]+getNodes (CT _ ns) = ns++-- | Combine clusters.+collapseNClusts :: (Ord c) => [ClusterTree c a] -> [ClusterTree c a]+collapseNClusts = concatMap grpCls+                  . groupBy sameClust+                  . sortBy clustOrder+  where+    grpCls []              = []+    grpCls ns@(NT _ : _)   = ns+    grpCls cs@(CT c _ : _) = [CT c (collapseNClusts $ concatMap getNodes cs)]++-- | Convert the cluster representation of the trees into 'DotNode's+--   and 'DotSubGraph's (with @'isCluster' = 'True'@, and+--   @'subGraphID' = 'Nothing'@).+treesToDot :: (c -> GraphID) -> (c -> [GlobalAttributes])+              -> ((n,a) -> Attributes) -> [ClusterTree c (n,a)]+              -> ([DotSubGraph n], [DotNode n])+treesToDot cID fmtCluster fmtNode+    = partitionEithers+      . map (treeToDot cID fmtCluster fmtNode)++-- | Convert this 'ClusterTree' into its /Dot/ representation.+treeToDot :: (c -> GraphID) -> (c -> [GlobalAttributes])+             -> ((n,a) -> Attributes) -> ClusterTree c (n,a)+             -> Either (DotSubGraph n) (DotNode n)+treeToDot _ _ fmtNode (NT ln)+    = Right DotNode { nodeID         = fst ln+                    , nodeAttributes = fmtNode ln+                    }+treeToDot cID fmtCluster fmtNode (CT c nts)+    = Left DotSG { isCluster     = True+                 , subGraphID    = Just $ cID c+                 , subGraphStmts = stmts+                 }+  where+    stmts = DotStmts { attrStmts = fmtCluster c+                     , subGraphs = cs+                     , nodeStmts = ns+                     , edgeStmts = []+                     }+    (cs, ns) = treesToDot cID fmtCluster fmtNode nts
Data/GraphViz/Attributes.hs view
@@ -2,2445 +2,321 @@  {- |    Module      : Data.GraphViz.Attributes-   Description : Definition of the Graphviz attributes.-   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   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:--   * 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).--   * @ColorList@, @DoubleList@ and @PointfList@ are defined as actual-     lists (@'LayerList'@ needs a newtype for other reasons).  All of these-     are assumed to be non-empty lists.  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.  The optional '!' and-     third value for Point are also available.--   * 'Rect' uses two 'Point' values to denote the lower-left and-     top-right corners.--   * The two 'LabelLoc' attributes have been combined.--   * 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.--   * Not every 'Attribute' is fully documented/described.  However,-     all those which have specific allowed values should be covered.--   * Deprecated 'Overlap' algorithms are not defined.--   * The global @Orientation@ attribute is not defined, as it is-     difficult to distinguish from the node-based 'Orientation'-     'Attribute'; also, its behaviour is duplicated by 'Rotate'.-- -}-module Data.GraphViz.Attributes-    ( -- * The actual /Dot/ attributes.-      Attribute(..)-    , Attributes-    , sameAttribute-      -- ** Validity functions on @Attribute@ values.-    , usedByGraphs-    , usedBySubGraphs-    , usedByClusters-    , usedByNodes-    , usedByEdges--      -- * Value types for @Attribute@s.-    , module Data.GraphViz.Attributes.Colors--      -- ** Labels-    , EscString-    , Label(..)-    , Labellable(..)-    , VerticalPlacement(..)-    , module Data.GraphViz.Attributes.HTML-      -- *** Types representing the Dot grammar for records.-    , RecordFields-    , RecordField(..)-    , Rect(..)-    , Justification(..)--      -- ** Nodes-    , Shape(..)-    , ScaleType(..)--      -- ** Edges-    , DirType(..)-    , EdgeType(..)-      -- *** Modifying where edges point-    , PortName(..)-    , PortPos(..)-    , CompassPoint(..)-      -- *** Arrows-    , 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--      -- ** Positioning-    , Point(..)-    , createPoint-    , Pos(..)-    , Spline(..)-    , DPoint(..)--      -- ** Layout-    , AspectType(..)-    , ClusterMode(..)-    , Model(..)-    , Overlap(..)-    , Root(..)-    , OutputMode(..)-    , Pack(..)-    , PackMode(..)-    , PageDir(..)-    , QuadType(..)-    , RankType(..)-    , RankDir(..)-    , StartType(..)-    , ViewPort(..)-    , FocusType(..)-    , Ratios(..)--      -- ** Modes-    , ModeType(..)-    , DEConstraints(..)--      -- ** Layers-    , LayerRange(..)-    , LayerID(..)-    , LayerList(..)-    , defLayerSep-    , notLayerSep--      -- ** Stylistic-    , SmoothType(..)-    , STStyle(..)-    , StyleItem(..)-    , StyleName(..)-    ) where--import Data.GraphViz.Attributes.Colors-import Data.GraphViz.Attributes.HTML-import Data.GraphViz.Attributes.Internal-import Data.GraphViz.Util-import Data.GraphViz.Parsing-import Data.GraphViz.Printing--import Data.Char(toLower)-import Data.Maybe(isJust)-import Data.Word(Word16)-import Control.Monad(liftM, liftM2)---- -------------------------------------------------------------------------------{- |--   These attributes have been implemented in a /permissive/ manner:-   that is, rather than split them up based on which type of value-   they are allowed, they have all been included in the one data type,-   with functions to determine if they are indeed valid for what-   they're being applied to.--   To interpret the /Valid for/ listings:--     [@G@] Valid for Graphs.--     [@C@] Valid for Clusters.--     [@S@] Valid for Sub-Graphs (and also Clusters).--     [@N@] Valid for Nodes.--     [@E@] Valid for Edges.--   The /Default/ listings are those that the various Graphviz commands-   use if that 'Attribute' isn't specified (in cases where this is-   /none/, this is equivalent to a 'Nothing' value; that is, no value-   is used).  The /Parsing Default/ listings represent what value is-   used (i.e. corresponds to 'True') when the 'Attribute' name is-   listed on its own in /Dot/ source code.--   Please note that the 'UnknownAttribute' 'Attribute' is defined for-   /backwards-compatibility purposes only/ (specifically, to be able to-   parse old Dot code containing 'Attribute's that are no longer valid).-   As such, this 'Attribute' should not be used directly.  The attribute-   name is assumed to match the first type of identifier listed in-   "Data.GraphViz.Printing" (i.e. a non-number that does not need to be-   quoted).---}-data Attribute-    = Damping Double                   -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only-    | K Double                         -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only-    | URL EscString                    -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only-    | ArrowHead ArrowType              -- ^ /Valid for/: E; /Default/: @'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/: X11Color 'Transparent'-    | 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-    | ColorScheme ColorScheme          -- ^ /Valid for/: ENCG; /Default/: @'X11'@-    | Color [Color]                    -- ^ /Valid for/: ENC; /Default/: @X11Color 'Black'@-    | 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-    | Dimen Int                        -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only-    | Dim Int                          -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only-    | Dir DirType                      -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)-    | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only-    | Distortion Double                -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@-    | DPI Double                       -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym-    | EdgeURL EscString                -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-    | EdgeTarget EscString             -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only-    | EdgeTooltip EscString            -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only-    | Epsilon Double                   -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only-    | ESep DPoint                      -- ^ /Valid for/: G; /Default/: @+3@; /Notes/: not dot-    | FillColor Color                  -- ^ /Valid for/: NC; /Default/: @X11Color 'LightGray'@ (nodes), @X11Color 'Black'@ (clusters)-    | FixedSize Bool                   -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'-    | FontColor Color                  -- ^ /Valid for/: ENGC; /Default/: @X11Color 'Black'@-    | FontName 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 EscString                -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-    | HeadClip Bool                    -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'-    | HeadLabel Label                  -- ^ /Valid for/: E; /Default/: @\"\"@-    | 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'-    | LabelURL EscString               -- ^ /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/: @X11Color '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-    | Label Label                      -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)-    | Landscape Bool                   -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'-    | LayerSep String                  -- ^ /Valid for/: G; /Default/: @\" :\t\"@-    | Layers LayerList                 -- ^ /Valid for/: G; /Default/: @\"\"@-    | Layer LayerRange                 -- ^ /Valid for/: EN; /Default/: @\"\"@-    | Layout String                    -- ^ /Valid for/: G; /Default/: @\"\"@-    | Len Double                       -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only-    | LevelsGap Double                 -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only-    | Levels Int                       -- ^ /Valid for/: G; /Default/: @MAXINT@; /Minimum/: @0@; /Notes/: sfdp 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-    | Model Model                      -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only-    | Mode ModeType                    -- ^ /Valid for/: G; /Default/: @'Major'@; /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-    | Nslimit1 Double                  -- ^ /Valid for/: G; /Notes/: dot only-    | Nslimit 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@-    | OutputOrder OutputMode           -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@-    | OverlapScaling Double            -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only-    | Overlap Overlap                  -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot-    | PackMode PackMode                -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot-    | Pack Pack                        -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'DoPack'; /Notes/: not dot-    | Pad DPoint                       -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)-    | PageDir PageDir                  -- ^ /Valid for/: G; /Default/: @'BL'@-    | Page Point                       -- ^ /Valid for/: G-    | PenColor Color                   -- ^ /Valid for/: C; /Default/: @X11Color 'Black'@-    | PenWidth Double                  -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@-    | Peripheries Int                  -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0-    | Pin Bool                         -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only-    | Pos Pos                          -- ^ /Valid for/: EN-    | QuadTree QuadType                -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only-    | Quantum Double                   -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@-    | 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-    | Rank RankType                    -- ^ /Valid for/: S; /Notes/: 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-    | ShapeFile String                 -- ^ /Valid for/: N; /Default/: @\"\"@-    | Shape Shape                      -- ^ /Valid for/: N; /Default/: @'Ellipse'@-    | ShowBoxes Int                    -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only-    | Sides Int                        -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@-    | Size Point                       -- ^ /Valid for/: G-    | Skew Double                      -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@-    | Smoothing SmoothType             -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only-    | SortV Word16                     -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@-    | Splines EdgeType                 -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges'-    | Start StartType                  -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: fdp, neato only-    | StyleSheet String                -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only-    | Style [StyleItem]                -- ^ /Valid for/: ENC-    | TailURL EscString                -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only-    | TailClip Bool                    -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'-    | TailLabel Label                  -- ^ /Valid for/: E; /Default/: @\"\"@-    | 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@-    | UnknownAttribute String String   -- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively.-      deriving (Eq, Ord, 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 (ColorScheme v)        = printField "colorscheme" v-    unqtDot (Color v)              = printField "color" v-    unqtDot (Comment v)            = printField "comment" v-    unqtDot (Compound v)           = printField "compound" v-    unqtDot (Concentrate v)        = printField "concentrate" v-    unqtDot (Constraint v)         = printField "constraint" v-    unqtDot (Decorate v)           = printField "decorate" v-    unqtDot (DefaultDist v)        = printField "defaultdist" v-    unqtDot (Dimen v)              = printField "dimen" v-    unqtDot (Dim v)                = printField "dim" 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 (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 (Label v)              = printField "label" v-    unqtDot (Landscape v)          = printField "landscape" v-    unqtDot (LayerSep v)           = printField "layersep" v-    unqtDot (Layers v)             = printField "layers" v-    unqtDot (Layer v)              = printField "layer" v-    unqtDot (Layout v)             = printField "layout" v-    unqtDot (Len v)                = printField "len" v-    unqtDot (LevelsGap v)          = printField "levelsgap" v-    unqtDot (Levels v)             = printField "levels" v-    unqtDot (LHead v)              = printField "lhead" v-    unqtDot (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 (Model v)              = printField "model" v-    unqtDot (Mode v)               = printField "mode" 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 (Nslimit1 v)           = printField "nslimit1" v-    unqtDot (Nslimit v)            = printField "nslimit" v-    unqtDot (Ordering v)           = printField "ordering" v-    unqtDot (Orientation v)        = printField "orientation" v-    unqtDot (OutputOrder v)        = printField "outputorder" v-    unqtDot (OverlapScaling v)     = printField "overlap_scaling" v-    unqtDot (Overlap v)            = printField "overlap" v-    unqtDot (PackMode v)           = printField "packmode" v-    unqtDot (Pack v)               = printField "pack" v-    unqtDot (Pad v)                = printField "pad" v-    unqtDot (PageDir v)            = printField "pagedir" v-    unqtDot (Page v)               = printField "page" 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 (RankDir v)            = printField "rankdir" v-    unqtDot (RankSep v)            = printField "ranksep" v-    unqtDot (Rank v)               = printField "rank" 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 (ShapeFile v)          = printField "shapefile" v-    unqtDot (Shape v)              = printField "shape" v-    unqtDot (ShowBoxes v)          = printField "showboxes" v-    unqtDot (Sides v)              = printField "sides" v-    unqtDot (Size v)               = printField "size" v-    unqtDot (Skew v)               = printField "skew" v-    unqtDot (Smoothing v)          = printField "smoothing" v-    unqtDot (SortV v)              = printField "sortv" v-    unqtDot (Splines v)            = printField "splines" v-    unqtDot (Start v)              = printField "start" v-    unqtDot (StyleSheet v)         = printField "stylesheet" v-    unqtDot (Style v)              = printField "style" 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-    unqtDot (UnknownAttribute a v) = toDot a <> equals <> toDot v--    listToDot = unqtListToDot--instance ParseDot Attribute where-    parseUnqt = oneOf [ parseField Damping "Damping"-                      , parseField K "K"-                      , parseFields URL ["URL", "href"]-                      , parseField ArrowHead "arrowhead"-                      , parseField ArrowSize "arrowsize"-                      , parseField ArrowTail "arrowtail"-                      , parseField Aspect "aspect"-                      , parseField Bb "bb"-                      , parseField BgColor "bgcolor"-                      , parseFieldBool Center "center"-                      , parseField Charset "charset"-                      , parseField ClusterRank "clusterrank"-                      , parseField ColorScheme "colorscheme"-                      , parseField Color "color"-                      , parseField Comment "comment"-                      , parseFieldBool Compound "compound"-                      , parseFieldBool Concentrate "concentrate"-                      , parseFieldBool Constraint "constraint"-                      , parseFieldBool Decorate "decorate"-                      , parseField DefaultDist "defaultdist"-                      , parseField Dimen "dimen"-                      , parseField Dim "dim"-                      , parseField Dir "dir"-                      , parseFieldDef DirEdgeConstraints EdgeConstraints "diredgeconstraints"-                      , parseField Distortion "distortion"-                      , parseFields DPI ["dpi", "resolution"]-                      , parseFields EdgeURL ["edgeURL", "edgehref"]-                      , parseField EdgeTarget "edgetarget"-                      , parseField EdgeTooltip "edgetooltip"-                      , parseField Epsilon "epsilon"-                      , parseField ESep "esep"-                      , parseField FillColor "fillcolor"-                      , parseFieldBool FixedSize "fixedsize"-                      , parseField FontColor "fontcolor"-                      , parseField FontName "fontname"-                      , parseField FontNames "fontnames"-                      , parseField FontPath "fontpath"-                      , parseField FontSize "fontsize"-                      , parseField Group "group"-                      , parseFields HeadURL ["headURL", "headhref"]-                      , parseFieldBool HeadClip "headclip"-                      , parseField HeadLabel "headlabel"-                      , parseField HeadPort "headport"-                      , parseField HeadTarget "headtarget"-                      , parseField HeadTooltip "headtooltip"-                      , parseField Height "height"-                      , parseField ID "id"-                      , parseField Image "image"-                      , parseFieldDef ImageScale UniformScale "imagescale"-                      , parseFields LabelURL ["labelURL", "labelhref"]-                      , parseField LabelAngle "labelangle"-                      , parseField LabelDistance "labeldistance"-                      , parseFieldBool LabelFloat "labelfloat"-                      , parseField LabelFontColor "labelfontcolor"-                      , parseField LabelFontName "labelfontname"-                      , parseField LabelFontSize "labelfontsize"-                      , parseField LabelJust "labeljust"-                      , parseField LabelLoc "labelloc"-                      , parseField LabelTarget "labeltarget"-                      , parseField LabelTooltip "labeltooltip"-                      , parseField Label "label"-                      , parseFieldBool Landscape "landscape"-                      , parseField LayerSep "layersep"-                      , parseField Layers "layers"-                      , parseField Layer "layer"-                      , parseField Layout "layout"-                      , parseField Len "len"-                      , parseField LevelsGap "levelsgap"-                      , parseField Levels "levels"-                      , parseField LHead "lhead"-                      , parseField LPos "lp"-                      , parseField LTail "ltail"-                      , parseField Margin "margin"-                      , parseField MaxIter "maxiter"-                      , parseField MCLimit "mclimit"-                      , parseField MinDist "mindist"-                      , parseField MinLen "minlen"-                      , parseField Model "model"-                      , parseField Mode "mode"-                      , parseFieldBool Mosek "mosek"-                      , parseField NodeSep "nodesep"-                      , parseFieldBool NoJustify "nojustify"-                      , parseFieldBool Normalize "normalize"-                      , parseField Nslimit1 "nslimit1"-                      , parseField Nslimit "nslimit"-                      , parseField Ordering "ordering"-                      , parseField Orientation "orientation"-                      , parseField OutputOrder "outputorder"-                      , parseField OverlapScaling "overlap_scaling"-                      , parseFieldDef Overlap KeepOverlaps "overlap"-                      , parseField PackMode "packmode"-                      , parseFieldDef Pack DoPack "pack"-                      , parseField Pad "pad"-                      , parseField PageDir "pagedir"-                      , parseField Page "page"-                      , parseField PenColor "pencolor"-                      , parseField PenWidth "penwidth"-                      , parseField Peripheries "peripheries"-                      , parseFieldBool Pin "pin"-                      , parseField Pos "pos"-                      , parseFieldDef QuadTree NormalQT "quadtree"-                      , parseField Quantum "quantum"-                      , parseField RankDir "rankdir"-                      , parseField RankSep "ranksep"-                      , parseField Rank "rank"-                      , parseField Ratio "ratio"-                      , parseField Rects "rects"-                      , parseFieldBool Regular "regular"-                      , parseFieldBool ReMinCross "remincross"-                      , parseField RepulsiveForce "repulsiveforce"-                      , parseFieldDef Root IsCentral "root"-                      , parseField Rotate "rotate"-                      , parseField SameHead "samehead"-                      , parseField SameTail "sametail"-                      , parseField SamplePoints "samplepoints"-                      , parseField SearchSize "searchsize"-                      , parseField Sep "sep"-                      , parseField ShapeFile "shapefile"-                      , parseField Shape "shape"-                      , parseField ShowBoxes "showboxes"-                      , parseField Sides "sides"-                      , parseField Size "size"-                      , parseField Skew "skew"-                      , parseField Smoothing "smoothing"-                      , parseField SortV "sortv"-                      , parseFieldDef Splines SplineEdges "splines"-                      , parseField Start "start"-                      , parseField StyleSheet "stylesheet"-                      , parseField Style "style"-                      , parseFields TailURL ["tailURL", "tailhref"]-                      , parseFieldBool TailClip "tailclip"-                      , parseField TailLabel "taillabel"-                      , parseField TailPort "tailport"-                      , parseField TailTarget "tailtarget"-                      , parseField TailTooltip "tailtooltip"-                      , parseField Target "target"-                      , parseField Tooltip "tooltip"-                      , parseFieldBool TrueColor "truecolor"-                      , parseField Vertices "vertices"-                      , parseField ViewPort "viewport"-                      , parseField VoroMargin "voro_margin"-                      , parseField Weight "weight"-                      , parseField Width "width"-                      , parseField Z "z"-                      , liftM2 UnknownAttribute stringBlock (parseEq >> parse)-                      ]--    parse = parseUnqt--    parseList = parseUnqtList---- | Determine if this 'Attribute' is valid for use with Graphs.-usedByGraphs                      :: Attribute -> Bool-usedByGraphs Damping{}            = True-usedByGraphs K{}                  = True-usedByGraphs URL{}                = True-usedByGraphs Aspect{}             = True-usedByGraphs 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 Dimen{}              = True-usedByGraphs Dim{}                = 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 LabelJust{}          = True-usedByGraphs LabelLoc{}           = True-usedByGraphs Label{}              = True-usedByGraphs Landscape{}          = True-usedByGraphs LayerSep{}           = True-usedByGraphs Layers{}             = True-usedByGraphs Layout{}             = True-usedByGraphs LevelsGap{}          = True-usedByGraphs Levels{}             = True-usedByGraphs LPos{}               = True-usedByGraphs Margin{}             = True-usedByGraphs MaxIter{}            = True-usedByGraphs MCLimit{}            = True-usedByGraphs MinDist{}            = True-usedByGraphs Model{}              = True-usedByGraphs Mode{}               = True-usedByGraphs Mosek{}              = True-usedByGraphs NodeSep{}            = True-usedByGraphs NoJustify{}          = True-usedByGraphs Normalize{}          = True-usedByGraphs Nslimit1{}           = True-usedByGraphs Nslimit{}            = True-usedByGraphs Ordering{}           = True-usedByGraphs OutputOrder{}        = True-usedByGraphs OverlapScaling{}     = True-usedByGraphs Overlap{}            = True-usedByGraphs PackMode{}           = True-usedByGraphs Pack{}               = True-usedByGraphs Pad{}                = True-usedByGraphs PageDir{}            = True-usedByGraphs Page{}               = 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 UnknownAttribute{}   = 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 ColorScheme{}      = True-usedByClusters Color{}            = True-usedByClusters FillColor{}        = True-usedByClusters FontColor{}        = True-usedByClusters FontName{}         = True-usedByClusters FontSize{}         = True-usedByClusters LabelJust{}        = True-usedByClusters LabelLoc{}         = True-usedByClusters Label{}            = 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 UnknownAttribute{} = True-usedByClusters _                  = False---- | Determine if this 'Attribute' is valid for use with SubGraphs.-usedBySubGraphs                    :: Attribute -> Bool-usedBySubGraphs Rank{}             = True-usedBySubGraphs UnknownAttribute{} = True-usedBySubGraphs _                  = False---- | Determine if this 'Attribute' is valid for use with Nodes.-usedByNodes                    :: Attribute -> Bool-usedByNodes URL{}              = True-usedByNodes ColorScheme{}      = True-usedByNodes Color{}            = True-usedByNodes Comment{}          = True-usedByNodes Distortion{}       = True-usedByNodes FillColor{}        = True-usedByNodes FixedSize{}        = True-usedByNodes FontColor{}        = True-usedByNodes FontName{}         = True-usedByNodes FontSize{}         = True-usedByNodes Group{}            = True-usedByNodes Height{}           = True-usedByNodes ID{}               = True-usedByNodes Image{}            = True-usedByNodes ImageScale{}       = True-usedByNodes LabelLoc{}         = True-usedByNodes Label{}            = 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 ShapeFile{}        = True-usedByNodes Shape{}            = True-usedByNodes ShowBoxes{}        = True-usedByNodes Sides{}            = True-usedByNodes Skew{}             = True-usedByNodes SortV{}            = True-usedByNodes Style{}            = True-usedByNodes Target{}           = True-usedByNodes Tooltip{}          = True-usedByNodes Vertices{}         = True-usedByNodes Width{}            = True-usedByNodes Z{}                = True-usedByNodes UnknownAttribute{} = True-usedByNodes _                  = False---- | Determine if this 'Attribute' is valid for use with Edges.-usedByEdges                    :: Attribute -> Bool-usedByEdges URL{}              = True-usedByEdges ArrowHead{}        = True-usedByEdges ArrowSize{}        = True-usedByEdges ArrowTail{}        = True-usedByEdges ColorScheme{}      = True-usedByEdges Color{}            = True-usedByEdges Comment{}          = True-usedByEdges Constraint{}       = True-usedByEdges Decorate{}         = True-usedByEdges Dir{}              = True-usedByEdges EdgeURL{}          = True-usedByEdges EdgeTarget{}       = True-usedByEdges EdgeTooltip{}      = True-usedByEdges 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 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 Label{}            = 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 UnknownAttribute{} = True-usedByEdges _                  = False---- | Determine if two 'Attributes' are the same type of 'Attribute'.-sameAttribute                                                 :: Attribute -> Attribute -> Bool-sameAttribute Damping{}               Damping{}               = True-sameAttribute K{}                     K{}                     = True-sameAttribute URL{}                   URL{}                   = True-sameAttribute ArrowHead{}             ArrowHead{}             = True-sameAttribute ArrowSize{}             ArrowSize{}             = True-sameAttribute ArrowTail{}             ArrowTail{}             = True-sameAttribute Aspect{}                Aspect{}                = True-sameAttribute Bb{}                    Bb{}                    = True-sameAttribute BgColor{}               BgColor{}               = True-sameAttribute Center{}                Center{}                = True-sameAttribute Charset{}               Charset{}               = True-sameAttribute ClusterRank{}           ClusterRank{}           = True-sameAttribute ColorScheme{}           ColorScheme{}           = True-sameAttribute Color{}                 Color{}                 = True-sameAttribute Comment{}               Comment{}               = True-sameAttribute Compound{}              Compound{}              = True-sameAttribute Concentrate{}           Concentrate{}           = True-sameAttribute Constraint{}            Constraint{}            = True-sameAttribute Decorate{}              Decorate{}              = True-sameAttribute DefaultDist{}           DefaultDist{}           = True-sameAttribute Dimen{}                 Dimen{}                 = True-sameAttribute Dim{}                   Dim{}                   = True-sameAttribute Dir{}                   Dir{}                   = True-sameAttribute DirEdgeConstraints{}    DirEdgeConstraints{}    = True-sameAttribute Distortion{}            Distortion{}            = True-sameAttribute DPI{}                   DPI{}                   = True-sameAttribute EdgeURL{}               EdgeURL{}               = True-sameAttribute EdgeTarget{}            EdgeTarget{}            = True-sameAttribute EdgeTooltip{}           EdgeTooltip{}           = True-sameAttribute Epsilon{}               Epsilon{}               = True-sameAttribute ESep{}                  ESep{}                  = True-sameAttribute FillColor{}             FillColor{}             = True-sameAttribute FixedSize{}             FixedSize{}             = True-sameAttribute FontColor{}             FontColor{}             = True-sameAttribute FontName{}              FontName{}              = True-sameAttribute FontNames{}             FontNames{}             = True-sameAttribute FontPath{}              FontPath{}              = True-sameAttribute FontSize{}              FontSize{}              = True-sameAttribute Group{}                 Group{}                 = True-sameAttribute HeadURL{}               HeadURL{}               = True-sameAttribute HeadClip{}              HeadClip{}              = True-sameAttribute HeadLabel{}             HeadLabel{}             = True-sameAttribute HeadPort{}              HeadPort{}              = True-sameAttribute HeadTarget{}            HeadTarget{}            = True-sameAttribute HeadTooltip{}           HeadTooltip{}           = True-sameAttribute Height{}                Height{}                = True-sameAttribute ID{}                    ID{}                    = True-sameAttribute Image{}                 Image{}                 = True-sameAttribute ImageScale{}            ImageScale{}            = True-sameAttribute LabelURL{}              LabelURL{}              = True-sameAttribute LabelAngle{}            LabelAngle{}            = True-sameAttribute LabelDistance{}         LabelDistance{}         = True-sameAttribute LabelFloat{}            LabelFloat{}            = True-sameAttribute LabelFontColor{}        LabelFontColor{}        = True-sameAttribute LabelFontName{}         LabelFontName{}         = True-sameAttribute LabelFontSize{}         LabelFontSize{}         = True-sameAttribute LabelJust{}             LabelJust{}             = True-sameAttribute LabelLoc{}              LabelLoc{}              = True-sameAttribute LabelTarget{}           LabelTarget{}           = True-sameAttribute LabelTooltip{}          LabelTooltip{}          = True-sameAttribute Label{}                 Label{}                 = True-sameAttribute Landscape{}             Landscape{}             = True-sameAttribute LayerSep{}              LayerSep{}              = True-sameAttribute Layers{}                Layers{}                = True-sameAttribute Layer{}                 Layer{}                 = True-sameAttribute Layout{}                Layout{}                = True-sameAttribute Len{}                   Len{}                   = True-sameAttribute LevelsGap{}             LevelsGap{}             = True-sameAttribute Levels{}                Levels{}                = True-sameAttribute LHead{}                 LHead{}                 = True-sameAttribute LPos{}                  LPos{}                  = True-sameAttribute LTail{}                 LTail{}                 = True-sameAttribute Margin{}                Margin{}                = True-sameAttribute MaxIter{}               MaxIter{}               = True-sameAttribute MCLimit{}               MCLimit{}               = True-sameAttribute MinDist{}               MinDist{}               = True-sameAttribute MinLen{}                MinLen{}                = True-sameAttribute Model{}                 Model{}                 = True-sameAttribute Mode{}                  Mode{}                  = True-sameAttribute Mosek{}                 Mosek{}                 = True-sameAttribute NodeSep{}               NodeSep{}               = True-sameAttribute NoJustify{}             NoJustify{}             = True-sameAttribute Normalize{}             Normalize{}             = True-sameAttribute Nslimit1{}              Nslimit1{}              = True-sameAttribute Nslimit{}               Nslimit{}               = True-sameAttribute Ordering{}              Ordering{}              = True-sameAttribute Orientation{}           Orientation{}           = True-sameAttribute OutputOrder{}           OutputOrder{}           = True-sameAttribute OverlapScaling{}        OverlapScaling{}        = True-sameAttribute Overlap{}               Overlap{}               = True-sameAttribute PackMode{}              PackMode{}              = True-sameAttribute Pack{}                  Pack{}                  = True-sameAttribute Pad{}                   Pad{}                   = True-sameAttribute PageDir{}               PageDir{}               = True-sameAttribute Page{}                  Page{}                  = True-sameAttribute PenColor{}              PenColor{}              = True-sameAttribute PenWidth{}              PenWidth{}              = True-sameAttribute Peripheries{}           Peripheries{}           = True-sameAttribute Pin{}                   Pin{}                   = True-sameAttribute Pos{}                   Pos{}                   = True-sameAttribute QuadTree{}              QuadTree{}              = True-sameAttribute Quantum{}               Quantum{}               = True-sameAttribute RankDir{}               RankDir{}               = True-sameAttribute RankSep{}               RankSep{}               = True-sameAttribute Rank{}                  Rank{}                  = True-sameAttribute Ratio{}                 Ratio{}                 = True-sameAttribute Rects{}                 Rects{}                 = True-sameAttribute Regular{}               Regular{}               = True-sameAttribute ReMinCross{}            ReMinCross{}            = True-sameAttribute RepulsiveForce{}        RepulsiveForce{}        = True-sameAttribute Root{}                  Root{}                  = True-sameAttribute Rotate{}                Rotate{}                = True-sameAttribute SameHead{}              SameHead{}              = True-sameAttribute SameTail{}              SameTail{}              = True-sameAttribute SamplePoints{}          SamplePoints{}          = True-sameAttribute SearchSize{}            SearchSize{}            = True-sameAttribute Sep{}                   Sep{}                   = True-sameAttribute ShapeFile{}             ShapeFile{}             = True-sameAttribute Shape{}                 Shape{}                 = True-sameAttribute ShowBoxes{}             ShowBoxes{}             = True-sameAttribute Sides{}                 Sides{}                 = True-sameAttribute Size{}                  Size{}                  = True-sameAttribute Skew{}                  Skew{}                  = True-sameAttribute Smoothing{}             Smoothing{}             = True-sameAttribute SortV{}                 SortV{}                 = True-sameAttribute Splines{}               Splines{}               = True-sameAttribute Start{}                 Start{}                 = True-sameAttribute StyleSheet{}            StyleSheet{}            = True-sameAttribute Style{}                 Style{}                 = True-sameAttribute TailURL{}               TailURL{}               = True-sameAttribute TailClip{}              TailClip{}              = True-sameAttribute TailLabel{}             TailLabel{}             = True-sameAttribute TailPort{}              TailPort{}              = True-sameAttribute TailTarget{}            TailTarget{}            = True-sameAttribute TailTooltip{}           TailTooltip{}           = True-sameAttribute Target{}                Target{}                = True-sameAttribute Tooltip{}               Tooltip{}               = True-sameAttribute TrueColor{}             TrueColor{}             = True-sameAttribute Vertices{}              Vertices{}              = True-sameAttribute ViewPort{}              ViewPort{}              = True-sameAttribute VoroMargin{}            VoroMargin{}            = True-sameAttribute Weight{}                Weight{}                = True-sameAttribute Width{}                 Width{}                 = True-sameAttribute Z{}                     Z{}                     = True-sameAttribute (UnknownAttribute a1 _) (UnknownAttribute a2 _) = a1 == a2-sameAttribute _                       _                       = 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---- --------------------------------------------------------------------------------- | /Dot/ has a basic grammar of arrow shapes which allows usage of---   up to 1,544,761 different shapes from 9 different basic---   'ArrowShape's.  Note that whilst an explicit list is used in the---   definition of 'ArrowType', there must be at least one tuple and a---   maximum of 4 (since that is what is required by Dot).  For more---   information, see: <http://graphviz.org/doc/info/arrows.html>------   The 19 basic arrows shown on the overall attributes page have---   been defined below as a convenience.  Parsing of the 5---   backward-compatible special cases is also supported.-newtype ArrowType = AType [(ArrowModifier, ArrowShape)]-    deriving (Eq, Ord, Show, Read)--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 = specialArrowParse-                `onFail`-                do mas <- many1 $ do m <- parseUnqt-                                     a <- parseUnqt-                                     return (m,a)-                   return $ AType mas--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, Ord, Bounded, Enum, 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, Ord, Show, Read)---- | Apply no modifications to an 'ArrowShape'.-noMods :: ArrowModifier-noMods = ArrMod FilledArrow BothSides---- | 'OpenArrow' and 'BothSides'-openMod :: ArrowModifier-openMod = ArrMod OpenArrow BothSides--instance PrintDot ArrowModifier where-    unqtDot (ArrMod f s) = unqtDot f <> unqtDot s--instance ParseDot ArrowModifier where-    parseUnqt = do f <- parseUnqt-                   s <- parseUnqt-                   return $ ArrMod f s--data ArrowFill = OpenArrow-               | FilledArrow-                 deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ArrowFill where-    unqtDot OpenArrow   = char 'o'-    unqtDot FilledArrow = empty--instance ParseDot ArrowFill where-    parseUnqt = liftM (bool FilledArrow OpenArrow . isJust)-                $ optional (character 'o')--    -- Not used individually-    parse = parseUnqt---- | Represents which side (when looking towards the node the arrow is---   pointing to) is drawn.-data ArrowSide = LeftSide-               | RightSide-               | BothSides-                 deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ArrowSide where-    unqtDot LeftSide  = char 'l'-    unqtDot RightSide = char 'r'-    unqtDot BothSides = empty--instance ParseDot ArrowSide where-    parseUnqt = liftM getSideType-                $ optional (oneOf $ map character ['l', 'r'])-        where-          getSideType = maybe BothSides-                              (bool RightSide LeftSide . (==) 'l')--    -- Not used individually-    parse = parseUnqt---- -------------------------------------------------------------------------------data AspectType = RatioOnly Double-                | RatioPassCount Double Int-                  deriving (Eq, Ord, Show, Read)--instance PrintDot AspectType where-    unqtDot (RatioOnly r)        = unqtDot r-    unqtDot (RatioPassCount r p) = commaDel r p--    toDot at@RatioOnly{}      = unqtDot at-    toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at--instance ParseDot AspectType where-    parseUnqt = liftM (uncurry RatioPassCount) commaSepUnqt-                `onFail`-                liftM RatioOnly parseUnqt---    parse = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)-            `onFail`-            liftM RatioOnly parse---- --------------------------------------------------------------------------------- | Should only have 2D points (i.e. created with 'createPoint').-data Rect = Rect Point Point-            deriving (Eq, Ord, Show, Read)--instance PrintDot Rect where-    unqtDot (Rect p1 p2) = commaDel p1 p2--    toDot = doubleQuotes . unqtDot--instance ParseDot Rect where-    parseUnqt = liftM (uncurry Rect) $ commaSep' parsePoint2D parsePoint2D--    parse = quotedParse parseUnqt---- -------------------------------------------------------------------------------data ClusterMode = Local-                 | Global-                 | NoCluster-                   deriving (Eq, Ord, Bounded, Enum, 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, Ord, Bounded, Enum, 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, Ord, Bounded, Enum, Show, Read)--instance PrintDot DEConstraints where-    unqtDot EdgeConstraints = unqtDot True-    unqtDot NoConstraints   = unqtDot False-    unqtDot HierConstraints = text "hier"--instance ParseDot DEConstraints where-    parseUnqt = liftM (bool NoConstraints EdgeConstraints) parse-                `onFail`-                stringRep HierConstraints "hier"---- --------------------------------------------------------------------------------- | Either a 'Double' or a (2D) 'Point' (i.e. created with---   'createPoint').-data DPoint = DVal Double-            | PVal Point-             deriving (Eq, Ord, Show, Read)--instance PrintDot DPoint where-    unqtDot (DVal d) = unqtDot d-    unqtDot (PVal p) = unqtDot p--    toDot (DVal d) = toDot d-    toDot (PVal p) = toDot p--instance ParseDot DPoint where-    parseUnqt = liftM PVal parsePoint2D-                `onFail`-                liftM DVal parseUnqt--    parse = quotedParse parseUnqt-            `onFail`-            liftM DVal parseUnqt---- -------------------------------------------------------------------------------data ModeType = Major-              | KK-              | Hier-              | IpSep-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ModeType where-    unqtDot Major = text "major"-    unqtDot KK    = text "KK"-    unqtDot Hier  = text "hier"-    unqtDot IpSep = text "ipsep"--instance ParseDot ModeType where-    parseUnqt = oneOf [ stringRep Major "major"-                      , stringRep KK "KK"-                      , stringRep Hier "hier"-                      , stringRep IpSep "ipsep"-                      ]---- -------------------------------------------------------------------------------data Model = ShortPath-           | SubSet-           | Circuit-             deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Model where-    unqtDot ShortPath = text "shortpath"-    unqtDot SubSet    = text "subset"-    unqtDot Circuit   = text "circuit"--instance ParseDot Model where-    parseUnqt = oneOf [ stringRep ShortPath "shortpath"-                      , stringRep SubSet "subset"-                      , stringRep Circuit "circuit"-                      ]---- -------------------------------------------------------------------------------data Label = StrLabel EscString-           | HtmlLabel HtmlLabel -- ^ If 'PlainText' is used, the-                                 --   'HtmlLabel' value is the entire-                                 --   \"shape\"; if anything else-                                 --   except 'PointShape' is used then-                                 --   the 'HtmlLabel' is embedded-                                 --   within the shape.-           | RecordLabel RecordFields -- ^ For nodes only; requires-                                      --   either 'Record' or-                                      --   'MRecord' as the shape.-             deriving (Eq, Ord, Show, Read)--instance PrintDot Label where-    unqtDot (StrLabel s)     = unqtDot s-    unqtDot (HtmlLabel h)    = angled $ unqtDot h-    unqtDot (RecordLabel fs) = unqtDot fs--    toDot (StrLabel s)     = toDot s-    toDot h@HtmlLabel{}    = unqtDot h-    toDot (RecordLabel fs) = toDot fs--instance ParseDot Label where-    -- Don't have to worry about being able to tell the difference-    -- between an HtmlLabel and a RecordLabel starting with a PortPos,-    -- since the latter will be in quotes and the former won't.--    parseUnqt = oneOf [ liftM HtmlLabel $ parseAngled parseUnqt-                      , liftM RecordLabel parseUnqt-                      , liftM StrLabel parseUnqt-                      ]--    parse = oneOf [ liftM HtmlLabel $ parseAngled parse-                  , liftM RecordLabel parse-                  , liftM StrLabel parse-                  ]---- | A convenience class to make it easier to create labels.  It is---   highly recommended that you make any other types that you wish to---   create labels from an instance of this class, preferably via the---   @String@ instance.-class Labellable a where-  toLabel :: a -> Attribute--instance Labellable EscString where-  toLabel = Label . StrLabel--instance Labellable Char where-  toLabel = toLabel . (:[])--instance Labellable Int where-  toLabel = toLabel . show--instance Labellable Double where-  toLabel = toLabel . show--instance Labellable Bool where-  toLabel = toLabel . show--instance Labellable HtmlLabel where-  toLabel = Label . HtmlLabel--instance Labellable HtmlText where-  toLabel = toLabel . HtmlText--instance Labellable HtmlTable where-  toLabel = toLabel . HtmlTable--instance Labellable RecordFields where-  toLabel = Label . RecordLabel--instance Labellable RecordField where-  toLabel = toLabel . (:[])---- | A shorter variant than using @PortName@ from 'RecordField'.-instance Labellable PortName where-  toLabel = toLabel . PortName---- | A shorter variant than using 'LabelledTarget'.-instance Labellable (PortName, EscString) where-  toLabel = toLabel . uncurry LabelledTarget---- --------------------------------------------------------------------------------- | A RecordFields value should never be empty.-type RecordFields = [RecordField]---- | Specifies the sub-values of a record-based label.  By default,---   the cells are laid out horizontally; use 'FlipFields' to change---   the orientation of the fields (can be applied recursively).  To---   change the default orientation, use 'RankDir'.-data RecordField = LabelledTarget PortName EscString-                 | PortName PortName -- ^ Will result in no label for-                                     --   that cell.-                 | FieldLabel EscString-                 | FlipFields RecordFields-                   deriving (Eq, Ord, Show, Read)--instance PrintDot RecordField where-  -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.-  unqtDot (LabelledTarget t s) = printPortName t <+> unqtRecordString s-  unqtDot (PortName t)         = printPortName t-  unqtDot (FieldLabel s)       = unqtRecordString s-  unqtDot (FlipFields rs)      = braces $ unqtDot rs--  toDot (FieldLabel s) = printEscaped recordEscChars s-  toDot rf             = doubleQuotes $ unqtDot rf--  unqtListToDot [f] = unqtDot f-  unqtListToDot fs  = hsep . punctuate (char '|') $ map unqtDot fs--  listToDot [f] = toDot f-  listToDot fs  = doubleQuotes $ unqtListToDot fs--instance ParseDot RecordField where-  parseUnqt = do t <- liftM PN $ parseAngled parseRecord-                 ml <- optional (whitespace >> parseRecord)-                 return $ maybe (PortName t)-                                (LabelledTarget t)-                                ml-              `onFail`-              liftM FieldLabel parseRecord-              `onFail`-              liftM FlipFields (parseBraced parseUnqt)--  parse = quotedParse parseUnqt--  parseUnqtList = wrapWhitespace $ sepBy1 parseUnqt (wrapWhitespace $ character '|')--  -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it-  -- will cause parsing problems for other 'Label' types.-  parseList = do rfs <- quotedParse parseUnqtList-                 if validRFs rfs-                   then return rfs-                   else fail "This is a StrLabel, not a RecordLabel"-    where-      validRFs [FieldLabel str] = any (`elem` recordEscChars) str-      validRFs _                = True---- | Print a 'PortName' value as expected within a Record data---   structure.-printPortName :: PortName -> DotCode-printPortName = angled . unqtRecordString . portName--parseRecord :: Parse String-parseRecord = parseEscaped False recordEscChars []--unqtRecordString :: String -> DotCode-unqtRecordString = unqtEscaped recordEscChars--recordEscChars :: [Char]-recordEscChars = ['{', '}', '|', ' ', '<', '>']---- -------------------------------------------------------------------------------data Point = Point { xCoord   :: Double-                   , yCoord   :: Double-                      -- | Can only be 'Just' for @'Dim' 3@ or greater.-                   , zCoord   :: Maybe Double-                     -- | Input to Graphviz only: specify that the-                     --   node position should not change.-                   , forcePos :: Bool-                   }-           deriving (Eq, Ord, Show, Read)---- | Create a point with only @x@ and @y@ values.-createPoint     :: Double -> Double -> Point-createPoint x y = Point x y Nothing False--parsePoint2D :: Parse Point-parsePoint2D = liftM (uncurry createPoint) commaSepUnqt--instance PrintDot Point where-    unqtDot (Point x y mz frs) = bool id (<> char '!') frs-                                 . maybe id (\ z -> (<> unqtDot z) . (<> comma)) mz-                                 $ commaDel x y--    toDot = doubleQuotes . unqtDot--    unqtListToDot = hsep . map unqtDot--    listToDot = doubleQuotes . unqtListToDot--instance ParseDot Point where-    parseUnqt = do (x,y) <- commaSepUnqt-                   mz <- optional $ parseComma >> parseUnqt-                   bng <- liftM isJust . optional $ character '!'-                   return $ Point x y mz bng--    parse = quotedParse parseUnqt--    parseUnqtList = sepBy1 parseUnqt whitespace---- -------------------------------------------------------------------------------data Overlap = KeepOverlaps-             | RemoveOverlaps-             | ScaleOverlaps-             | ScaleXYOverlaps-             | PrismOverlap (Maybe Word16) -- ^ Only when sfdp is-                                           --   available, @'Nothing'@-                                           --   is equivalent to-                                           --   @'Just' 1000@.-             | CompressOverlap-             | VpscOverlap-             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@-               deriving (Eq, Ord, Show, Read)--instance PrintDot Overlap where-    unqtDot KeepOverlaps     = unqtDot True-    unqtDot 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 ScaleXYOverlaps "scalexy"-                      , stringRep ScaleOverlaps "scale"-                      , string "prism" >> liftM PrismOverlap (optional parse)-                      , stringRep CompressOverlap "compress"-                      , stringRep VpscOverlap "vpsc"-                      , stringRep IpsepOverlap "ipsep"-                      ]---- -------------------------------------------------------------------------------data LayerRange = LRID LayerID-                | LRS LayerID LayerID-                  deriving (Eq, Ord, Show, Read)--instance PrintDot LayerRange where-    unqtDot (LRID lid)    = unqtDot lid-    unqtDot (LRS id1 id2) = unqtDot id1 <> s <> unqtDot id2-      where-        s = unqtDot $ head defLayerSep--    toDot (LRID lid) = toDot lid-    toDot lrs        = doubleQuotes $ unqtDot lrs--instance ParseDot LayerRange where-    parseUnqt = do id1 <- parseUnqt-                   _   <- parseLayerSep-                   id2 <- parseUnqt-                   return $ LRS id1 id2-                `onFail`-                liftM LRID parseUnqt---    parse = quotedParse ( do id1 <- parseUnqt-                             _   <- parseLayerSep-                             id2 <- parseUnqt-                             return $ LRS id1 id2-                        )-            `onFail`-            liftM LRID parse--parseLayerSep :: Parse String-parseLayerSep = many1 . oneOf-                $ map character defLayerSep---- | The default separators for 'LayerSep'.-defLayerSep :: [Char]-defLayerSep = [' ', ':', '\t']--parseLayerName :: Parse String-parseLayerName = parseEscaped False [] defLayerSep--parseLayerName' :: Parse String-parseLayerName' = stringBlock-                  `onFail`-                  quotedParse parseLayerName--notLayerSep :: Char -> Bool-notLayerSep = flip notElem defLayerSep---- | You should not have any layer separator characters for the---   'LRName' option, as they won't be parseable.-data LayerID = AllLayers-             | LRInt Int-             | LRName String -- ^ Should not be a number of @"all"@.-               deriving (Eq, Ord, Show, Read)--instance PrintDot LayerID where-    unqtDot AllLayers   = text "all"-    unqtDot (LRInt n)   = unqtDot n-    unqtDot (LRName nm) = unqtDot nm--    toDot (LRName nm) = toDot nm-    -- Other two don't need quotes-    toDot li          = unqtDot li--    unqtListToDot = hcat . punctuate s . map unqtDot-      where-        s = unqtDot $ head defLayerSep--    listToDot [l] = toDot l-    -- Might not need quotes, but probably will.  Can't tell either-    -- way since we don't know what the separator character will be.-    listToDot ll  = doubleQuotes $ unqtDot ll--instance ParseDot LayerID where-    parseUnqt = liftM checkLayerName parseLayerName -- tests for Int and All--    parse = oneOf [ liftM checkLayerName parseLayerName'-                  , liftM LRInt parse -- Mainly for unquoted case.-                  ]--checkLayerName     :: String -> LayerID-checkLayerName str = maybe checkAll LRInt $ stringToInt str-  where-    checkAll = if map toLower str == "all"-               then AllLayers-               else LRName str---- | A non-empty list of layer names.  The names should all be---   'LRName' values, and when printed will use an arbitrary character---   from 'defLayerSep'.-newtype LayerList = LL [LayerID]-                  deriving (Eq, Ord, Show, Read)--instance PrintDot LayerList where-  unqtDot (LL ll) = unqtDot ll--  toDot (LL ll) = toDot ll--instance ParseDot LayerList where-  parseUnqt = liftM LL $ sepBy1 parseUnqt parseLayerSep--  parse = quotedParse parseUnqt-          `onFail`-          liftM (LL . (:[]) . LRName) stringBlock---- -------------------------------------------------------------------------------data OutputMode = BreadthFirst | NodesFirst | EdgesFirst-                  deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot OutputMode where-    unqtDot BreadthFirst = text "breadthfirst"-    unqtDot NodesFirst   = text "nodesfirst"-    unqtDot EdgesFirst   = text "edgesfirst"--instance ParseDot OutputMode where-    parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"-                      , stringRep NodesFirst "nodesfirst"-                      , stringRep EdgesFirst "edgesfirst"-                      ]---- -------------------------------------------------------------------------------data Pack = DoPack-          | DontPack-          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.-            deriving (Eq, Ord, Show, Read)--instance PrintDot Pack where-    unqtDot DoPack         = unqtDot True-    unqtDot DontPack       = unqtDot False-    unqtDot (PackMargin m) = unqtDot m--instance ParseDot Pack where-    -- What happens if it parses 0?  It's non-negative, but parses as False-    parseUnqt = oneOf [ liftM PackMargin parseUnqt-                      , liftM (bool DontPack DoPack) onlyBool-                      ]---- -------------------------------------------------------------------------------data PackMode = PackNode-              | PackClust-              | PackGraph-              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort-                                                -- by user, number of-                                                -- rows/cols-                deriving (Eq, Ord, Show, Read)--instance PrintDot PackMode where-    unqtDot PackNode           = text "node"-    unqtDot PackClust          = text "clust"-    unqtDot PackGraph          = text "graph"-    unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder-                                 $ text "array"-        where-          addNum = maybe id (flip (<>) . unqtDot) mi-          isUnder = if c || u-                    then flip (<>) $ char '_'-                    else id-          isC = if c-                then flip (<>) $ char 'c'-                else id-          isU = if u-                then flip (<>) $ char 'u'-                else id--instance ParseDot PackMode where-    parseUnqt = oneOf [ stringRep PackNode "node"-                      , stringRep PackClust "clust"-                      , stringRep PackGraph "graph"-                      , do string "array"-                           mcu <- optional $ do character '_'-                                                many1 $ satisfy isCU-                           let c = hasCharacter mcu 'c'-                               u = hasCharacter mcu 'u'-                           mi <- optional parseUnqt-                           return $ PackArray c u mi-                      ]-        where-          hasCharacter ms c = maybe False (elem c) ms-          -- Also checks and removes quote characters-          isCU = flip elem ['c', 'u']---- -------------------------------------------------------------------------------data Pos = PointPos Point-         | SplinePos [Spline]-           deriving (Eq, Ord, Show, Read)--instance PrintDot Pos where-    unqtDot (PointPos p)   = unqtDot p-    unqtDot (SplinePos ss) = unqtDot ss--    toDot (PointPos p)   = toDot p-    toDot (SplinePos ss) = toDot ss--instance ParseDot Pos where-    -- Have to be careful with this: if we try to parse points first,-    -- then a spline with no start and end points will erroneously get-    -- parsed as a point and then the parser will crash as it expects-    -- a closing quote character...-    parseUnqt = do splns <- parseUnqt-                   case splns of-                     [Spline Nothing Nothing [p]] -> return $ PointPos p-                     _                            -> return $ SplinePos splns--    parse = quotedParse parseUnqt---- --------------------------------------------------------------------------------- | Controls how (and if) edges are represented.-data EdgeType = SplineEdges-              | LineEdges-              | NoEdges-              | PolyLine-              | CompoundEdge -- ^ fdp only-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot EdgeType where-    unqtDot SplineEdges  = toDot True-    unqtDot LineEdges    = toDot False-    unqtDot NoEdges      = empty-    unqtDot PolyLine     = text "polyline"-    unqtDot CompoundEdge = text "compound"--    toDot NoEdges = doubleQuotes empty-    toDot et      = unqtDot et--instance ParseDot EdgeType where-    -- Can't parse NoEdges without quotes.-    parseUnqt = oneOf [ liftM (bool LineEdges SplineEdges) parse-                      , stringRep SplineEdges "spline"-                      , stringRep LineEdges "line"-                      , stringRep PolyLine "polyline"-                      , stringRep CompoundEdge "compound"-                      ]--    parse = stringRep NoEdges "\"\""-            `onFail`-            optionalQuoted parseUnqt---- --------------------------------------------------------------------------------- | Upper-case first character is major order;---   lower-case second character is minor order.-data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt-               deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot PageDir where-    unqtDot Bl = text "BL"-    unqtDot Br = text "BR"-    unqtDot Tl = text "TL"-    unqtDot Tr = text "TR"-    unqtDot Rb = text "RB"-    unqtDot Rt = text "RT"-    unqtDot Lb = text "LB"-    unqtDot Lt = text "LT"--instance ParseDot PageDir where-    parseUnqt = 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, Ord, 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 = hcat . punctuate semi . map unqtDot--    listToDot = doubleQuotes . unqtListToDot--instance ParseDot Spline where-    parseUnqt = do ms <- parseP 's'-                   me <- parseP 'e'-                   ps <- sepBy1 parseUnqt whitespace-                   return $ Spline ms me ps-        where-          parseP t = optional $ do character t-                                   parseComma-                                   parseUnqt `discard` whitespace--    parse = quotedParse parseUnqt--    parseUnqtList = sepBy1 parseUnqt (character ';')---- -------------------------------------------------------------------------------data QuadType = NormalQT-              | FastQT-              | NoQT-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot QuadType where-    unqtDot NormalQT = text "normal"-    unqtDot FastQT   = text "fast"-    unqtDot NoQT     = text "none"--instance ParseDot QuadType where-    -- Have to take into account the slightly different interpretation-    -- of Bool used as an option for parsing QuadType-    parseUnqt = oneOf [ stringRep NormalQT "normal"-                      , stringRep FastQT "fast"-                      , stringRep NoQT "none"-                      , character '2'   >> return FastQT -- weird bool-                      , liftM (bool NoQT NormalQT) parse-                      ]---- --------------------------------------------------------------------------------- | Specify the root node either as a Node attribute or a Graph attribute.-data Root = IsCentral       -- ^ For Nodes only-          | NotCentral      -- ^ For Nodes only-          | NodeName String -- ^ For Graphs only-            deriving (Eq, Ord, Show, Read)--instance PrintDot Root where-    unqtDot IsCentral    = unqtDot True-    unqtDot NotCentral   = unqtDot False-    unqtDot (NodeName n) = unqtDot n--    toDot (NodeName n) = toDot n-    toDot r            = unqtDot r--instance ParseDot Root where-    parseUnqt = liftM (bool NotCentral IsCentral) onlyBool-                `onFail`-                liftM NodeName parseUnqt--    parse = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool)-            `onFail`-            liftM NodeName parse---- -------------------------------------------------------------------------------data RankType = SameRank-              | MinRank-              | SourceRank-              | MaxRank-              | SinkRank-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot RankType where-    unqtDot SameRank   = text "same"-    unqtDot MinRank    = text "min"-    unqtDot SourceRank = text "source"-    unqtDot MaxRank    = text "max"-    unqtDot SinkRank   = text "sink"--instance ParseDot RankType where-    parseUnqt = oneOf [ stringRep SameRank "same"-                      , stringRep MinRank "min"-                      , stringRep SourceRank "source"-                      , stringRep MaxRank "max"-                      , stringRep SinkRank "sink"-                      ]---- -------------------------------------------------------------------------------data RankDir = FromTop-             | FromLeft-             | FromBottom-             | FromRight-               deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot RankDir where-    unqtDot FromTop    = text "TB"-    unqtDot FromLeft   = text "LR"-    unqtDot FromBottom = text "BT"-    unqtDot FromRight  = text "RL"--instance ParseDot RankDir where-    parseUnqt = oneOf [ stringRep FromTop "TB"-                      , stringRep FromLeft "LR"-                      , stringRep FromBottom "BT"-                      , stringRep FromRight "RL"-                      ]---- -------------------------------------------------------------------------------data Shape-    = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.-    | Polygon-    | Ellipse-    | Circle-    | PointShape-    | Egg-    | Triangle-    | PlainText -- ^ Has synonym of /none/.-    | DiamondShape-    | Trapezium-    | Parallelogram-    | House-    | Pentagon-    | Hexagon-    | Septagon-    | Octagon-    | DoubleCircle-    | DoubleOctagon-    | TripleOctagon-    | InvTriangle-    | InvTrapezium-    | InvHouse-    | MDiamond-    | MSquare-    | MCircle-    | Note-    | Tab-    | Folder-    | Box3D-    | Component-    | Record -- ^ Must specify the record shape with a 'Label'.-    | MRecord -- ^ Must specify the record shape with a 'Label'.-      deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Shape where-    unqtDot BoxShape      = text "box"-    unqtDot Polygon       = text "polygon"-    unqtDot Ellipse       = text "ellipse"-    unqtDot Circle        = text "circle"-    unqtDot PointShape    = text "point"-    unqtDot Egg           = text "egg"-    unqtDot Triangle      = text "triangle"-    unqtDot PlainText     = text "plaintext"-    unqtDot DiamondShape  = text "diamond"-    unqtDot Trapezium     = text "trapezium"-    unqtDot Parallelogram = text "parallelogram"-    unqtDot House         = text "house"-    unqtDot Pentagon      = text "pentagon"-    unqtDot Hexagon       = text "hexagon"-    unqtDot Septagon      = text "septagon"-    unqtDot Octagon       = text "octagon"-    unqtDot DoubleCircle  = text "doublecircle"-    unqtDot DoubleOctagon = text "doubleoctagon"-    unqtDot TripleOctagon = text "tripleoctagon"-    unqtDot InvTriangle   = text "invtriangle"-    unqtDot InvTrapezium  = text "invtrapezium"-    unqtDot InvHouse      = text "invhouse"-    unqtDot MDiamond      = text "Mdiamond"-    unqtDot MSquare       = text "Msquare"-    unqtDot MCircle       = text "Mcircle"-    unqtDot Note          = text "note"-    unqtDot Tab           = text "tab"-    unqtDot Folder        = text "folder"-    unqtDot Box3D         = text "box3d"-    unqtDot Component     = text "component"-    unqtDot Record        = text "record"-    unqtDot MRecord       = text "Mrecord"--instance ParseDot Shape where-    parseUnqt = oneOf [ stringRep Box3D "box3d" -- Parse this before "box"-                      , stringReps BoxShape ["box","rectangle","rect"]-                      , stringRep Polygon "polygon"-                      , stringRep Ellipse "ellipse"-                      , stringRep Circle "circle"-                      , stringRep PointShape "point"-                      , stringRep Egg "egg"-                      , stringRep Triangle "triangle"-                      , stringReps PlainText ["plaintext","none"]-                      , 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 Note "note"-                      , stringRep Tab "tab"-                      , stringRep Folder "folder"-                      , stringRep Component "component"-                      , stringRep Record "record"-                      , stringRep MRecord "Mrecord"-                      ]---- -------------------------------------------------------------------------------data SmoothType = NoSmooth-                | AvgDist-                | GraphDist-                | PowerDist-                | RNG-                | Spring-                | TriangleSmooth-                  deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot SmoothType where-    unqtDot NoSmooth       = text "none"-    unqtDot AvgDist        = text "avg_dist"-    unqtDot GraphDist      = text "graph_dist"-    unqtDot PowerDist      = text "power_dist"-    unqtDot RNG            = text "rng"-    unqtDot Spring         = text "spring"-    unqtDot TriangleSmooth = text "triangle"--instance ParseDot SmoothType where-    parseUnqt = oneOf [ stringRep NoSmooth "none"-                      , stringRep AvgDist "avg_dist"-                      , stringRep GraphDist "graph_dist"-                      , stringRep PowerDist "power_dist"-                      , stringRep RNG "rng"-                      , stringRep Spring "spring"-                      , stringRep TriangleSmooth "triangle"-                      ]---- -------------------------------------------------------------------------------data StartType = StartStyle STStyle-               | StartSeed Int-               | StartStyleSeed STStyle Int-                 deriving (Eq, Ord, Show, Read)--instance PrintDot StartType where-    unqtDot (StartStyle ss)       = unqtDot ss-    unqtDot (StartSeed s)         = unqtDot s-    unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s--instance ParseDot StartType where-    parseUnqt = oneOf [ do ss <- parseUnqt-                           s  <- parseUnqt-                           return $ StartStyleSeed ss s-                      , liftM StartStyle parseUnqt-                      , liftM StartSeed parseUnqt-                      ]--data STStyle = RegularStyle-             | SelfStyle-             | RandomStyle-               deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot STStyle where-    unqtDot RegularStyle = text "regular"-    unqtDot SelfStyle    = text "self"-    unqtDot RandomStyle  = text "random"--instance ParseDot STStyle where-    parseUnqt = oneOf [ stringRep RegularStyle "regular"-                      , stringRep SelfStyle "self"-                      , stringRep RandomStyle "random"-                      ]---- --------------------------------------------------------------------------------- | An individual style item.  Except for 'DD', the @['String']@---   should be empty.-data StyleItem = SItem StyleName [String]-             deriving (Eq, Ord, Show, Read)--instance PrintDot StyleItem where-    unqtDot (SItem nm args)-        | null args = dnm-        | otherwise = dnm <> parens args'-        where-          dnm = unqtDot nm-          args' = hcat . punctuate comma $ 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--    parse = quotedParse (liftM2 SItem parseUnqt parseArgs)-            `onFail`-            liftM (flip SItem []) parse--    parseUnqtList = sepBy1 parseUnqt parseComma--    parseList = quotedParse parseUnqtList-                `onFail`-                -- Might not necessarily need to be quoted if a singleton...-                liftM return parse--parseArgs :: Parse [String]-parseArgs = bracketSep (character '(')-                       parseComma-                       (character ')')-                       parseStyleName--data StyleName = Dashed    -- ^ Nodes and Edges-               | Dotted    -- ^ Nodes and Edges-               | Solid     -- ^ Nodes and Edges-               | Bold      -- ^ Nodes and Edges-               | Invisible -- ^ Nodes and Edges-               | Filled    -- ^ Nodes and Clusters-               | Diagonals -- ^ Nodes only-               | Rounded   -- ^ Nodes and Clusters-               | DD String -- ^ Device Dependent-                 deriving (Eq, Ord, Show, Read)--instance PrintDot StyleName where-    unqtDot Dashed    = text "dashed"-    unqtDot Dotted    = text "dotted"-    unqtDot Solid     = text "solid"-    unqtDot Bold      = text "bold"-    unqtDot Invisible = text "invis"-    unqtDot Filled    = text "filled"-    unqtDot Diagonals = text "diagonals"-    unqtDot Rounded   = text "rounded"-    unqtDot (DD nm)   = unqtDot nm--    toDot (DD nm) = toDot nm-    toDot sn      = unqtDot sn--instance ParseDot StyleName where-    parseUnqt = liftM checkDD parseStyleName--    parse = quotedParse parseUnqt-            `onFail`-            liftM checkDD quotelessString--checkDD     :: String -> StyleName-checkDD str = case map toLower str of-                "dashed"    -> Dashed-                "dotted"    -> Dotted-                "solid"     -> Solid-                "bold"      -> Bold-                "invis"     -> Invisible-                "filled"    -> Filled-                "diagonals" -> Diagonals-                "rounded"   -> Rounded-                _           -> DD str--parseStyleName :: Parse String-parseStyleName = do f <- orEscaped . noneOf $ ' ' : disallowedChars-                    r <- parseEscaped True [] disallowedChars-                    return $ f:r-  where-    disallowedChars = [quoteChar, '(', ')', ',']-    -- Used because the first character has slightly stricter requirements than the rest.-    orSlash p = stringRep '\\' "\\\\" `onFail` p-    orEscaped = orQuote . orSlash---- -------------------------------------------------------------------------------data ViewPort = VP { wVal  :: Double-                   , hVal  :: Double-                   , zVal  :: Double-                   , focus :: Maybe FocusType-                   }-                deriving (Eq, Ord, Show, Read)--instance PrintDot ViewPort where-    unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)-                 $ focus vp-        where-          vs = hcat . punctuate comma-               $ 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---- | For use with 'ViewPort'.-data FocusType = XY Point-               | NodeFocus String-                 deriving (Eq, Ord, Show, Read)--instance PrintDot FocusType where-    unqtDot (XY p)         = unqtDot p-    unqtDot (NodeFocus nm) = unqtDot nm--    toDot (XY p)         = toDot p-    toDot (NodeFocus nm) = toDot nm--instance ParseDot FocusType where-    parseUnqt = liftM XY parseUnqt-                `onFail`-                liftM NodeFocus parseUnqt--    parse = liftM XY parse-            `onFail`-            liftM NodeFocus parse---- -------------------------------------------------------------------------------data VerticalPlacement = VTop-                       | VCenter -- ^ Only valid for Nodes.-                       | VBottom-                         deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot VerticalPlacement where-    unqtDot VTop    = char 't'-    unqtDot VCenter = char 'c'-    unqtDot VBottom = char 'b'--instance ParseDot VerticalPlacement where-    parseUnqt = oneOf [ stringRep VTop "t"-                      , stringRep VCenter "c"-                      , stringRep VBottom "b"-                      ]---- -------------------------------------------------------------------------------data ScaleType = UniformScale-               | NoScale-               | FillWidth-               | FillHeight-               | FillBoth-                 deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot ScaleType where-    unqtDot UniformScale = unqtDot True-    unqtDot NoScale      = unqtDot False-    unqtDot FillWidth    = text "width"-    unqtDot FillHeight   = text "height"-    unqtDot FillBoth     = text "both"--instance ParseDot ScaleType where-    parseUnqt = oneOf [ stringRep UniformScale "true"-                      , stringRep NoScale "false"-                      , stringRep FillWidth "width"-                      , stringRep FillHeight "height"-                      , stringRep FillBoth "both"-                      ]---- -------------------------------------------------------------------------------data Justification = JLeft-                   | JRight-                   | JCenter-                     deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot Justification where-    unqtDot JLeft   = char 'l'-    unqtDot JRight  = char 'r'-    unqtDot JCenter = char 'c'--instance ParseDot Justification where-    parseUnqt = oneOf [ stringRep JLeft "l"-                      , stringRep JRight "r"-                      , stringRep JCenter "c"-                      ]---- -------------------------------------------------------------------------------data Ratios = AspectRatio Double-            | FillRatio-            | CompressRatio-            | ExpandRatio-            | AutoRatio-              deriving (Eq, Ord, Show, Read)--instance PrintDot Ratios where-    unqtDot (AspectRatio r) = unqtDot r-    unqtDot FillRatio       = text "fill"-    unqtDot CompressRatio   = text "compress"-    unqtDot ExpandRatio     = text "expand"-    unqtDot AutoRatio       = text "auto"--instance ParseDot Ratios where-    parseUnqt = oneOf [ liftM AspectRatio parseUnqt-                      , stringRep FillRatio "fill"-                      , stringRep CompressRatio "compress"-                      , stringRep ExpandRatio "expand"-                      , stringRep AutoRatio "auto"-                      ]+   Description : User-friendly wrappers around Graphviz attributes.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   There are almost 150 possible attributes available for Dot graphs, and+   it can be difficult to know which ones to use.  This module provides+   helper functions for the most commonly used ones.++   The complete list of all possible attributes can be found in+   "Data.GraphViz.Attributes.Complete"; it is possible to use both of+   these modules if you require specific extra attributes that are not+   provided here.++ -}+module Data.GraphViz.Attributes+       ( -- * The definition of attributes+         Attribute+       , Attributes+         -- * Creating labels+         -- $labels+       , toLabel+       , textLabel+       , textLabelValue+       , Labellable(..)+         -- * Colors+         -- $colors+       , X11Color(..)+       , bgColor+       , fillColor+       , fontColor+       , penColor+       , color+         -- * Stylistic attributes+         -- $styles+       , penWidth+       , style+       , styles+       , Style+       , dashed+       , dotted+       , solid+       , bold+       , invis+       , filled+       , diagonals+       , rounded+         -- * Node shapes+       , shape+       , Shape(..)+         -- * Edge arrows+       , arrowTo+       , arrowFrom+         -- ** Specifying where to draw arrows on an edge.+       , edgeEnds+       , DirType(..)+         -- ** Default arrow types.+       , Arrow+         -- *** The 9 primitive arrows.+       , box+       , crow+       , diamond+       , dotArrow+       , inv+       , noArrow+       , normal+       , tee+       , vee+         -- *** 5 derived arrows.+       , oDot+       , invDot+       , invODot+       , oBox+       , oDiamond+       ) where++import Data.GraphViz.Attributes.Complete++import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)++-- -----------------------------------------------------------------------------++{- $labels++   The following escape codes are available for labels (where applicable):++     [@\\N@] Replace with the name of the node.++     [@\\G@] Replace with the name of the graph (for node attributes)+             or the name of the graph or cluster, whichever is+             applicable (for graph, cluster and edge attributes).++     [@\\E@] Replace with the name of the edge, formed by the two+             adjoining nodes and the edge type.++     [@\\T@] Replace with the name of the node the edge is coming from.++     [@\\H@] Replace with the name of the node the edge is going to.++     [@\\n@] Centered newline.++     [@\\l@] Left-justified newline.++     [@\\r@] Right-justified newline.++ -}++-- | A convenience class to make it easier to create labels.  It is+--   highly recommended that you make any other types that you wish to+--   create labels from an instance of this class, preferably via the+--   @String@ or @Text@ instances.+class Labellable a where+  -- | This function only creates a 'Label' value to enable you to use+  --   it for 'Attributes' such as 'HeadLabel', etc.+  toLabelValue :: a -> Label++-- | Equivalent to @'Label' . 'toLabelValue'@; the most common label+--   'Attribute'.+toLabel :: (Labellable a) => a -> Attribute+toLabel = Label . toLabelValue++-- | An alias for 'toLabel' for use with the OverloadedStrings+--   extension.+textLabel :: Text -> Attribute+textLabel = toLabel++-- | An alias for 'toLabelValue' for use with the OverloadedStrings+--   extension.+textLabelValue :: Text -> Label+textLabelValue = toLabelValue++instance Labellable Text where+  toLabelValue = StrLabel++instance Labellable Char where+  toLabelValue = toLabelValue . T.singleton++instance Labellable String where+  toLabelValue = toLabelValue . T.pack++instance Labellable Int where+  toLabelValue = toLabelValue . show++instance Labellable Double where+  toLabelValue = toLabelValue . show++instance Labellable Bool where+  toLabelValue = toLabelValue . show++instance Labellable HtmlLabel where+  toLabelValue = HtmlLabel++instance Labellable HtmlText where+  toLabelValue = toLabelValue . HtmlText++instance Labellable HtmlTable where+  toLabelValue = toLabelValue . HtmlTable++instance Labellable RecordFields where+  toLabelValue = RecordLabel++instance Labellable RecordField where+  toLabelValue = toLabelValue . (:[])++-- | A shorter variant than using @PortName@ from 'RecordField'.+instance Labellable PortName where+  toLabelValue = toLabelValue . PortName++-- | A shorter variant than using 'LabelledTarget'.+instance Labellable (PortName, EscString) where+  toLabelValue = toLabelValue . uncurry LabelledTarget++-- -----------------------------------------------------------------------------++{- $colors++   The recommended way of dealing with colors in Dot graphs is to use the+   named 'X11Colors' rather than explicitly specifying RGB, RGBA or HSV+   colors.++ -}++-- | Specify the background color of a graph or cluster.  Requires+--   @'style' 'filled'@.+bgColor :: X11Color -> Attribute+bgColor = BgColor . X11Color++-- | Specify the fill color of a node.  Requires @'style' 'filled'@.+fillColor :: X11Color -> Attribute+fillColor = FillColor . X11Color++-- | Specify the color of text.+fontColor :: X11Color -> Attribute+fontColor = FontColor . X11Color++-- | Specify the color of the bounding box of a cluster.+penColor :: X11Color -> Attribute+penColor = PenColor . X11Color++-- | The @color@ attribute serves several purposes.  As such care must+--   be taken when using it, and it is preferable to use those+--   alternatives that are available when they exist.+--+--   * The color of edges;+--+--   * The bounding color of nodes;+--+--   * The bounding color of clusters (i.e. equivalent to 'penColor');+--+--   * If the 'filled' 'Style' is set, then it defines the+--     background color of nodes and clusters unless 'fillColor' or+--     'bgColor' respectively is set.+color :: X11Color -> Attribute+color = Color . (:[]) . X11Color++-- -----------------------------------------------------------------------------++{- $styles++   Various stylistic attributes to customise how items are drawn.  All+   'Style's are available for nodes; those specified also can be used+   for edges and clusters.++ -}++-- | A particular style type to be used.+type Style = StyleItem++style :: Style -> Attribute+style = styles . (:[])++styles :: [Style] -> Attribute+styles = Style++-- | Also available for edges.+dashed :: Style+dashed = SItem Dashed []++-- | Also available for edges.+dotted :: Style+dotted = SItem Dotted []++-- | Also available for edges.+solid :: Style+solid = SItem Solid []++-- | Also available for edges.+invis :: Style+invis = SItem Invisible []++-- | Also available for edges.+bold :: Style+bold = SItem Bold []++-- | Also available for clusters.+filled :: Style+filled = SItem Filled []++-- | Also available for clusters.+rounded :: Style+rounded = SItem Rounded []++-- | Only available for nodes.+diagonals :: Style+diagonals = SItem Diagonals []++-- | Specify the width of lines.  Valid for clusters, nodes and edges.+penWidth :: Double -> Attribute+penWidth = PenWidth++-- -----------------------------------------------------------------------------++-- | The shape of a node.+shape :: Shape -> Attribute+shape = Shape++-- -----------------------------------------------------------------------------++-- | A particular way of drawing the end of an edge.+type Arrow = ArrowType++-- | How to draw the arrow at the node the edge is pointing to.  For+--   an undirected graph, requires either @'edgeEnds' 'Forward'@ or+--   @'edgeEnds' 'Both'@.+arrowTo :: Arrow -> Attribute+arrowTo = ArrowHead++-- | How to draw the arrow at the node the edge is coming from.+--   Requires either @'edgeEnds' 'Back'@ or @'EdgeEnds' 'Both'@.+arrowFrom :: Arrow -> Attribute+arrowFrom = ArrowTail++-- | Specify where to place arrows on an edge.+edgeEnds :: DirType -> Attribute+edgeEnds = Dir++box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: Arrow+oDot, invDot, invODot, oBox, oDiamond :: Arrow++normal = AType [(noMods, Normal)]+inv = AType [(noMods, Inv)]+dotArrow = AType [(noMods, DotArrow)]+invDot = AType [ (noMods, Inv)+               , (noMods, DotArrow)]+oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)]+invODot = AType [ (noMods, Inv)+                , (openMod, DotArrow)]+noArrow = AType [(noMods, NoArrow)]+tee = AType [(noMods, Tee)]+diamond = AType [(noMods, Diamond)]+oDiamond = AType [(openMod, Diamond)]+crow = AType [(noMods, Crow)]+box = AType [(noMods, Box)]+oBox = AType [(openMod, Box)]+vee = AType [(noMods, Vee)]++-- -----------------------------------------------------------------------------
+ Data/GraphViz/Attributes/ColorScheme.hs view
@@ -0,0 +1,72 @@+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Attributes.ColorScheme+   Description : Specification of color schemes.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This is an internal module designed so that the state can record+   the current color scheme.+-}+module Data.GraphViz.Attributes.ColorScheme where++import Data.Word(Word8)++-- -----------------------------------------------------------------------------++-- | This represents the color schemes that Graphviz accepts.  As+--   mentioned above, these are /not/ used for actual parsing or+--   printing.+data ColorScheme = X11+                 | Brewer BrewerScheme+                 deriving (Eq, Ord, Show, Read)++-- | The value of the depends on the name.+data BrewerScheme = BScheme BrewerName Word8+                  deriving (Eq, Ord, Show, Read)++-- | All of these have a minimum level value of @3@, with a maximum+--   of @9@ unless otherwise specified.+data BrewerName = Accent   -- ^ Maximum of @8@.+                | Blues+                | Brbg     -- ^ Maximum of @11@.+                | Bugn+                | Bupu+                | Dark2    -- ^ Maximum of @8@.+                | Gnbu+                | Greens+                | Greys+                | Oranges+                | Orrd+                | Paired   -- ^ Maximum of @12@.+                | Pastel1+                | Pastel2  -- ^ Maximum of @8@.+                | Piyg     -- ^ Maximum of @11@.+                | Prgn     -- ^ Maximum of @11@.+                | Pubu+                | Pubugn+                | Puor     -- ^ Maximum of @11@; note that the last two are listed+                           --   after the @'Purd'@ values in the+                           --   documentation.+                | Purd+                | Purples+                | Rdbu     -- ^ Maximum of @11@; note that the last two are listed+                           --   first.+                | Rdgy     -- ^ Maximum of @11@; note that the last two are listed+                           --   after the @'Rdpu'@ values in the+                           --   documentation.+                | Rdpu+                | Rdylbu   -- ^ Maximum of @11@.+                | Rdylgn   -- ^ Maximum of @11@.+                | Reds+                | Set1+                | Set2     -- ^ Maximum of @8@.+                | Set3     -- ^ Maximum of @12@.+                | Spectral -- ^ Maximum of @11@.+                | Ylgn+                | Ylgnbu+                | Ylorbr+                | Ylorrd+                deriving (Eq, Ord, Bounded, Enum, Show, Read)
Data/GraphViz/Attributes/Colors.hs view
@@ -1,1956 +1,1976 @@-{- |-   Module      : Data.GraphViz.Attributes.Colors-   Description : Specification of Color-related types and functions.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines the various colors, etc. for Graphviz.  For-   information on colors in general, see:-     <http://graphviz.org/doc/info/attrs.html#k:color>-   For named colors, see:-     <http://graphviz.org/doc/info/colors.html>--   Note that the ColorBrewer Color Schemes (shortened to just-   \"Brewer\" for the rest of this module) are covered by the-   following license (also available in the LICENSE file of this-   library):-     <http://graphviz.org/doc/info/colors.html#brewer_license>--   When parsing and printing 'Color' values (more specifically, the-   Brewer color values), the actual 'ColorScheme' being used isn't-   taken into account.  Also, the \"@\/foo\/bar@\" style of overriding-   the 'ColorScheme' being used isn't supported for parsing purposes-   (and will result in a parsing failure).--}-module Data.GraphViz.Attributes.Colors-       ( -- * Color schemes.-         ColorScheme(..)-       , BrewerName(..)-         -- * Colors-       , Color(..)-       , X11Color(..)-         -- * Conversion to\/from @Colour@.-       , toColour-       , x11Colour-       , fromColour-       , fromAColour-       ) where--import Data.GraphViz.Parsing-import Data.GraphViz.Printing--import Data.Colour( AlphaColour, opaque, transparent, withOpacity-                  , over, black, alphaChannel, darken)-import Data.Colour.SRGB(Colour, sRGB, sRGB24, toSRGB24)-import Data.Colour.RGBSpace(uncurryRGB)-import Data.Colour.RGBSpace.HSV(hsv)--import Data.Char(isHexDigit)-import Numeric(showHex, readHex)-import Data.Word(Word8)-import Control.Monad(liftM, liftM2)---- --------------------------------------------------------------------------------- | This represents the color schemes that Graphviz accepts.  As---   mentioned above, these are /not/ used for actual parsing or---   printing.-data ColorScheme = X11-                 | BrewerScheme BrewerName Word8 -- ^ The value of the-                                                 --   scheme number-                                                 --   depends on-                                                 --   the name.-                 deriving (Eq, Ord, Show, Read)--instance PrintDot ColorScheme where-    unqtDot X11 = unqtDot "X11"-    unqtDot (BrewerScheme n l) = unqtDot n <> unqtDot l--instance ParseDot ColorScheme where-    parseUnqt = stringRep X11 "X11"-                `onFail`-                liftM2 BrewerScheme parseUnqt parseUnqt---- | All of these have a minimum level value of @3@, with a maximum---   of @9@ unless otherwise specified.-data BrewerName = Accent   -- ^ Maximum of @8@.-                | Blues-                | Brbg     -- ^ Maximum of @11@.-                | Bugn-                | Bupu-                | Dark2    -- ^ Maximum of @8@.-                | Gnbu-                | Greens-                | Greys-                | Oranges-                | Orrd-                | Paired   -- ^ Maximum of @12@.-                | Pastel1-                | Pastel2  -- ^ Maximum of @8@.-                | Piyg     -- ^ Maximum of @11@.-                | Prgn     -- ^ Maximum of @11@.-                | Pubu-                | Pubugn-                | Puor     -- ^ Maximum of @11@; note that the last two are listed-                           --   after the @'Purd'@ values in the-                           --   documentation.-                | Purd-                | Purples-                | Rdbu     -- ^ Maximum of @11@; note that the last two are listed-                           --   first.-                | Rdgy     -- ^ Maximum of @11@; note that the last two are listed-                           --   after the @'Rdpu'@ values in the-                           --   documentation.-                | Rdpu-                | Rdylbu   -- ^ Maximum of @11@.-                | Rdylgn   -- ^ Maximum of @11@.-                | Reds-                | Set1-                | Set2     -- ^ Maximum of @8@.-                | Set3     -- ^ Maximum of @12@.-                | Spectral -- ^ Maximum of @11@.-                | Ylgn-                | Ylgnbu-                | Ylorbr-                | Ylorrd-                deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot BrewerName where-    unqtDot Accent   = unqtDot "accent"-    unqtDot Blues    = unqtDot "blues"-    unqtDot Brbg     = unqtDot "brbg"-    unqtDot Bugn     = unqtDot "bugn"-    unqtDot Bupu     = unqtDot "bupu"-    unqtDot Dark2    = unqtDot "dark2"-    unqtDot Gnbu     = unqtDot "gnbu"-    unqtDot Greens   = unqtDot "greens"-    unqtDot Greys    = unqtDot "greys"-    unqtDot Oranges  = unqtDot "oranges"-    unqtDot Orrd     = unqtDot "orrd"-    unqtDot Paired   = unqtDot "paired"-    unqtDot Pastel1  = unqtDot "pastel1"-    unqtDot Pastel2  = unqtDot "pastel2"-    unqtDot Piyg     = unqtDot "piyg"-    unqtDot Prgn     = unqtDot "prgn"-    unqtDot Pubu     = unqtDot "pubu"-    unqtDot Pubugn   = unqtDot "pubugn"-    unqtDot Puor     = unqtDot "puor"-    unqtDot Purd     = unqtDot "purd"-    unqtDot Purples  = unqtDot "purples"-    unqtDot Rdbu     = unqtDot "rdbu"-    unqtDot Rdgy     = unqtDot "rdgy"-    unqtDot Rdpu     = unqtDot "rdpu"-    unqtDot Rdylbu   = unqtDot "rdylbu"-    unqtDot Rdylgn   = unqtDot "rdylgn"-    unqtDot Reds     = unqtDot "reds"-    unqtDot Set1     = unqtDot "set1"-    unqtDot Set2     = unqtDot "set2"-    unqtDot Set3     = unqtDot "set3"-    unqtDot Spectral = unqtDot "spectral"-    unqtDot Ylgn     = unqtDot "ylgn"-    unqtDot Ylgnbu   = unqtDot "ylgnbu"-    unqtDot Ylorbr   = unqtDot "ylorbr"-    unqtDot Ylorrd   = unqtDot "ylorrd"--instance ParseDot BrewerName where-  -- The order is different from above to make sure longer names are-  -- parsed first.-  parseUnqt = oneOf [ stringRep Accent "accent"-                    , stringRep Blues "blues"-                    , stringRep Brbg "brbg"-                    , stringRep Bugn "bugn"-                    , stringRep Bupu "bupu"-                    , stringRep Dark2 "dark2"-                    , stringRep Gnbu "gnbu"-                    , stringRep Greens "greens"-                    , stringRep Greys "greys"-                    , stringRep Oranges "oranges"-                    , stringRep Orrd "orrd"-                    , stringRep Paired "paired"-                    , stringRep Pastel1 "pastel1"-                    , stringRep Pastel2 "pastel2"-                    , stringRep Piyg "piyg"-                    , stringRep Prgn "prgn"-                    , stringRep Pubugn "pubugn"-                    , stringRep Pubu "pubu"-                    , stringRep Puor "puor"-                    , stringRep Purd "purd"-                    , stringRep Purples "purples"-                    , stringRep Rdbu "rdbu"-                    , stringRep Rdgy "rdgy"-                    , stringRep Rdpu "rdpu"-                    , stringRep Rdylbu "rdylbu"-                    , stringRep Rdylgn "rdylgn"-                    , stringRep Reds "reds"-                    , stringRep Set1 "set1"-                    , stringRep Set2 "set2"-                    , stringRep Set3 "set3"-                    , stringRep Spectral "spectral"-                    , stringRep Ylgnbu "ylgnbu"-                    , stringRep Ylgn "ylgn"-                    , stringRep Ylorbr "ylorbr"-                    , stringRep Ylorrd "ylorrd"-                    ]---- --------------------------------------------------------------------------------- | Defining a color for use with Graphviz.  Note that named colors---   have been split up into 'X11Color's and those based upon the---   Brewer color schemes.-data Color = RGB { red   :: Word8-                 , green :: Word8-                 , blue  :: Word8-                 }-           | RGBA { red   :: Word8-                  , green :: Word8-                  , blue  :: Word8-                  , alpha :: Word8-                  }-             -- | The 'hue', 'saturation' and 'value' values must all-             --   be @0 <= x <=1@.-           | HSV { hue        :: Double-                 , saturation :: Double-                 , value      :: Double-                 }-           | X11Color X11Color-           | BrewerColor Word8 -- ^ This value should be between @1@-                               --   and the level of the 'BrewerName'-                               --   being used.-             deriving (Eq, Ord, 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 (X11Color name) = unqtDot name-    unqtDot (BrewerColor n) = unqtDot n--    toDot (X11Color name) = toDot name-    toDot (BrewerColor n) = toDot n-    toDot c               = doubleQuotes $ unqtDot c--    unqtListToDot = hcat . punctuate colon . map unqtDot--    -- These two don't need to be quoted if they're on their own.-    listToDot [X11Color name] = toDot name-    listToDot [BrewerColor n] = toDot n-    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 X11Color parseUnqt-                      , liftM BrewerColor parseUnqt-                      ]-        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 = quotedParse parseUnqt-            `onFail` -- These two can be unquoted-            oneOf [ liftM X11Color parseUnqt-                  , liftM BrewerColor parseUnqt-                  ]--    parseUnqtList = sepBy1 parseUnqt (character ':')--    parseList = liftM return-                -- Unquoted single color-                (oneOf [ liftM X11Color parseUnqt-                       , liftM BrewerColor parseUnqt-                       ]-                )-                `onFail`-                quotedParse parseUnqtList---- --------------------------------------------------------------------------------- | The X11 colors that Graphviz uses.  Note that these are slightly---   different from the \"normal\" X11 colors used (e.g. the inclusion---   of @Crimson@).  Graphviz's list of colors also duplicated almost---   all @Gray@ colors with @Grey@ ones; parsing of an 'X11Color'---   which is specified using \"grey\" will succeed, even for those---   that don't have the duplicate spelling (e.g. @DarkSlateGray1@).-data X11Color = AliceBlue-              | AntiqueWhite-              | AntiqueWhite1-              | AntiqueWhite2-              | AntiqueWhite3-              | AntiqueWhite4-              | Aquamarine-              | Aquamarine1-              | Aquamarine2-              | Aquamarine3-              | Aquamarine4-              | Azure-              | Azure1-              | Azure2-              | Azure3-              | Azure4-              | Beige-              | Bisque-              | Bisque1-              | Bisque2-              | Bisque3-              | Bisque4-              | Black-              | BlanchedAlmond-              | Blue-              | Blue1-              | Blue2-              | Blue3-              | Blue4-              | BlueViolet-              | Brown-              | Brown1-              | Brown2-              | Brown3-              | Brown4-              | Burlywood-              | Burlywood1-              | Burlywood2-              | Burlywood3-              | Burlywood4-              | CadetBlue-              | CadetBlue1-              | CadetBlue2-              | CadetBlue3-              | CadetBlue4-              | Chartreuse-              | Chartreuse1-              | Chartreuse2-              | Chartreuse3-              | Chartreuse4-              | Chocolate-              | Chocolate1-              | Chocolate2-              | Chocolate3-              | Chocolate4-              | Coral-              | Coral1-              | Coral2-              | Coral3-              | Coral4-              | CornFlowerBlue-              | CornSilk-              | CornSilk1-              | CornSilk2-              | CornSilk3-              | CornSilk4-              | Crimson-              | Cyan-              | Cyan1-              | Cyan2-              | Cyan3-              | Cyan4-              | DarkGoldenrod-              | DarkGoldenrod1-              | DarkGoldenrod2-              | DarkGoldenrod3-              | DarkGoldenrod4-              | DarkGreen-              | Darkkhaki-              | DarkOliveGreen-              | DarkOliveGreen1-              | DarkOliveGreen2-              | DarkOliveGreen3-              | DarkOliveGreen4-              | DarkOrange-              | DarkOrange1-              | DarkOrange2-              | DarkOrange3-              | DarkOrange4-              | DarkOrchid-              | DarkOrchid1-              | DarkOrchid2-              | DarkOrchid3-              | DarkOrchid4-              | DarkSalmon-              | DarkSeaGreen-              | DarkSeaGreen1-              | DarkSeaGreen2-              | DarkSeaGreen3-              | DarkSeaGreen4-              | DarkSlateBlue-              | DarkSlateGray-              | DarkSlateGray1-              | DarkSlateGray2-              | DarkSlateGray3-              | DarkSlateGray4-              | DarkTurquoise-              | DarkViolet-              | DeepPink-              | DeepPink1-              | DeepPink2-              | DeepPink3-              | DeepPink4-              | DeepSkyBlue-              | DeepSkyBlue1-              | DeepSkyBlue2-              | DeepSkyBlue3-              | DeepSkyBlue4-              | DimGray-              | DodgerBlue-              | DodgerBlue1-              | DodgerBlue2-              | DodgerBlue3-              | DodgerBlue4-              | Firebrick-              | Firebrick1-              | Firebrick2-              | Firebrick3-              | Firebrick4-              | FloralWhite-              | ForestGreen-              | Gainsboro-              | GhostWhite-              | Gold-              | Gold1-              | Gold2-              | Gold3-              | Gold4-              | Goldenrod-              | Goldenrod1-              | Goldenrod2-              | Goldenrod3-              | Goldenrod4-              | Gray-              | Gray0-              | Gray1-              | Gray2-              | Gray3-              | Gray4-              | Gray5-              | Gray6-              | Gray7-              | Gray8-              | Gray9-              | Gray10-              | Gray11-              | Gray12-              | Gray13-              | Gray14-              | Gray15-              | Gray16-              | Gray17-              | Gray18-              | Gray19-              | Gray20-              | Gray21-              | Gray22-              | Gray23-              | Gray24-              | Gray25-              | Gray26-              | Gray27-              | Gray28-              | Gray29-              | Gray30-              | Gray31-              | Gray32-              | Gray33-              | Gray34-              | Gray35-              | Gray36-              | Gray37-              | Gray38-              | Gray39-              | Gray40-              | Gray41-              | Gray42-              | Gray43-              | Gray44-              | Gray45-              | Gray46-              | Gray47-              | Gray48-              | Gray49-              | Gray50-              | Gray51-              | Gray52-              | Gray53-              | Gray54-              | Gray55-              | Gray56-              | Gray57-              | Gray58-              | Gray59-              | Gray60-              | Gray61-              | Gray62-              | Gray63-              | Gray64-              | Gray65-              | Gray66-              | Gray67-              | Gray68-              | Gray69-              | Gray70-              | Gray71-              | Gray72-              | Gray73-              | Gray74-              | Gray75-              | Gray76-              | Gray77-              | Gray78-              | Gray79-              | Gray80-              | Gray81-              | Gray82-              | Gray83-              | Gray84-              | Gray85-              | Gray86-              | Gray87-              | Gray88-              | Gray89-              | Gray90-              | Gray91-              | Gray92-              | Gray93-              | Gray94-              | Gray95-              | Gray96-              | Gray97-              | Gray98-              | Gray99-              | Gray100-              | Green-              | Green1-              | Green2-              | Green3-              | Green4-              | GreenYellow-              | HoneyDew-              | HoneyDew1-              | HoneyDew2-              | HoneyDew3-              | HoneyDew4-              | HotPink-              | HotPink1-              | HotPink2-              | HotPink3-              | HotPink4-              | IndianRed-              | IndianRed1-              | IndianRed2-              | IndianRed3-              | IndianRed4-              | Indigo-              | Ivory-              | Ivory1-              | Ivory2-              | Ivory3-              | Ivory4-              | Khaki-              | Khaki1-              | Khaki2-              | Khaki3-              | Khaki4-              | Lavender-              | LavenderBlush-              | LavenderBlush1-              | LavenderBlush2-              | LavenderBlush3-              | LavenderBlush4-              | LawnGreen-              | LemonChiffon-              | LemonChiffon1-              | LemonChiffon2-              | LemonChiffon3-              | LemonChiffon4-              | LightBlue-              | LightBlue1-              | LightBlue2-              | LightBlue3-              | LightBlue4-              | LightCoral-              | LightCyan-              | LightCyan1-              | LightCyan2-              | LightCyan3-              | LightCyan4-              | LightGoldenrod-              | LightGoldenrod1-              | LightGoldenrod2-              | LightGoldenrod3-              | LightGoldenrod4-              | LightGoldenrodYellow-              | LightGray-              | LightPink-              | LightPink1-              | LightPink2-              | LightPink3-              | LightPink4-              | LightSalmon-              | LightSalmon1-              | LightSalmon2-              | LightSalmon3-              | LightSalmon4-              | LightSeaGreen-              | LightSkyBlue-              | LightSkyBlue1-              | LightSkyBlue2-              | LightSkyBlue3-              | LightSkyBlue4-              | LightSlateBlue-              | LightSlateGray-              | LightSteelBlue-              | LightSteelBlue1-              | LightSteelBlue2-              | LightSteelBlue3-              | LightSteelBlue4-              | LightYellow-              | LightYellow1-              | LightYellow2-              | LightYellow3-              | LightYellow4-              | LimeGreen-              | Linen-              | Magenta-              | Magenta1-              | Magenta2-              | Magenta3-              | Magenta4-              | Maroon-              | Maroon1-              | Maroon2-              | Maroon3-              | Maroon4-              | MediumAquamarine-              | MediumBlue-              | MediumOrchid-              | MediumOrchid1-              | MediumOrchid2-              | MediumOrchid3-              | MediumOrchid4-              | MediumPurple-              | MediumPurple1-              | MediumPurple2-              | MediumPurple3-              | MediumPurple4-              | MediumSeaGreen-              | MediumSlateBlue-              | MediumSpringGreen-              | MediumTurquoise-              | MediumVioletRed-              | MidnightBlue-              | MintCream-              | MistyRose-              | MistyRose1-              | MistyRose2-              | MistyRose3-              | MistyRose4-              | Moccasin-              | NavajoWhite-              | NavajoWhite1-              | NavajoWhite2-              | NavajoWhite3-              | NavajoWhite4-              | Navy-              | NavyBlue-              | OldLace-              | OliveDrab-              | OliveDrab1-              | OliveDrab2-              | OliveDrab3-              | OliveDrab4-              | Orange-              | Orange1-              | Orange2-              | Orange3-              | Orange4-              | OrangeRed-              | OrangeRed1-              | OrangeRed2-              | OrangeRed3-              | OrangeRed4-              | Orchid-              | Orchid1-              | Orchid2-              | Orchid3-              | Orchid4-              | PaleGoldenrod-              | PaleGreen-              | PaleGreen1-              | PaleGreen2-              | PaleGreen3-              | PaleGreen4-              | PaleTurquoise-              | PaleTurquoise1-              | PaleTurquoise2-              | PaleTurquoise3-              | PaleTurquoise4-              | PaleVioletRed-              | PaleVioletRed1-              | PaleVioletRed2-              | PaleVioletRed3-              | PaleVioletRed4-              | PapayaWhip-              | PeachPuff-              | PeachPuff1-              | PeachPuff2-              | PeachPuff3-              | PeachPuff4-              | Peru-              | Pink-              | Pink1-              | Pink2-              | Pink3-              | Pink4-              | Plum-              | Plum1-              | Plum2-              | Plum3-              | Plum4-              | PowderBlue-              | Purple-              | Purple1-              | Purple2-              | Purple3-              | Purple4-              | Red-              | Red1-              | Red2-              | Red3-              | Red4-              | RosyBrown-              | RosyBrown1-              | RosyBrown2-              | RosyBrown3-              | RosyBrown4-              | RoyalBlue-              | RoyalBlue1-              | RoyalBlue2-              | RoyalBlue3-              | RoyalBlue4-              | SaddleBrown-              | Salmon-              | Salmon1-              | Salmon2-              | Salmon3-              | Salmon4-              | SandyBrown-              | SeaGreen-              | SeaGreen1-              | SeaGreen2-              | SeaGreen3-              | SeaGreen4-              | SeaShell-              | SeaShell1-              | SeaShell2-              | SeaShell3-              | SeaShell4-              | Sienna-              | Sienna1-              | Sienna2-              | Sienna3-              | Sienna4-              | SkyBlue-              | SkyBlue1-              | SkyBlue2-              | SkyBlue3-              | SkyBlue4-              | SlateBlue-              | SlateBlue1-              | SlateBlue2-              | SlateBlue3-              | SlateBlue4-              | SlateGray-              | SlateGray1-              | SlateGray2-              | SlateGray3-              | SlateGray4-              | Snow-              | Snow1-              | Snow2-              | Snow3-              | Snow4-              | SpringGreen-              | SpringGreen1-              | SpringGreen2-              | SpringGreen3-              | SpringGreen4-              | SteelBlue-              | SteelBlue1-              | SteelBlue2-              | SteelBlue3-              | SteelBlue4-              | Tan-              | Tan1-              | Tan2-              | Tan3-              | Tan4-              | Thistle-              | Thistle1-              | Thistle2-              | Thistle3-              | Thistle4-              | Tomato-              | Tomato1-              | Tomato2-              | Tomato3-              | Tomato4-              | Transparent -- ^ Equivalent to setting @Style [SItem Invisible []]@.-              | Turquoise-              | Turquoise1-              | Turquoise2-              | Turquoise3-              | Turquoise4-              | Violet-              | VioletRed-              | VioletRed1-              | VioletRed2-              | VioletRed3-              | VioletRed4-              | Wheat-              | Wheat1-              | Wheat2-              | Wheat3-              | Wheat4-              | White-              | WhiteSmoke-              | Yellow-              | Yellow1-              | Yellow2-              | Yellow3-              | Yellow4-              | YellowGreen-              deriving (Eq, Ord, Bounded, Enum, Show, Read)--instance PrintDot X11Color where-  unqtDot AliceBlue            = unqtDot "aliceblue"-  unqtDot AntiqueWhite         = unqtDot "antiquewhite"-  unqtDot AntiqueWhite1        = unqtDot "antiquewhite1"-  unqtDot AntiqueWhite2        = unqtDot "antiquewhite2"-  unqtDot AntiqueWhite3        = unqtDot "antiquewhite3"-  unqtDot AntiqueWhite4        = unqtDot "antiquewhite4"-  unqtDot Aquamarine           = unqtDot "aquamarine"-  unqtDot Aquamarine1          = unqtDot "aquamarine1"-  unqtDot Aquamarine2          = unqtDot "aquamarine2"-  unqtDot Aquamarine3          = unqtDot "aquamarine3"-  unqtDot Aquamarine4          = unqtDot "aquamarine4"-  unqtDot Azure                = unqtDot "azure"-  unqtDot Azure1               = unqtDot "azure1"-  unqtDot Azure2               = unqtDot "azure2"-  unqtDot Azure3               = unqtDot "azure3"-  unqtDot Azure4               = unqtDot "azure4"-  unqtDot Beige                = unqtDot "beige"-  unqtDot Bisque               = unqtDot "bisque"-  unqtDot Bisque1              = unqtDot "bisque1"-  unqtDot Bisque2              = unqtDot "bisque2"-  unqtDot Bisque3              = unqtDot "bisque3"-  unqtDot Bisque4              = unqtDot "bisque4"-  unqtDot Black                = unqtDot "black"-  unqtDot BlanchedAlmond       = unqtDot "blanchedalmond"-  unqtDot Blue                 = unqtDot "blue"-  unqtDot Blue1                = unqtDot "blue1"-  unqtDot Blue2                = unqtDot "blue2"-  unqtDot Blue3                = unqtDot "blue3"-  unqtDot Blue4                = unqtDot "blue4"-  unqtDot BlueViolet           = unqtDot "blueviolet"-  unqtDot Brown                = unqtDot "brown"-  unqtDot Brown1               = unqtDot "brown1"-  unqtDot Brown2               = unqtDot "brown2"-  unqtDot Brown3               = unqtDot "brown3"-  unqtDot Brown4               = unqtDot "brown4"-  unqtDot Burlywood            = unqtDot "burlywood"-  unqtDot Burlywood1           = unqtDot "burlywood1"-  unqtDot Burlywood2           = unqtDot "burlywood2"-  unqtDot Burlywood3           = unqtDot "burlywood3"-  unqtDot Burlywood4           = unqtDot "burlywood4"-  unqtDot CadetBlue            = unqtDot "cadetblue"-  unqtDot CadetBlue1           = unqtDot "cadetblue1"-  unqtDot CadetBlue2           = unqtDot "cadetblue2"-  unqtDot CadetBlue3           = unqtDot "cadetblue3"-  unqtDot CadetBlue4           = unqtDot "cadetblue4"-  unqtDot Chartreuse           = unqtDot "chartreuse"-  unqtDot Chartreuse1          = unqtDot "chartreuse1"-  unqtDot Chartreuse2          = unqtDot "chartreuse2"-  unqtDot Chartreuse3          = unqtDot "chartreuse3"-  unqtDot Chartreuse4          = unqtDot "chartreuse4"-  unqtDot Chocolate            = unqtDot "chocolate"-  unqtDot Chocolate1           = unqtDot "chocolate1"-  unqtDot Chocolate2           = unqtDot "chocolate2"-  unqtDot Chocolate3           = unqtDot "chocolate3"-  unqtDot Chocolate4           = unqtDot "chocolate4"-  unqtDot Coral                = unqtDot "coral"-  unqtDot Coral1               = unqtDot "coral1"-  unqtDot Coral2               = unqtDot "coral2"-  unqtDot Coral3               = unqtDot "coral3"-  unqtDot Coral4               = unqtDot "coral4"-  unqtDot CornFlowerBlue       = unqtDot "cornflowerblue"-  unqtDot CornSilk             = unqtDot "cornsilk"-  unqtDot CornSilk1            = unqtDot "cornsilk1"-  unqtDot CornSilk2            = unqtDot "cornsilk2"-  unqtDot CornSilk3            = unqtDot "cornsilk3"-  unqtDot CornSilk4            = unqtDot "cornsilk4"-  unqtDot Crimson              = unqtDot "crimson"-  unqtDot Cyan                 = unqtDot "cyan"-  unqtDot Cyan1                = unqtDot "cyan1"-  unqtDot Cyan2                = unqtDot "cyan2"-  unqtDot Cyan3                = unqtDot "cyan3"-  unqtDot Cyan4                = unqtDot "cyan4"-  unqtDot DarkGoldenrod        = unqtDot "darkgoldenrod"-  unqtDot DarkGoldenrod1       = unqtDot "darkgoldenrod1"-  unqtDot DarkGoldenrod2       = unqtDot "darkgoldenrod2"-  unqtDot DarkGoldenrod3       = unqtDot "darkgoldenrod3"-  unqtDot DarkGoldenrod4       = unqtDot "darkgoldenrod4"-  unqtDot DarkGreen            = unqtDot "darkgreen"-  unqtDot Darkkhaki            = unqtDot "darkkhaki"-  unqtDot DarkOliveGreen       = unqtDot "darkolivegreen"-  unqtDot DarkOliveGreen1      = unqtDot "darkolivegreen1"-  unqtDot DarkOliveGreen2      = unqtDot "darkolivegreen2"-  unqtDot DarkOliveGreen3      = unqtDot "darkolivegreen3"-  unqtDot DarkOliveGreen4      = unqtDot "darkolivegreen4"-  unqtDot DarkOrange           = unqtDot "darkorange"-  unqtDot DarkOrange1          = unqtDot "darkorange1"-  unqtDot DarkOrange2          = unqtDot "darkorange2"-  unqtDot DarkOrange3          = unqtDot "darkorange3"-  unqtDot DarkOrange4          = unqtDot "darkorange4"-  unqtDot DarkOrchid           = unqtDot "darkorchid"-  unqtDot DarkOrchid1          = unqtDot "darkorchid1"-  unqtDot DarkOrchid2          = unqtDot "darkorchid2"-  unqtDot DarkOrchid3          = unqtDot "darkorchid3"-  unqtDot DarkOrchid4          = unqtDot "darkorchid4"-  unqtDot DarkSalmon           = unqtDot "darksalmon"-  unqtDot DarkSeaGreen         = unqtDot "darkseagreen"-  unqtDot DarkSeaGreen1        = unqtDot "darkseagreen1"-  unqtDot DarkSeaGreen2        = unqtDot "darkseagreen2"-  unqtDot DarkSeaGreen3        = unqtDot "darkseagreen3"-  unqtDot DarkSeaGreen4        = unqtDot "darkseagreen4"-  unqtDot DarkSlateBlue        = unqtDot "darkslateblue"-  unqtDot DarkSlateGray        = unqtDot "darkslategray"-  unqtDot DarkSlateGray1       = unqtDot "darkslategray1"-  unqtDot DarkSlateGray2       = unqtDot "darkslategray2"-  unqtDot DarkSlateGray3       = unqtDot "darkslategray3"-  unqtDot DarkSlateGray4       = unqtDot "darkslategray4"-  unqtDot DarkTurquoise        = unqtDot "darkturquoise"-  unqtDot DarkViolet           = unqtDot "darkviolet"-  unqtDot DeepPink             = unqtDot "deeppink"-  unqtDot DeepPink1            = unqtDot "deeppink1"-  unqtDot DeepPink2            = unqtDot "deeppink2"-  unqtDot DeepPink3            = unqtDot "deeppink3"-  unqtDot DeepPink4            = unqtDot "deeppink4"-  unqtDot DeepSkyBlue          = unqtDot "deepskyblue"-  unqtDot DeepSkyBlue1         = unqtDot "deepskyblue1"-  unqtDot DeepSkyBlue2         = unqtDot "deepskyblue2"-  unqtDot DeepSkyBlue3         = unqtDot "deepskyblue3"-  unqtDot DeepSkyBlue4         = unqtDot "deepskyblue4"-  unqtDot DimGray              = unqtDot "dimgray"-  unqtDot DodgerBlue           = unqtDot "dodgerblue"-  unqtDot DodgerBlue1          = unqtDot "dodgerblue1"-  unqtDot DodgerBlue2          = unqtDot "dodgerblue2"-  unqtDot DodgerBlue3          = unqtDot "dodgerblue3"-  unqtDot DodgerBlue4          = unqtDot "dodgerblue4"-  unqtDot Firebrick            = unqtDot "firebrick"-  unqtDot Firebrick1           = unqtDot "firebrick1"-  unqtDot Firebrick2           = unqtDot "firebrick2"-  unqtDot Firebrick3           = unqtDot "firebrick3"-  unqtDot Firebrick4           = unqtDot "firebrick4"-  unqtDot FloralWhite          = unqtDot "floralwhite"-  unqtDot ForestGreen          = unqtDot "forestgreen"-  unqtDot Gainsboro            = unqtDot "gainsboro"-  unqtDot GhostWhite           = unqtDot "ghostwhite"-  unqtDot Gold                 = unqtDot "gold"-  unqtDot Gold1                = unqtDot "gold1"-  unqtDot Gold2                = unqtDot "gold2"-  unqtDot Gold3                = unqtDot "gold3"-  unqtDot Gold4                = unqtDot "gold4"-  unqtDot Goldenrod            = unqtDot "goldenrod"-  unqtDot Goldenrod1           = unqtDot "goldenrod1"-  unqtDot Goldenrod2           = unqtDot "goldenrod2"-  unqtDot Goldenrod3           = unqtDot "goldenrod3"-  unqtDot Goldenrod4           = unqtDot "goldenrod4"-  unqtDot Gray                 = unqtDot "gray"-  unqtDot Gray0                = unqtDot "gray0"-  unqtDot Gray1                = unqtDot "gray1"-  unqtDot Gray2                = unqtDot "gray2"-  unqtDot Gray3                = unqtDot "gray3"-  unqtDot Gray4                = unqtDot "gray4"-  unqtDot Gray5                = unqtDot "gray5"-  unqtDot Gray6                = unqtDot "gray6"-  unqtDot Gray7                = unqtDot "gray7"-  unqtDot Gray8                = unqtDot "gray8"-  unqtDot Gray9                = unqtDot "gray9"-  unqtDot Gray10               = unqtDot "gray10"-  unqtDot Gray11               = unqtDot "gray11"-  unqtDot Gray12               = unqtDot "gray12"-  unqtDot Gray13               = unqtDot "gray13"-  unqtDot Gray14               = unqtDot "gray14"-  unqtDot Gray15               = unqtDot "gray15"-  unqtDot Gray16               = unqtDot "gray16"-  unqtDot Gray17               = unqtDot "gray17"-  unqtDot Gray18               = unqtDot "gray18"-  unqtDot Gray19               = unqtDot "gray19"-  unqtDot Gray20               = unqtDot "gray20"-  unqtDot Gray21               = unqtDot "gray21"-  unqtDot Gray22               = unqtDot "gray22"-  unqtDot Gray23               = unqtDot "gray23"-  unqtDot Gray24               = unqtDot "gray24"-  unqtDot Gray25               = unqtDot "gray25"-  unqtDot Gray26               = unqtDot "gray26"-  unqtDot Gray27               = unqtDot "gray27"-  unqtDot Gray28               = unqtDot "gray28"-  unqtDot Gray29               = unqtDot "gray29"-  unqtDot Gray30               = unqtDot "gray30"-  unqtDot Gray31               = unqtDot "gray31"-  unqtDot Gray32               = unqtDot "gray32"-  unqtDot Gray33               = unqtDot "gray33"-  unqtDot Gray34               = unqtDot "gray34"-  unqtDot Gray35               = unqtDot "gray35"-  unqtDot Gray36               = unqtDot "gray36"-  unqtDot Gray37               = unqtDot "gray37"-  unqtDot Gray38               = unqtDot "gray38"-  unqtDot Gray39               = unqtDot "gray39"-  unqtDot Gray40               = unqtDot "gray40"-  unqtDot Gray41               = unqtDot "gray41"-  unqtDot Gray42               = unqtDot "gray42"-  unqtDot Gray43               = unqtDot "gray43"-  unqtDot Gray44               = unqtDot "gray44"-  unqtDot Gray45               = unqtDot "gray45"-  unqtDot Gray46               = unqtDot "gray46"-  unqtDot Gray47               = unqtDot "gray47"-  unqtDot Gray48               = unqtDot "gray48"-  unqtDot Gray49               = unqtDot "gray49"-  unqtDot Gray50               = unqtDot "gray50"-  unqtDot Gray51               = unqtDot "gray51"-  unqtDot Gray52               = unqtDot "gray52"-  unqtDot Gray53               = unqtDot "gray53"-  unqtDot Gray54               = unqtDot "gray54"-  unqtDot Gray55               = unqtDot "gray55"-  unqtDot Gray56               = unqtDot "gray56"-  unqtDot Gray57               = unqtDot "gray57"-  unqtDot Gray58               = unqtDot "gray58"-  unqtDot Gray59               = unqtDot "gray59"-  unqtDot Gray60               = unqtDot "gray60"-  unqtDot Gray61               = unqtDot "gray61"-  unqtDot Gray62               = unqtDot "gray62"-  unqtDot Gray63               = unqtDot "gray63"-  unqtDot Gray64               = unqtDot "gray64"-  unqtDot Gray65               = unqtDot "gray65"-  unqtDot Gray66               = unqtDot "gray66"-  unqtDot Gray67               = unqtDot "gray67"-  unqtDot Gray68               = unqtDot "gray68"-  unqtDot Gray69               = unqtDot "gray69"-  unqtDot Gray70               = unqtDot "gray70"-  unqtDot Gray71               = unqtDot "gray71"-  unqtDot Gray72               = unqtDot "gray72"-  unqtDot Gray73               = unqtDot "gray73"-  unqtDot Gray74               = unqtDot "gray74"-  unqtDot Gray75               = unqtDot "gray75"-  unqtDot Gray76               = unqtDot "gray76"-  unqtDot Gray77               = unqtDot "gray77"-  unqtDot Gray78               = unqtDot "gray78"-  unqtDot Gray79               = unqtDot "gray79"-  unqtDot Gray80               = unqtDot "gray80"-  unqtDot Gray81               = unqtDot "gray81"-  unqtDot Gray82               = unqtDot "gray82"-  unqtDot Gray83               = unqtDot "gray83"-  unqtDot Gray84               = unqtDot "gray84"-  unqtDot Gray85               = unqtDot "gray85"-  unqtDot Gray86               = unqtDot "gray86"-  unqtDot Gray87               = unqtDot "gray87"-  unqtDot Gray88               = unqtDot "gray88"-  unqtDot Gray89               = unqtDot "gray89"-  unqtDot Gray90               = unqtDot "gray90"-  unqtDot Gray91               = unqtDot "gray91"-  unqtDot Gray92               = unqtDot "gray92"-  unqtDot Gray93               = unqtDot "gray93"-  unqtDot Gray94               = unqtDot "gray94"-  unqtDot Gray95               = unqtDot "gray95"-  unqtDot Gray96               = unqtDot "gray96"-  unqtDot Gray97               = unqtDot "gray97"-  unqtDot Gray98               = unqtDot "gray98"-  unqtDot Gray99               = unqtDot "gray99"-  unqtDot Gray100              = unqtDot "gray100"-  unqtDot Green                = unqtDot "green"-  unqtDot Green1               = unqtDot "green1"-  unqtDot Green2               = unqtDot "green2"-  unqtDot Green3               = unqtDot "green3"-  unqtDot Green4               = unqtDot "green4"-  unqtDot GreenYellow          = unqtDot "greenyellow"-  unqtDot HoneyDew             = unqtDot "honeydew"-  unqtDot HoneyDew1            = unqtDot "honeydew1"-  unqtDot HoneyDew2            = unqtDot "honeydew2"-  unqtDot HoneyDew3            = unqtDot "honeydew3"-  unqtDot HoneyDew4            = unqtDot "honeydew4"-  unqtDot HotPink              = unqtDot "hotpink"-  unqtDot HotPink1             = unqtDot "hotpink1"-  unqtDot HotPink2             = unqtDot "hotpink2"-  unqtDot HotPink3             = unqtDot "hotpink3"-  unqtDot HotPink4             = unqtDot "hotpink4"-  unqtDot IndianRed            = unqtDot "indianred"-  unqtDot IndianRed1           = unqtDot "indianred1"-  unqtDot IndianRed2           = unqtDot "indianred2"-  unqtDot IndianRed3           = unqtDot "indianred3"-  unqtDot IndianRed4           = unqtDot "indianred4"-  unqtDot Indigo               = unqtDot "indigo"-  unqtDot Ivory                = unqtDot "ivory"-  unqtDot Ivory1               = unqtDot "ivory1"-  unqtDot Ivory2               = unqtDot "ivory2"-  unqtDot Ivory3               = unqtDot "ivory3"-  unqtDot Ivory4               = unqtDot "ivory4"-  unqtDot Khaki                = unqtDot "khaki"-  unqtDot Khaki1               = unqtDot "khaki1"-  unqtDot Khaki2               = unqtDot "khaki2"-  unqtDot Khaki3               = unqtDot "khaki3"-  unqtDot Khaki4               = unqtDot "khaki4"-  unqtDot Lavender             = unqtDot "lavender"-  unqtDot LavenderBlush        = unqtDot "lavenderblush"-  unqtDot LavenderBlush1       = unqtDot "lavenderblush1"-  unqtDot LavenderBlush2       = unqtDot "lavenderblush2"-  unqtDot LavenderBlush3       = unqtDot "lavenderblush3"-  unqtDot LavenderBlush4       = unqtDot "lavenderblush4"-  unqtDot LawnGreen            = unqtDot "lawngreen"-  unqtDot LemonChiffon         = unqtDot "lemonchiffon"-  unqtDot LemonChiffon1        = unqtDot "lemonchiffon1"-  unqtDot LemonChiffon2        = unqtDot "lemonchiffon2"-  unqtDot LemonChiffon3        = unqtDot "lemonchiffon3"-  unqtDot LemonChiffon4        = unqtDot "lemonchiffon4"-  unqtDot LightBlue            = unqtDot "lightblue"-  unqtDot LightBlue1           = unqtDot "lightblue1"-  unqtDot LightBlue2           = unqtDot "lightblue2"-  unqtDot LightBlue3           = unqtDot "lightblue3"-  unqtDot LightBlue4           = unqtDot "lightblue4"-  unqtDot LightCoral           = unqtDot "lightcoral"-  unqtDot LightCyan            = unqtDot "lightcyan"-  unqtDot LightCyan1           = unqtDot "lightcyan1"-  unqtDot LightCyan2           = unqtDot "lightcyan2"-  unqtDot LightCyan3           = unqtDot "lightcyan3"-  unqtDot LightCyan4           = unqtDot "lightcyan4"-  unqtDot LightGoldenrod       = unqtDot "lightgoldenrod"-  unqtDot LightGoldenrod1      = unqtDot "lightgoldenrod1"-  unqtDot LightGoldenrod2      = unqtDot "lightgoldenrod2"-  unqtDot LightGoldenrod3      = unqtDot "lightgoldenrod3"-  unqtDot LightGoldenrod4      = unqtDot "lightgoldenrod4"-  unqtDot LightGoldenrodYellow = unqtDot "lightgoldenrodyellow"-  unqtDot LightGray            = unqtDot "lightgray"-  unqtDot LightPink            = unqtDot "lightpink"-  unqtDot LightPink1           = unqtDot "lightpink1"-  unqtDot LightPink2           = unqtDot "lightpink2"-  unqtDot LightPink3           = unqtDot "lightpink3"-  unqtDot LightPink4           = unqtDot "lightpink4"-  unqtDot LightSalmon          = unqtDot "lightsalmon"-  unqtDot LightSalmon1         = unqtDot "lightsalmon1"-  unqtDot LightSalmon2         = unqtDot "lightsalmon2"-  unqtDot LightSalmon3         = unqtDot "lightsalmon3"-  unqtDot LightSalmon4         = unqtDot "lightsalmon4"-  unqtDot LightSeaGreen        = unqtDot "lightseagreen"-  unqtDot LightSkyBlue         = unqtDot "lightskyblue"-  unqtDot LightSkyBlue1        = unqtDot "lightskyblue1"-  unqtDot LightSkyBlue2        = unqtDot "lightskyblue2"-  unqtDot LightSkyBlue3        = unqtDot "lightskyblue3"-  unqtDot LightSkyBlue4        = unqtDot "lightskyblue4"-  unqtDot LightSlateBlue       = unqtDot "lightslateblue"-  unqtDot LightSlateGray       = unqtDot "lightslategray"-  unqtDot LightSteelBlue       = unqtDot "lightsteelblue"-  unqtDot LightSteelBlue1      = unqtDot "lightsteelblue1"-  unqtDot LightSteelBlue2      = unqtDot "lightsteelblue2"-  unqtDot LightSteelBlue3      = unqtDot "lightsteelblue3"-  unqtDot LightSteelBlue4      = unqtDot "lightsteelblue4"-  unqtDot LightYellow          = unqtDot "lightyellow"-  unqtDot LightYellow1         = unqtDot "lightyellow1"-  unqtDot LightYellow2         = unqtDot "lightyellow2"-  unqtDot LightYellow3         = unqtDot "lightyellow3"-  unqtDot LightYellow4         = unqtDot "lightyellow4"-  unqtDot LimeGreen            = unqtDot "limegreen"-  unqtDot Linen                = unqtDot "linen"-  unqtDot Magenta              = unqtDot "magenta"-  unqtDot Magenta1             = unqtDot "magenta1"-  unqtDot Magenta2             = unqtDot "magenta2"-  unqtDot Magenta3             = unqtDot "magenta3"-  unqtDot Magenta4             = unqtDot "magenta4"-  unqtDot Maroon               = unqtDot "maroon"-  unqtDot Maroon1              = unqtDot "maroon1"-  unqtDot Maroon2              = unqtDot "maroon2"-  unqtDot Maroon3              = unqtDot "maroon3"-  unqtDot Maroon4              = unqtDot "maroon4"-  unqtDot MediumAquamarine     = unqtDot "mediumaquamarine"-  unqtDot MediumBlue           = unqtDot "mediumblue"-  unqtDot MediumOrchid         = unqtDot "mediumorchid"-  unqtDot MediumOrchid1        = unqtDot "mediumorchid1"-  unqtDot MediumOrchid2        = unqtDot "mediumorchid2"-  unqtDot MediumOrchid3        = unqtDot "mediumorchid3"-  unqtDot MediumOrchid4        = unqtDot "mediumorchid4"-  unqtDot MediumPurple         = unqtDot "mediumpurple"-  unqtDot MediumPurple1        = unqtDot "mediumpurple1"-  unqtDot MediumPurple2        = unqtDot "mediumpurple2"-  unqtDot MediumPurple3        = unqtDot "mediumpurple3"-  unqtDot MediumPurple4        = unqtDot "mediumpurple4"-  unqtDot MediumSeaGreen       = unqtDot "mediumseagreen"-  unqtDot MediumSlateBlue      = unqtDot "mediumslateblue"-  unqtDot MediumSpringGreen    = unqtDot "mediumspringgreen"-  unqtDot MediumTurquoise      = unqtDot "mediumturquoise"-  unqtDot MediumVioletRed      = unqtDot "mediumvioletred"-  unqtDot MidnightBlue         = unqtDot "midnightblue"-  unqtDot MintCream            = unqtDot "mintcream"-  unqtDot MistyRose            = unqtDot "mistyrose"-  unqtDot MistyRose1           = unqtDot "mistyrose1"-  unqtDot MistyRose2           = unqtDot "mistyrose2"-  unqtDot MistyRose3           = unqtDot "mistyrose3"-  unqtDot MistyRose4           = unqtDot "mistyrose4"-  unqtDot Moccasin             = unqtDot "moccasin"-  unqtDot NavajoWhite          = unqtDot "navajowhite"-  unqtDot NavajoWhite1         = unqtDot "navajowhite1"-  unqtDot NavajoWhite2         = unqtDot "navajowhite2"-  unqtDot NavajoWhite3         = unqtDot "navajowhite3"-  unqtDot NavajoWhite4         = unqtDot "navajowhite4"-  unqtDot Navy                 = unqtDot "navy"-  unqtDot NavyBlue             = unqtDot "navyblue"-  unqtDot OldLace              = unqtDot "oldlace"-  unqtDot OliveDrab            = unqtDot "olivedrab"-  unqtDot OliveDrab1           = unqtDot "olivedrab1"-  unqtDot OliveDrab2           = unqtDot "olivedrab2"-  unqtDot OliveDrab3           = unqtDot "olivedrab3"-  unqtDot OliveDrab4           = unqtDot "olivedrab4"-  unqtDot Orange               = unqtDot "orange"-  unqtDot Orange1              = unqtDot "orange1"-  unqtDot Orange2              = unqtDot "orange2"-  unqtDot Orange3              = unqtDot "orange3"-  unqtDot Orange4              = unqtDot "orange4"-  unqtDot OrangeRed            = unqtDot "orangered"-  unqtDot OrangeRed1           = unqtDot "orangered1"-  unqtDot OrangeRed2           = unqtDot "orangered2"-  unqtDot OrangeRed3           = unqtDot "orangered3"-  unqtDot OrangeRed4           = unqtDot "orangered4"-  unqtDot Orchid               = unqtDot "orchid"-  unqtDot Orchid1              = unqtDot "orchid1"-  unqtDot Orchid2              = unqtDot "orchid2"-  unqtDot Orchid3              = unqtDot "orchid3"-  unqtDot Orchid4              = unqtDot "orchid4"-  unqtDot PaleGoldenrod        = unqtDot "palegoldenrod"-  unqtDot PaleGreen            = unqtDot "palegreen"-  unqtDot PaleGreen1           = unqtDot "palegreen1"-  unqtDot PaleGreen2           = unqtDot "palegreen2"-  unqtDot PaleGreen3           = unqtDot "palegreen3"-  unqtDot PaleGreen4           = unqtDot "palegreen4"-  unqtDot PaleTurquoise        = unqtDot "paleturquoise"-  unqtDot PaleTurquoise1       = unqtDot "paleturquoise1"-  unqtDot PaleTurquoise2       = unqtDot "paleturquoise2"-  unqtDot PaleTurquoise3       = unqtDot "paleturquoise3"-  unqtDot PaleTurquoise4       = unqtDot "paleturquoise4"-  unqtDot PaleVioletRed        = unqtDot "palevioletred"-  unqtDot PaleVioletRed1       = unqtDot "palevioletred1"-  unqtDot PaleVioletRed2       = unqtDot "palevioletred2"-  unqtDot PaleVioletRed3       = unqtDot "palevioletred3"-  unqtDot PaleVioletRed4       = unqtDot "palevioletred4"-  unqtDot PapayaWhip           = unqtDot "papayawhip"-  unqtDot PeachPuff            = unqtDot "peachpuff"-  unqtDot PeachPuff1           = unqtDot "peachpuff1"-  unqtDot PeachPuff2           = unqtDot "peachpuff2"-  unqtDot PeachPuff3           = unqtDot "peachpuff3"-  unqtDot PeachPuff4           = unqtDot "peachpuff4"-  unqtDot Peru                 = unqtDot "peru"-  unqtDot Pink                 = unqtDot "pink"-  unqtDot Pink1                = unqtDot "pink1"-  unqtDot Pink2                = unqtDot "pink2"-  unqtDot Pink3                = unqtDot "pink3"-  unqtDot Pink4                = unqtDot "pink4"-  unqtDot Plum                 = unqtDot "plum"-  unqtDot Plum1                = unqtDot "plum1"-  unqtDot Plum2                = unqtDot "plum2"-  unqtDot Plum3                = unqtDot "plum3"-  unqtDot Plum4                = unqtDot "plum4"-  unqtDot PowderBlue           = unqtDot "powderblue"-  unqtDot Purple               = unqtDot "purple"-  unqtDot Purple1              = unqtDot "purple1"-  unqtDot Purple2              = unqtDot "purple2"-  unqtDot Purple3              = unqtDot "purple3"-  unqtDot Purple4              = unqtDot "purple4"-  unqtDot Red                  = unqtDot "red"-  unqtDot Red1                 = unqtDot "red1"-  unqtDot Red2                 = unqtDot "red2"-  unqtDot Red3                 = unqtDot "red3"-  unqtDot Red4                 = unqtDot "red4"-  unqtDot RosyBrown            = unqtDot "rosybrown"-  unqtDot RosyBrown1           = unqtDot "rosybrown1"-  unqtDot RosyBrown2           = unqtDot "rosybrown2"-  unqtDot RosyBrown3           = unqtDot "rosybrown3"-  unqtDot RosyBrown4           = unqtDot "rosybrown4"-  unqtDot RoyalBlue            = unqtDot "royalblue"-  unqtDot RoyalBlue1           = unqtDot "royalblue1"-  unqtDot RoyalBlue2           = unqtDot "royalblue2"-  unqtDot RoyalBlue3           = unqtDot "royalblue3"-  unqtDot RoyalBlue4           = unqtDot "royalblue4"-  unqtDot SaddleBrown          = unqtDot "saddlebrown"-  unqtDot Salmon               = unqtDot "salmon"-  unqtDot Salmon1              = unqtDot "salmon1"-  unqtDot Salmon2              = unqtDot "salmon2"-  unqtDot Salmon3              = unqtDot "salmon3"-  unqtDot Salmon4              = unqtDot "salmon4"-  unqtDot SandyBrown           = unqtDot "sandybrown"-  unqtDot SeaGreen             = unqtDot "seagreen"-  unqtDot SeaGreen1            = unqtDot "seagreen1"-  unqtDot SeaGreen2            = unqtDot "seagreen2"-  unqtDot SeaGreen3            = unqtDot "seagreen3"-  unqtDot SeaGreen4            = unqtDot "seagreen4"-  unqtDot SeaShell             = unqtDot "seashell"-  unqtDot SeaShell1            = unqtDot "seashell1"-  unqtDot SeaShell2            = unqtDot "seashell2"-  unqtDot SeaShell3            = unqtDot "seashell3"-  unqtDot SeaShell4            = unqtDot "seashell4"-  unqtDot Sienna               = unqtDot "sienna"-  unqtDot Sienna1              = unqtDot "sienna1"-  unqtDot Sienna2              = unqtDot "sienna2"-  unqtDot Sienna3              = unqtDot "sienna3"-  unqtDot Sienna4              = unqtDot "sienna4"-  unqtDot SkyBlue              = unqtDot "skyblue"-  unqtDot SkyBlue1             = unqtDot "skyblue1"-  unqtDot SkyBlue2             = unqtDot "skyblue2"-  unqtDot SkyBlue3             = unqtDot "skyblue3"-  unqtDot SkyBlue4             = unqtDot "skyblue4"-  unqtDot SlateBlue            = unqtDot "slateblue"-  unqtDot SlateBlue1           = unqtDot "slateblue1"-  unqtDot SlateBlue2           = unqtDot "slateblue2"-  unqtDot SlateBlue3           = unqtDot "slateblue3"-  unqtDot SlateBlue4           = unqtDot "slateblue4"-  unqtDot SlateGray            = unqtDot "slategray"-  unqtDot SlateGray1           = unqtDot "slategray1"-  unqtDot SlateGray2           = unqtDot "slategray2"-  unqtDot SlateGray3           = unqtDot "slategray3"-  unqtDot SlateGray4           = unqtDot "slategray4"-  unqtDot Snow                 = unqtDot "snow"-  unqtDot Snow1                = unqtDot "snow1"-  unqtDot Snow2                = unqtDot "snow2"-  unqtDot Snow3                = unqtDot "snow3"-  unqtDot Snow4                = unqtDot "snow4"-  unqtDot SpringGreen          = unqtDot "springgreen"-  unqtDot SpringGreen1         = unqtDot "springgreen1"-  unqtDot SpringGreen2         = unqtDot "springgreen2"-  unqtDot SpringGreen3         = unqtDot "springgreen3"-  unqtDot SpringGreen4         = unqtDot "springgreen4"-  unqtDot SteelBlue            = unqtDot "steelblue"-  unqtDot SteelBlue1           = unqtDot "steelblue1"-  unqtDot SteelBlue2           = unqtDot "steelblue2"-  unqtDot SteelBlue3           = unqtDot "steelblue3"-  unqtDot SteelBlue4           = unqtDot "steelblue4"-  unqtDot Tan                  = unqtDot "tan"-  unqtDot Tan1                 = unqtDot "tan1"-  unqtDot Tan2                 = unqtDot "tan2"-  unqtDot Tan3                 = unqtDot "tan3"-  unqtDot Tan4                 = unqtDot "tan4"-  unqtDot Thistle              = unqtDot "thistle"-  unqtDot Thistle1             = unqtDot "thistle1"-  unqtDot Thistle2             = unqtDot "thistle2"-  unqtDot Thistle3             = unqtDot "thistle3"-  unqtDot Thistle4             = unqtDot "thistle4"-  unqtDot Tomato               = unqtDot "tomato"-  unqtDot Tomato1              = unqtDot "tomato1"-  unqtDot Tomato2              = unqtDot "tomato2"-  unqtDot Tomato3              = unqtDot "tomato3"-  unqtDot Tomato4              = unqtDot "tomato4"-  unqtDot Transparent          = unqtDot "transparent"-  unqtDot Turquoise            = unqtDot "turquoise"-  unqtDot Turquoise1           = unqtDot "turquoise1"-  unqtDot Turquoise2           = unqtDot "turquoise2"-  unqtDot Turquoise3           = unqtDot "turquoise3"-  unqtDot Turquoise4           = unqtDot "turquoise4"-  unqtDot Violet               = unqtDot "violet"-  unqtDot VioletRed            = unqtDot "violetred"-  unqtDot VioletRed1           = unqtDot "violetred1"-  unqtDot VioletRed2           = unqtDot "violetred2"-  unqtDot VioletRed3           = unqtDot "violetred3"-  unqtDot VioletRed4           = unqtDot "violetred4"-  unqtDot Wheat                = unqtDot "wheat"-  unqtDot Wheat1               = unqtDot "wheat1"-  unqtDot Wheat2               = unqtDot "wheat2"-  unqtDot Wheat3               = unqtDot "wheat3"-  unqtDot Wheat4               = unqtDot "wheat4"-  unqtDot White                = unqtDot "white"-  unqtDot WhiteSmoke           = unqtDot "whitesmoke"-  unqtDot Yellow               = unqtDot "yellow"-  unqtDot Yellow1              = unqtDot "yellow1"-  unqtDot Yellow2              = unqtDot "yellow2"-  unqtDot Yellow3              = unqtDot "yellow3"-  unqtDot Yellow4              = unqtDot "yellow4"-  unqtDot YellowGreen          = unqtDot "yellowgreen"--instance ParseDot X11Color where-  parseUnqt = oneOf-              $ reverse [ stringRep  AliceBlue "aliceblue"-                        , stringRep  AntiqueWhite "antiquewhite"-                        , stringRep  AntiqueWhite1 "antiquewhite1"-                        , stringRep  AntiqueWhite2 "antiquewhite2"-                        , stringRep  AntiqueWhite3 "antiquewhite3"-                        , stringRep  AntiqueWhite4 "antiquewhite4"-                        , stringRep  Aquamarine "aquamarine"-                        , stringRep  Aquamarine1 "aquamarine1"-                        , stringRep  Aquamarine2 "aquamarine2"-                        , stringRep  Aquamarine3 "aquamarine3"-                        , stringRep  Aquamarine4 "aquamarine4"-                        , stringRep  Azure "azure"-                        , stringRep  Azure1 "azure1"-                        , stringRep  Azure2 "azure2"-                        , stringRep  Azure3 "azure3"-                        , stringRep  Azure4 "azure4"-                        , stringRep  Beige "beige"-                        , stringRep  Bisque "bisque"-                        , stringRep  Bisque1 "bisque1"-                        , stringRep  Bisque2 "bisque2"-                        , stringRep  Bisque3 "bisque3"-                        , stringRep  Bisque4 "bisque4"-                        , stringRep  Black "black"-                        , stringRep  BlanchedAlmond "blanchedalmond"-                        , stringRep  Blue "blue"-                        , stringRep  Blue1 "blue1"-                        , stringRep  Blue2 "blue2"-                        , stringRep  Blue3 "blue3"-                        , stringRep  Blue4 "blue4"-                        , stringRep  BlueViolet "blueviolet"-                        , stringRep  Brown "brown"-                        , stringRep  Brown1 "brown1"-                        , stringRep  Brown2 "brown2"-                        , stringRep  Brown3 "brown3"-                        , stringRep  Brown4 "brown4"-                        , stringRep  Burlywood "burlywood"-                        , stringRep  Burlywood1 "burlywood1"-                        , stringRep  Burlywood2 "burlywood2"-                        , stringRep  Burlywood3 "burlywood3"-                        , stringRep  Burlywood4 "burlywood4"-                        , stringRep  CadetBlue "cadetblue"-                        , stringRep  CadetBlue1 "cadetblue1"-                        , stringRep  CadetBlue2 "cadetblue2"-                        , stringRep  CadetBlue3 "cadetblue3"-                        , stringRep  CadetBlue4 "cadetblue4"-                        , stringRep  Chartreuse "chartreuse"-                        , stringRep  Chartreuse1 "chartreuse1"-                        , stringRep  Chartreuse2 "chartreuse2"-                        , stringRep  Chartreuse3 "chartreuse3"-                        , stringRep  Chartreuse4 "chartreuse4"-                        , stringRep  Chocolate "chocolate"-                        , stringRep  Chocolate1 "chocolate1"-                        , stringRep  Chocolate2 "chocolate2"-                        , stringRep  Chocolate3 "chocolate3"-                        , stringRep  Chocolate4 "chocolate4"-                        , stringRep  Coral "coral"-                        , stringRep  Coral1 "coral1"-                        , stringRep  Coral2 "coral2"-                        , stringRep  Coral3 "coral3"-                        , stringRep  Coral4 "coral4"-                        , stringRep  CornFlowerBlue "cornflowerblue"-                        , stringRep  CornSilk "cornsilk"-                        , stringRep  CornSilk1 "cornsilk1"-                        , stringRep  CornSilk2 "cornsilk2"-                        , stringRep  CornSilk3 "cornsilk3"-                        , stringRep  CornSilk4 "cornsilk4"-                        , stringRep  Crimson "crimson"-                        , stringRep  Cyan "cyan"-                        , stringRep  Cyan1 "cyan1"-                        , stringRep  Cyan2 "cyan2"-                        , stringRep  Cyan3 "cyan3"-                        , stringRep  Cyan4 "cyan4"-                        , stringRep  DarkGoldenrod "darkgoldenrod"-                        , stringRep  DarkGoldenrod1 "darkgoldenrod1"-                        , stringRep  DarkGoldenrod2 "darkgoldenrod2"-                        , stringRep  DarkGoldenrod3 "darkgoldenrod3"-                        , stringRep  DarkGoldenrod4 "darkgoldenrod4"-                        , stringRep  DarkGreen "darkgreen"-                        , stringRep  Darkkhaki "darkkhaki"-                        , stringRep  DarkOliveGreen "darkolivegreen"-                        , stringRep  DarkOliveGreen1 "darkolivegreen1"-                        , stringRep  DarkOliveGreen2 "darkolivegreen2"-                        , stringRep  DarkOliveGreen3 "darkolivegreen3"-                        , stringRep  DarkOliveGreen4 "darkolivegreen4"-                        , stringRep  DarkOrange "darkorange"-                        , stringRep  DarkOrange1 "darkorange1"-                        , stringRep  DarkOrange2 "darkorange2"-                        , stringRep  DarkOrange3 "darkorange3"-                        , stringRep  DarkOrange4 "darkorange4"-                        , stringRep  DarkOrchid "darkorchid"-                        , stringRep  DarkOrchid1 "darkorchid1"-                        , stringRep  DarkOrchid2 "darkorchid2"-                        , stringRep  DarkOrchid3 "darkorchid3"-                        , stringRep  DarkOrchid4 "darkorchid4"-                        , stringRep  DarkSalmon "darksalmon"-                        , stringRep  DarkSeaGreen "darkseagreen"-                        , stringRep  DarkSeaGreen1 "darkseagreen1"-                        , stringRep  DarkSeaGreen2 "darkseagreen2"-                        , stringRep  DarkSeaGreen3 "darkseagreen3"-                        , stringRep  DarkSeaGreen4 "darkseagreen4"-                        , stringRep  DarkSlateBlue "darkslateblue"-                        , stringReps DarkSlateGray ["darkslategray", "darkslategrey"]-                        , stringReps DarkSlateGray1 ["darkslategray1", "darkslategrey1"]-                        , stringReps DarkSlateGray2 ["darkslategray2", "darkslategrey2"]-                        , stringReps DarkSlateGray3 ["darkslategray3", "darkslategrey3"]-                        , stringReps DarkSlateGray4 ["darkslategray4", "darkslategrey4"]-                        , stringRep  DarkTurquoise "darkturquoise"-                        , stringRep  DarkViolet "darkviolet"-                        , stringRep  DeepPink "deeppink"-                        , stringRep  DeepPink1 "deeppink1"-                        , stringRep  DeepPink2 "deeppink2"-                        , stringRep  DeepPink3 "deeppink3"-                        , stringRep  DeepPink4 "deeppink4"-                        , stringRep  DeepSkyBlue "deepskyblue"-                        , stringRep  DeepSkyBlue1 "deepskyblue1"-                        , stringRep  DeepSkyBlue2 "deepskyblue2"-                        , stringRep  DeepSkyBlue3 "deepskyblue3"-                        , stringRep  DeepSkyBlue4 "deepskyblue4"-                        , stringReps DimGray ["dimgray", "dimgrey"]-                        , stringRep  DodgerBlue "dodgerblue"-                        , stringRep  DodgerBlue1 "dodgerblue1"-                        , stringRep  DodgerBlue2 "dodgerblue2"-                        , stringRep  DodgerBlue3 "dodgerblue3"-                        , stringRep  DodgerBlue4 "dodgerblue4"-                        , stringRep  Firebrick "firebrick"-                        , stringRep  Firebrick1 "firebrick1"-                        , stringRep  Firebrick2 "firebrick2"-                        , stringRep  Firebrick3 "firebrick3"-                        , stringRep  Firebrick4 "firebrick4"-                        , stringRep  FloralWhite "floralwhite"-                        , stringRep  ForestGreen "forestgreen"-                        , stringRep  Gainsboro "gainsboro"-                        , stringRep  GhostWhite "ghostwhite"-                        , stringRep  Gold "gold"-                        , stringRep  Gold1 "gold1"-                        , stringRep  Gold2 "gold2"-                        , stringRep  Gold3 "gold3"-                        , stringRep  Gold4 "gold4"-                        , stringRep  Goldenrod "goldenrod"-                        , stringRep  Goldenrod1 "goldenrod1"-                        , stringRep  Goldenrod2 "goldenrod2"-                        , stringRep  Goldenrod3 "goldenrod3"-                        , stringRep  Goldenrod4 "goldenrod4"-                        , stringReps Gray ["gray", "grey"]-                        , stringReps Gray0 ["gray0", "grey0"]-                        , stringReps Gray1 ["gray1", "grey1"]-                        , stringReps Gray2 ["gray2", "grey2"]-                        , stringReps Gray3 ["gray3", "grey3"]-                        , stringReps Gray4 ["gray4", "grey4"]-                        , stringReps Gray5 ["gray5", "grey5"]-                        , stringReps Gray6 ["gray6", "grey6"]-                        , stringReps Gray7 ["gray7", "grey7"]-                        , stringReps Gray8 ["gray8", "grey8"]-                        , stringReps Gray9 ["gray9", "grey9"]-                        , stringReps Gray10 ["gray10", "grey10"]-                        , stringReps Gray11 ["gray11", "grey11"]-                        , stringReps Gray12 ["gray12", "grey12"]-                        , stringReps Gray13 ["gray13", "grey13"]-                        , stringReps Gray14 ["gray14", "grey14"]-                        , stringReps Gray15 ["gray15", "grey15"]-                        , stringReps Gray16 ["gray16", "grey16"]-                        , stringReps Gray17 ["gray17", "grey17"]-                        , stringReps Gray18 ["gray18", "grey18"]-                        , stringReps Gray19 ["gray19", "grey19"]-                        , stringReps Gray20 ["gray20", "grey20"]-                        , stringReps Gray21 ["gray21", "grey21"]-                        , stringReps Gray22 ["gray22", "grey22"]-                        , stringReps Gray23 ["gray23", "grey23"]-                        , stringReps Gray24 ["gray24", "grey24"]-                        , stringReps Gray25 ["gray25", "grey25"]-                        , stringReps Gray26 ["gray26", "grey26"]-                        , stringReps Gray27 ["gray27", "grey27"]-                        , stringReps Gray28 ["gray28", "grey28"]-                        , stringReps Gray29 ["gray29", "grey29"]-                        , stringReps Gray30 ["gray30", "grey30"]-                        , stringReps Gray31 ["gray31", "grey31"]-                        , stringReps Gray32 ["gray32", "grey32"]-                        , stringReps Gray33 ["gray33", "grey33"]-                        , stringReps Gray34 ["gray34", "grey34"]-                        , stringReps Gray35 ["gray35", "grey35"]-                        , stringReps Gray36 ["gray36", "grey36"]-                        , stringReps Gray37 ["gray37", "grey37"]-                        , stringReps Gray38 ["gray38", "grey38"]-                        , stringReps Gray39 ["gray39", "grey39"]-                        , stringReps Gray40 ["gray40", "grey40"]-                        , stringReps Gray41 ["gray41", "grey41"]-                        , stringReps Gray42 ["gray42", "grey42"]-                        , stringReps Gray43 ["gray43", "grey43"]-                        , stringReps Gray44 ["gray44", "grey44"]-                        , stringReps Gray45 ["gray45", "grey45"]-                        , stringReps Gray46 ["gray46", "grey46"]-                        , stringReps Gray47 ["gray47", "grey47"]-                        , stringReps Gray48 ["gray48", "grey48"]-                        , stringReps Gray49 ["gray49", "grey49"]-                        , stringReps Gray50 ["gray50", "grey50"]-                        , stringReps Gray51 ["gray51", "grey51"]-                        , stringReps Gray52 ["gray52", "grey52"]-                        , stringReps Gray53 ["gray53", "grey53"]-                        , stringReps Gray54 ["gray54", "grey54"]-                        , stringReps Gray55 ["gray55", "grey55"]-                        , stringReps Gray56 ["gray56", "grey56"]-                        , stringReps Gray57 ["gray57", "grey57"]-                        , stringReps Gray58 ["gray58", "grey58"]-                        , stringReps Gray59 ["gray59", "grey59"]-                        , stringReps Gray60 ["gray60", "grey60"]-                        , stringReps Gray61 ["gray61", "grey61"]-                        , stringReps Gray62 ["gray62", "grey62"]-                        , stringReps Gray63 ["gray63", "grey63"]-                        , stringReps Gray64 ["gray64", "grey64"]-                        , stringReps Gray65 ["gray65", "grey65"]-                        , stringReps Gray66 ["gray66", "grey66"]-                        , stringReps Gray67 ["gray67", "grey67"]-                        , stringReps Gray68 ["gray68", "grey68"]-                        , stringReps Gray69 ["gray69", "grey69"]-                        , stringReps Gray70 ["gray70", "grey70"]-                        , stringReps Gray71 ["gray71", "grey71"]-                        , stringReps Gray72 ["gray72", "grey72"]-                        , stringReps Gray73 ["gray73", "grey73"]-                        , stringReps Gray74 ["gray74", "grey74"]-                        , stringReps Gray75 ["gray75", "grey75"]-                        , stringReps Gray76 ["gray76", "grey76"]-                        , stringReps Gray77 ["gray77", "grey77"]-                        , stringReps Gray78 ["gray78", "grey78"]-                        , stringReps Gray79 ["gray79", "grey79"]-                        , stringReps Gray80 ["gray80", "grey80"]-                        , stringReps Gray81 ["gray81", "grey81"]-                        , stringReps Gray82 ["gray82", "grey82"]-                        , stringReps Gray83 ["gray83", "grey83"]-                        , stringReps Gray84 ["gray84", "grey84"]-                        , stringReps Gray85 ["gray85", "grey85"]-                        , stringReps Gray86 ["gray86", "grey86"]-                        , stringReps Gray87 ["gray87", "grey87"]-                        , stringReps Gray88 ["gray88", "grey88"]-                        , stringReps Gray89 ["gray89", "grey89"]-                        , stringReps Gray90 ["gray90", "grey90"]-                        , stringReps Gray91 ["gray91", "grey91"]-                        , stringReps Gray92 ["gray92", "grey92"]-                        , stringReps Gray93 ["gray93", "grey93"]-                        , stringReps Gray94 ["gray94", "grey94"]-                        , stringReps Gray95 ["gray95", "grey95"]-                        , stringReps Gray96 ["gray96", "grey96"]-                        , stringReps Gray97 ["gray97", "grey97"]-                        , stringReps Gray98 ["gray98", "grey98"]-                        , stringReps Gray99 ["gray99", "grey99"]-                        , stringReps Gray100 ["gray100", "grey100"]-                        , stringRep  Green "green"-                        , stringRep  Green1 "green1"-                        , stringRep  Green2 "green2"-                        , stringRep  Green3 "green3"-                        , stringRep  Green4 "green4"-                        , stringRep  GreenYellow "greenyellow"-                        , stringRep  HoneyDew "honeydew"-                        , stringRep  HoneyDew1 "honeydew1"-                        , stringRep  HoneyDew2 "honeydew2"-                        , stringRep  HoneyDew3 "honeydew3"-                        , stringRep  HoneyDew4 "honeydew4"-                        , stringRep  HotPink "hotpink"-                        , stringRep  HotPink1 "hotpink1"-                        , stringRep  HotPink2 "hotpink2"-                        , stringRep  HotPink3 "hotpink3"-                        , stringRep  HotPink4 "hotpink4"-                        , stringRep  IndianRed "indianred"-                        , stringRep  IndianRed1 "indianred1"-                        , stringRep  IndianRed2 "indianred2"-                        , stringRep  IndianRed3 "indianred3"-                        , stringRep  IndianRed4 "indianred4"-                        , stringRep  Indigo "indigo"-                        , stringRep  Ivory "ivory"-                        , stringRep  Ivory1 "ivory1"-                        , stringRep  Ivory2 "ivory2"-                        , stringRep  Ivory3 "ivory3"-                        , stringRep  Ivory4 "ivory4"-                        , stringRep  Khaki "khaki"-                        , stringRep  Khaki1 "khaki1"-                        , stringRep  Khaki2 "khaki2"-                        , stringRep  Khaki3 "khaki3"-                        , stringRep  Khaki4 "khaki4"-                        , stringRep  Lavender "lavender"-                        , stringRep  LavenderBlush "lavenderblush"-                        , stringRep  LavenderBlush1 "lavenderblush1"-                        , stringRep  LavenderBlush2 "lavenderblush2"-                        , stringRep  LavenderBlush3 "lavenderblush3"-                        , stringRep  LavenderBlush4 "lavenderblush4"-                        , stringRep  LawnGreen "lawngreen"-                        , stringRep  LemonChiffon "lemonchiffon"-                        , stringRep  LemonChiffon1 "lemonchiffon1"-                        , stringRep  LemonChiffon2 "lemonchiffon2"-                        , stringRep  LemonChiffon3 "lemonchiffon3"-                        , stringRep  LemonChiffon4 "lemonchiffon4"-                        , stringRep  LightBlue "lightblue"-                        , stringRep  LightBlue1 "lightblue1"-                        , stringRep  LightBlue2 "lightblue2"-                        , stringRep  LightBlue3 "lightblue3"-                        , stringRep  LightBlue4 "lightblue4"-                        , stringRep  LightCoral "lightcoral"-                        , stringRep  LightCyan "lightcyan"-                        , stringRep  LightCyan1 "lightcyan1"-                        , stringRep  LightCyan2 "lightcyan2"-                        , stringRep  LightCyan3 "lightcyan3"-                        , stringRep  LightCyan4 "lightcyan4"-                        , stringRep  LightGoldenrod "lightgoldenrod"-                        , stringRep  LightGoldenrod1 "lightgoldenrod1"-                        , stringRep  LightGoldenrod2 "lightgoldenrod2"-                        , stringRep  LightGoldenrod3 "lightgoldenrod3"-                        , stringRep  LightGoldenrod4 "lightgoldenrod4"-                        , stringRep  LightGoldenrodYellow "lightgoldenrodyellow"-                        , stringReps LightGray ["lightgray", "lightgrey"]-                        , stringRep  LightPink "lightpink"-                        , stringRep  LightPink1 "lightpink1"-                        , stringRep  LightPink2 "lightpink2"-                        , stringRep  LightPink3 "lightpink3"-                        , stringRep  LightPink4 "lightpink4"-                        , stringRep  LightSalmon "lightsalmon"-                        , stringRep  LightSalmon1 "lightsalmon1"-                        , stringRep  LightSalmon2 "lightsalmon2"-                        , stringRep  LightSalmon3 "lightsalmon3"-                        , stringRep  LightSalmon4 "lightsalmon4"-                        , stringRep  LightSeaGreen "lightseagreen"-                        , stringRep  LightSkyBlue "lightskyblue"-                        , stringRep  LightSkyBlue1 "lightskyblue1"-                        , stringRep  LightSkyBlue2 "lightskyblue2"-                        , stringRep  LightSkyBlue3 "lightskyblue3"-                        , stringRep  LightSkyBlue4 "lightskyblue4"-                        , stringRep  LightSlateBlue "lightslateblue"-                        , stringReps LightSlateGray ["lightslategray", "lightslategrey"]-                        , stringRep  LightSteelBlue "lightsteelblue"-                        , stringRep  LightSteelBlue1 "lightsteelblue1"-                        , stringRep  LightSteelBlue2 "lightsteelblue2"-                        , stringRep  LightSteelBlue3 "lightsteelblue3"-                        , stringRep  LightSteelBlue4 "lightsteelblue4"-                        , stringRep  LightYellow "lightyellow"-                        , stringRep  LightYellow1 "lightyellow1"-                        , stringRep  LightYellow2 "lightyellow2"-                        , stringRep  LightYellow3 "lightyellow3"-                        , stringRep  LightYellow4 "lightyellow4"-                        , stringRep  LimeGreen "limegreen"-                        , stringRep  Linen "linen"-                        , stringRep  Magenta "magenta"-                        , stringRep  Magenta1 "magenta1"-                        , stringRep  Magenta2 "magenta2"-                        , stringRep  Magenta3 "magenta3"-                        , stringRep  Magenta4 "magenta4"-                        , stringRep  Maroon "maroon"-                        , stringRep  Maroon1 "maroon1"-                        , stringRep  Maroon2 "maroon2"-                        , stringRep  Maroon3 "maroon3"-                        , stringRep  Maroon4 "maroon4"-                        , stringRep  MediumAquamarine "mediumaquamarine"-                        , stringRep  MediumBlue "mediumblue"-                        , stringRep  MediumOrchid "mediumorchid"-                        , stringRep  MediumOrchid1 "mediumorchid1"-                        , stringRep  MediumOrchid2 "mediumorchid2"-                        , stringRep  MediumOrchid3 "mediumorchid3"-                        , stringRep  MediumOrchid4 "mediumorchid4"-                        , stringRep  MediumPurple "mediumpurple"-                        , stringRep  MediumPurple1 "mediumpurple1"-                        , stringRep  MediumPurple2 "mediumpurple2"-                        , stringRep  MediumPurple3 "mediumpurple3"-                        , stringRep  MediumPurple4 "mediumpurple4"-                        , stringRep  MediumSeaGreen "mediumseagreen"-                        , stringRep  MediumSlateBlue "mediumslateblue"-                        , stringRep  MediumSpringGreen "mediumspringgreen"-                        , stringRep  MediumTurquoise "mediumturquoise"-                        , stringRep  MediumVioletRed "mediumvioletred"-                        , stringRep  MidnightBlue "midnightblue"-                        , stringRep  MintCream "mintcream"-                        , stringRep  MistyRose "mistyrose"-                        , stringRep  MistyRose1 "mistyrose1"-                        , stringRep  MistyRose2 "mistyrose2"-                        , stringRep  MistyRose3 "mistyrose3"-                        , stringRep  MistyRose4 "mistyrose4"-                        , stringRep  Moccasin "moccasin"-                        , stringRep  NavajoWhite "navajowhite"-                        , stringRep  NavajoWhite1 "navajowhite1"-                        , stringRep  NavajoWhite2 "navajowhite2"-                        , stringRep  NavajoWhite3 "navajowhite3"-                        , stringRep  NavajoWhite4 "navajowhite4"-                        , stringRep  Navy "navy"-                        , stringRep  NavyBlue "navyblue"-                        , stringRep  OldLace "oldlace"-                        , stringRep  OliveDrab "olivedrab"-                        , stringRep  OliveDrab1 "olivedrab1"-                        , stringRep  OliveDrab2 "olivedrab2"-                        , stringRep  OliveDrab3 "olivedrab3"-                        , stringRep  OliveDrab4 "olivedrab4"-                        , stringRep  Orange "orange"-                        , stringRep  Orange1 "orange1"-                        , stringRep  Orange2 "orange2"-                        , stringRep  Orange3 "orange3"-                        , stringRep  Orange4 "orange4"-                        , stringRep  OrangeRed "orangered"-                        , stringRep  OrangeRed1 "orangered1"-                        , stringRep  OrangeRed2 "orangered2"-                        , stringRep  OrangeRed3 "orangered3"-                        , stringRep  OrangeRed4 "orangered4"-                        , stringRep  Orchid "orchid"-                        , stringRep  Orchid1 "orchid1"-                        , stringRep  Orchid2 "orchid2"-                        , stringRep  Orchid3 "orchid3"-                        , stringRep  Orchid4 "orchid4"-                        , stringRep  PaleGoldenrod "palegoldenrod"-                        , stringRep  PaleGreen "palegreen"-                        , stringRep  PaleGreen1 "palegreen1"-                        , stringRep  PaleGreen2 "palegreen2"-                        , stringRep  PaleGreen3 "palegreen3"-                        , stringRep  PaleGreen4 "palegreen4"-                        , stringRep  PaleTurquoise "paleturquoise"-                        , stringRep  PaleTurquoise1 "paleturquoise1"-                        , stringRep  PaleTurquoise2 "paleturquoise2"-                        , stringRep  PaleTurquoise3 "paleturquoise3"-                        , stringRep  PaleTurquoise4 "paleturquoise4"-                        , stringRep  PaleVioletRed "palevioletred"-                        , stringRep  PaleVioletRed1 "palevioletred1"-                        , stringRep  PaleVioletRed2 "palevioletred2"-                        , stringRep  PaleVioletRed3 "palevioletred3"-                        , stringRep  PaleVioletRed4 "palevioletred4"-                        , stringRep  PapayaWhip "papayawhip"-                        , stringRep  PeachPuff "peachpuff"-                        , stringRep  PeachPuff1 "peachpuff1"-                        , stringRep  PeachPuff2 "peachpuff2"-                        , stringRep  PeachPuff3 "peachpuff3"-                        , stringRep  PeachPuff4 "peachpuff4"-                        , stringRep  Peru "peru"-                        , stringRep  Pink "pink"-                        , stringRep  Pink1 "pink1"-                        , stringRep  Pink2 "pink2"-                        , stringRep  Pink3 "pink3"-                        , stringRep  Pink4 "pink4"-                        , stringRep  Plum "plum"-                        , stringRep  Plum1 "plum1"-                        , stringRep  Plum2 "plum2"-                        , stringRep  Plum3 "plum3"-                        , stringRep  Plum4 "plum4"-                        , stringRep  PowderBlue "powderblue"-                        , stringRep  Purple "purple"-                        , stringRep  Purple1 "purple1"-                        , stringRep  Purple2 "purple2"-                        , stringRep  Purple3 "purple3"-                        , stringRep  Purple4 "purple4"-                        , stringRep  Red "red"-                        , stringRep  Red1 "red1"-                        , stringRep  Red2 "red2"-                        , stringRep  Red3 "red3"-                        , stringRep  Red4 "red4"-                        , stringRep  RosyBrown "rosybrown"-                        , stringRep  RosyBrown1 "rosybrown1"-                        , stringRep  RosyBrown2 "rosybrown2"-                        , stringRep  RosyBrown3 "rosybrown3"-                        , stringRep  RosyBrown4 "rosybrown4"-                        , stringRep  RoyalBlue "royalblue"-                        , stringRep  RoyalBlue1 "royalblue1"-                        , stringRep  RoyalBlue2 "royalblue2"-                        , stringRep  RoyalBlue3 "royalblue3"-                        , stringRep  RoyalBlue4 "royalblue4"-                        , stringRep  SaddleBrown "saddlebrown"-                        , stringRep  Salmon "salmon"-                        , stringRep  Salmon1 "salmon1"-                        , stringRep  Salmon2 "salmon2"-                        , stringRep  Salmon3 "salmon3"-                        , stringRep  Salmon4 "salmon4"-                        , stringRep  SandyBrown "sandybrown"-                        , stringRep  SeaGreen "seagreen"-                        , stringRep  SeaGreen1 "seagreen1"-                        , stringRep  SeaGreen2 "seagreen2"-                        , stringRep  SeaGreen3 "seagreen3"-                        , stringRep  SeaGreen4 "seagreen4"-                        , stringRep  SeaShell "seashell"-                        , stringRep  SeaShell1 "seashell1"-                        , stringRep  SeaShell2 "seashell2"-                        , stringRep  SeaShell3 "seashell3"-                        , stringRep  SeaShell4 "seashell4"-                        , stringRep  Sienna "sienna"-                        , stringRep  Sienna1 "sienna1"-                        , stringRep  Sienna2 "sienna2"-                        , stringRep  Sienna3 "sienna3"-                        , stringRep  Sienna4 "sienna4"-                        , stringRep  SkyBlue "skyblue"-                        , stringRep  SkyBlue1 "skyblue1"-                        , stringRep  SkyBlue2 "skyblue2"-                        , stringRep  SkyBlue3 "skyblue3"-                        , stringRep  SkyBlue4 "skyblue4"-                        , stringRep  SlateBlue "slateblue"-                        , stringRep  SlateBlue1 "slateblue1"-                        , stringRep  SlateBlue2 "slateblue2"-                        , stringRep  SlateBlue3 "slateblue3"-                        , stringRep  SlateBlue4 "slateblue4"-                        , stringReps SlateGray ["slategray", "slategrey"]-                        , stringReps SlateGray1 ["slategray1", "slategrey1"]-                        , stringReps SlateGray2 ["slategray2", "slategrey2"]-                        , stringReps SlateGray3 ["slategray3", "slategrey3"]-                        , stringReps SlateGray4 ["slategray4", "slategrey4"]-                        , stringRep  Snow "snow"-                        , stringRep  Snow1 "snow1"-                        , stringRep  Snow2 "snow2"-                        , stringRep  Snow3 "snow3"-                        , stringRep  Snow4 "snow4"-                        , stringRep  SpringGreen "springgreen"-                        , stringRep  SpringGreen1 "springgreen1"-                        , stringRep  SpringGreen2 "springgreen2"-                        , stringRep  SpringGreen3 "springgreen3"-                        , stringRep  SpringGreen4 "springgreen4"-                        , stringRep  SteelBlue "steelblue"-                        , stringRep  SteelBlue1 "steelblue1"-                        , stringRep  SteelBlue2 "steelblue2"-                        , stringRep  SteelBlue3 "steelblue3"-                        , stringRep  SteelBlue4 "steelblue4"-                        , stringRep  Tan "tan"-                        , stringRep  Tan1 "tan1"-                        , stringRep  Tan2 "tan2"-                        , stringRep  Tan3 "tan3"-                        , stringRep  Tan4 "tan4"-                        , stringRep  Thistle "thistle"-                        , stringRep  Thistle1 "thistle1"-                        , stringRep  Thistle2 "thistle2"-                        , stringRep  Thistle3 "thistle3"-                        , stringRep  Thistle4 "thistle4"-                        , stringRep  Tomato "tomato"-                        , stringRep  Tomato1 "tomato1"-                        , stringRep  Tomato2 "tomato2"-                        , stringRep  Tomato3 "tomato3"-                        , stringRep  Tomato4 "tomato4"-                        , stringReps Transparent ["transparent", "invis", "none"]-                        , stringRep  Turquoise "turquoise"-                        , stringRep  Turquoise1 "turquoise1"-                        , stringRep  Turquoise2 "turquoise2"-                        , stringRep  Turquoise3 "turquoise3"-                        , stringRep  Turquoise4 "turquoise4"-                        , stringRep  Violet "violet"-                        , stringRep  VioletRed "violetred"-                        , stringRep  VioletRed1 "violetred1"-                        , stringRep  VioletRed2 "violetred2"-                        , stringRep  VioletRed3 "violetred3"-                        , stringRep  VioletRed4 "violetred4"-                        , stringRep  Wheat "wheat"-                        , stringRep  Wheat1 "wheat1"-                        , stringRep  Wheat2 "wheat2"-                        , stringRep  Wheat3 "wheat3"-                        , stringRep  Wheat4 "wheat4"-                        , stringRep  White "white"-                        , stringRep  WhiteSmoke "whitesmoke"-                        , stringRep  Yellow "yellow"-                        , stringRep  Yellow1 "yellow1"-                        , stringRep  Yellow2 "yellow2"-                        , stringRep  Yellow3 "yellow3"-                        , stringRep  Yellow4 "yellow4"-                        , stringRep  YellowGreen "yellowgreen"-                        ]+{-# LANGUAGE OverloadedStrings #-}++{- |+   Module      : Data.GraphViz.Attributes.Colors+   Description : Specification of Color-related types and functions.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines the various colors, etc. for Graphviz.  For+   information on colors in general, see:+     <http://graphviz.org/doc/info/attrs.html#k:color>+   For named colors, see:+     <http://graphviz.org/doc/info/colors.html>++   Note that the ColorBrewer Color Schemes (shortened to just+   \"Brewer\" for the rest of this module) are covered by the+   following license (also available in the LICENSE file of this+   library):+     <http://graphviz.org/doc/info/colors.html#brewer_license>+-}+module Data.GraphViz.Attributes.Colors+       ( -- * Color schemes.+         ColorScheme(..)+       , BrewerScheme(..)+       , BrewerName(..)+         -- * Colors+       , Color(..)+       , X11Color(..)+         -- * Conversion to\/from @Colour@.+       , toColour+       , x11Colour+       , fromColour+       , fromAColour+       ) where++import Data.GraphViz.Parsing+import Data.GraphViz.Printing+import Data.GraphViz.State+import Data.GraphViz.Attributes.ColorScheme+import Data.GraphViz.Util(bool)+import Data.GraphViz.Exception++import Data.Colour( AlphaColour, opaque, transparent, withOpacity+                  , over, black, alphaChannel, darken)+import Data.Colour.SRGB(Colour, sRGB, sRGB24, toSRGB24)+import Data.Colour.RGBSpace(uncurryRGB)+import Data.Colour.RGBSpace.HSV(hsv)++import Data.Char(isHexDigit)+import Numeric(showHex, readHex)+import Data.Word(Word8)+import qualified Data.Text.Lazy as T+import Control.Monad(liftM)++-- -----------------------------------------------------------------------------++-- | Defining a color for use with Graphviz.  Note that named colors+--   have been split up into 'X11Color's and those based upon the+--   Brewer color schemes.+data Color = RGB { red   :: Word8+                 , green :: Word8+                 , blue  :: Word8+                 }+           | RGBA { red   :: Word8+                  , green :: Word8+                  , blue  :: Word8+                  , alpha :: Word8+                  }+             -- | The 'hue', 'saturation' and 'value' values must all+             --   be @0 <= x <=1@.+           | HSV { hue        :: Double+                 , saturation :: Double+                 , value      :: Double+                 }+           | X11Color X11Color+           | BrewerColor BrewerScheme Word8 -- ^ This value should be+                                            --   between @1@ and the+                                            --   level of the+                                            --   'BrewerScheme' being+                                            --   used.+           deriving (Eq, Ord, 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 $ mapM unqtDot [h,s,v]+  unqtDot (X11Color name)    = unqtDot name+  unqtDot (BrewerColor bs n) = printBrewerColor False bs n++  toDot (X11Color name)    = toDot name+  toDot (BrewerColor bs n) = printBrewerColor True bs n+  toDot c                  = dquotes $ unqtDot c++  unqtListToDot = hcat . punctuate colon . mapM unqtDot++  -- These two don't need to be quoted if they're on their own.+  listToDot [X11Color name]    = toDot name+  listToDot [BrewerColor bs n] = printBrewerColor True bs n+  listToDot cs                 = dquotes $ unqtListToDot cs++hexColor :: [Word8] -> DotCode+hexColor = (<>) (char '#') . hcat . mapM word8Doc++word8Doc   :: Word8 -> DotCode+word8Doc w = text $ padding `T.append` simple+  where+    simple = T.pack $ showHex w ""+    padding = T.replicate count (T.singleton '0')+    count = 2 - findCols 1 w+    findCols c n+      | n < 16 = c+      | otherwise = findCols (c+1) (n `div` 16)++instance ParseDot Color where+  parseUnqt = oneOf [ parseHexBased+                    , parseHSV+                      -- Have to parse BrewerColor first, as some of them may appear to be X11 colors+                    , liftM (uncurry BrewerColor) $ parseBrewerColor False+                    , liftM X11Color $ parseX11Color False+                    ]+    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+                          _ -> throw . NotDotCode+                               $ "Not a valid hex Color specification: "+                                  ++ show cs+      parseHSV = do h <- parse+                    parseSep+                    s <- parse+                    parseSep+                    v <- parse+                    return $ HSV h s v+      parseSep = oneOf [ string ","+                       , whitespace+                       ]+      parse2Hex = do c1 <- satisfy isHexDigit+                     c2 <- satisfy isHexDigit+                     let [(n, [])] = readHex [c1, c2]+                     return n++  parse = quotedParse parseUnqt+          `onFail` -- These two might not need to be quoted+          oneOf [ liftM X11Color parseUnqt+                , do Brewer bc <- getColorScheme+                     liftM (BrewerColor bc) parseUnqt+                ]++  parseUnqtList = sepBy1 parseUnqt (character ':')++  parseList = liftM (:[])+              -- Unquoted single color+              (oneOf [ liftM X11Color parseUnqt+                     , do Brewer bc <- getColorScheme+                          liftM (BrewerColor bc) parseUnqt+                     ]+              )+              `onFail`+              quotedParse parseUnqtList++printBrewerColor        :: Bool -> BrewerScheme -> Word8 -> DotCode+printBrewerColor q bs l = do cs <- getColorScheme+                             case cs of+                               Brewer bs'+                                 | bs == bs' -> unqtDot l+                               _             -> addQ $ fslash <> unqtDot bs+                                                       <> fslash <> unqtDot l+  where+    addQ = bool id dquotes q++parseBrewerColor   :: Bool -> Parse (BrewerScheme, Word8)+parseBrewerColor q = do Brewer bs <- getColorScheme+                        optional $ stringRep () "//"+                        liftM ((,) bs) $ bool parseUnqt parse q+                     `onFail`+                     bool id quotedParse q ( do character '/'+                                                bs <- parseUnqt+                                                character '/'+                                                l <- parseUnqt+                                                return (bs,l)+                                           )++-- -----------------------------------------------------------------------------++-- | Covers the four cases:+--+--   * yyyy+--   * /yyyy+--   * /X11/yyyy+--   * //yyyy+--+parseX11Color   :: Bool -> Parse X11Color+parseX11Color q = bool parseUnqt parse q+                  `onFail`+                  bool id quotedParse q+                    ( do character '/'+                         optional $ do optional $ do X11 <- parseUnqt+                                                     return ()+                                       character '/'+                         parseUnqt+                    )++-- | The X11 colors that Graphviz uses.  Note that these are slightly+--   different from the \"normal\" X11 colors used (e.g. the inclusion+--   of @Crimson@).  Graphviz's list of colors also duplicated almost+--   all @Gray@ colors with @Grey@ ones; parsing of an 'X11Color'+--   which is specified using \"grey\" will succeed, even for those+--   that don't have the duplicate spelling (e.g. @DarkSlateGray1@).+data X11Color = AliceBlue+              | AntiqueWhite+              | AntiqueWhite1+              | AntiqueWhite2+              | AntiqueWhite3+              | AntiqueWhite4+              | Aquamarine+              | Aquamarine1+              | Aquamarine2+              | Aquamarine3+              | Aquamarine4+              | Azure+              | Azure1+              | Azure2+              | Azure3+              | Azure4+              | Beige+              | Bisque+              | Bisque1+              | Bisque2+              | Bisque3+              | Bisque4+              | Black+              | BlanchedAlmond+              | Blue+              | Blue1+              | Blue2+              | Blue3+              | Blue4+              | BlueViolet+              | Brown+              | Brown1+              | Brown2+              | Brown3+              | Brown4+              | Burlywood+              | Burlywood1+              | Burlywood2+              | Burlywood3+              | Burlywood4+              | CadetBlue+              | CadetBlue1+              | CadetBlue2+              | CadetBlue3+              | CadetBlue4+              | Chartreuse+              | Chartreuse1+              | Chartreuse2+              | Chartreuse3+              | Chartreuse4+              | Chocolate+              | Chocolate1+              | Chocolate2+              | Chocolate3+              | Chocolate4+              | Coral+              | Coral1+              | Coral2+              | Coral3+              | Coral4+              | CornFlowerBlue+              | CornSilk+              | CornSilk1+              | CornSilk2+              | CornSilk3+              | CornSilk4+              | Crimson+              | Cyan+              | Cyan1+              | Cyan2+              | Cyan3+              | Cyan4+              | DarkGoldenrod+              | DarkGoldenrod1+              | DarkGoldenrod2+              | DarkGoldenrod3+              | DarkGoldenrod4+              | DarkGreen+              | Darkkhaki+              | DarkOliveGreen+              | DarkOliveGreen1+              | DarkOliveGreen2+              | DarkOliveGreen3+              | DarkOliveGreen4+              | DarkOrange+              | DarkOrange1+              | DarkOrange2+              | DarkOrange3+              | DarkOrange4+              | DarkOrchid+              | DarkOrchid1+              | DarkOrchid2+              | DarkOrchid3+              | DarkOrchid4+              | DarkSalmon+              | DarkSeaGreen+              | DarkSeaGreen1+              | DarkSeaGreen2+              | DarkSeaGreen3+              | DarkSeaGreen4+              | DarkSlateBlue+              | DarkSlateGray+              | DarkSlateGray1+              | DarkSlateGray2+              | DarkSlateGray3+              | DarkSlateGray4+              | DarkTurquoise+              | DarkViolet+              | DeepPink+              | DeepPink1+              | DeepPink2+              | DeepPink3+              | DeepPink4+              | DeepSkyBlue+              | DeepSkyBlue1+              | DeepSkyBlue2+              | DeepSkyBlue3+              | DeepSkyBlue4+              | DimGray+              | DodgerBlue+              | DodgerBlue1+              | DodgerBlue2+              | DodgerBlue3+              | DodgerBlue4+              | Firebrick+              | Firebrick1+              | Firebrick2+              | Firebrick3+              | Firebrick4+              | FloralWhite+              | ForestGreen+              | Gainsboro+              | GhostWhite+              | Gold+              | Gold1+              | Gold2+              | Gold3+              | Gold4+              | Goldenrod+              | Goldenrod1+              | Goldenrod2+              | Goldenrod3+              | Goldenrod4+              | Gray+              | Gray0+              | Gray1+              | Gray2+              | Gray3+              | Gray4+              | Gray5+              | Gray6+              | Gray7+              | Gray8+              | Gray9+              | Gray10+              | Gray11+              | Gray12+              | Gray13+              | Gray14+              | Gray15+              | Gray16+              | Gray17+              | Gray18+              | Gray19+              | Gray20+              | Gray21+              | Gray22+              | Gray23+              | Gray24+              | Gray25+              | Gray26+              | Gray27+              | Gray28+              | Gray29+              | Gray30+              | Gray31+              | Gray32+              | Gray33+              | Gray34+              | Gray35+              | Gray36+              | Gray37+              | Gray38+              | Gray39+              | Gray40+              | Gray41+              | Gray42+              | Gray43+              | Gray44+              | Gray45+              | Gray46+              | Gray47+              | Gray48+              | Gray49+              | Gray50+              | Gray51+              | Gray52+              | Gray53+              | Gray54+              | Gray55+              | Gray56+              | Gray57+              | Gray58+              | Gray59+              | Gray60+              | Gray61+              | Gray62+              | Gray63+              | Gray64+              | Gray65+              | Gray66+              | Gray67+              | Gray68+              | Gray69+              | Gray70+              | Gray71+              | Gray72+              | Gray73+              | Gray74+              | Gray75+              | Gray76+              | Gray77+              | Gray78+              | Gray79+              | Gray80+              | Gray81+              | Gray82+              | Gray83+              | Gray84+              | Gray85+              | Gray86+              | Gray87+              | Gray88+              | Gray89+              | Gray90+              | Gray91+              | Gray92+              | Gray93+              | Gray94+              | Gray95+              | Gray96+              | Gray97+              | Gray98+              | Gray99+              | Gray100+              | Green+              | Green1+              | Green2+              | Green3+              | Green4+              | GreenYellow+              | HoneyDew+              | HoneyDew1+              | HoneyDew2+              | HoneyDew3+              | HoneyDew4+              | HotPink+              | HotPink1+              | HotPink2+              | HotPink3+              | HotPink4+              | IndianRed+              | IndianRed1+              | IndianRed2+              | IndianRed3+              | IndianRed4+              | Indigo+              | Ivory+              | Ivory1+              | Ivory2+              | Ivory3+              | Ivory4+              | Khaki+              | Khaki1+              | Khaki2+              | Khaki3+              | Khaki4+              | Lavender+              | LavenderBlush+              | LavenderBlush1+              | LavenderBlush2+              | LavenderBlush3+              | LavenderBlush4+              | LawnGreen+              | LemonChiffon+              | LemonChiffon1+              | LemonChiffon2+              | LemonChiffon3+              | LemonChiffon4+              | LightBlue+              | LightBlue1+              | LightBlue2+              | LightBlue3+              | LightBlue4+              | LightCoral+              | LightCyan+              | LightCyan1+              | LightCyan2+              | LightCyan3+              | LightCyan4+              | LightGoldenrod+              | LightGoldenrod1+              | LightGoldenrod2+              | LightGoldenrod3+              | LightGoldenrod4+              | LightGoldenrodYellow+              | LightGray+              | LightPink+              | LightPink1+              | LightPink2+              | LightPink3+              | LightPink4+              | LightSalmon+              | LightSalmon1+              | LightSalmon2+              | LightSalmon3+              | LightSalmon4+              | LightSeaGreen+              | LightSkyBlue+              | LightSkyBlue1+              | LightSkyBlue2+              | LightSkyBlue3+              | LightSkyBlue4+              | LightSlateBlue+              | LightSlateGray+              | LightSteelBlue+              | LightSteelBlue1+              | LightSteelBlue2+              | LightSteelBlue3+              | LightSteelBlue4+              | LightYellow+              | LightYellow1+              | LightYellow2+              | LightYellow3+              | LightYellow4+              | LimeGreen+              | Linen+              | Magenta+              | Magenta1+              | Magenta2+              | Magenta3+              | Magenta4+              | Maroon+              | Maroon1+              | Maroon2+              | Maroon3+              | Maroon4+              | MediumAquamarine+              | MediumBlue+              | MediumOrchid+              | MediumOrchid1+              | MediumOrchid2+              | MediumOrchid3+              | MediumOrchid4+              | MediumPurple+              | MediumPurple1+              | MediumPurple2+              | MediumPurple3+              | MediumPurple4+              | MediumSeaGreen+              | MediumSlateBlue+              | MediumSpringGreen+              | MediumTurquoise+              | MediumVioletRed+              | MidnightBlue+              | MintCream+              | MistyRose+              | MistyRose1+              | MistyRose2+              | MistyRose3+              | MistyRose4+              | Moccasin+              | NavajoWhite+              | NavajoWhite1+              | NavajoWhite2+              | NavajoWhite3+              | NavajoWhite4+              | Navy+              | NavyBlue+              | OldLace+              | OliveDrab+              | OliveDrab1+              | OliveDrab2+              | OliveDrab3+              | OliveDrab4+              | Orange+              | Orange1+              | Orange2+              | Orange3+              | Orange4+              | OrangeRed+              | OrangeRed1+              | OrangeRed2+              | OrangeRed3+              | OrangeRed4+              | Orchid+              | Orchid1+              | Orchid2+              | Orchid3+              | Orchid4+              | PaleGoldenrod+              | PaleGreen+              | PaleGreen1+              | PaleGreen2+              | PaleGreen3+              | PaleGreen4+              | PaleTurquoise+              | PaleTurquoise1+              | PaleTurquoise2+              | PaleTurquoise3+              | PaleTurquoise4+              | PaleVioletRed+              | PaleVioletRed1+              | PaleVioletRed2+              | PaleVioletRed3+              | PaleVioletRed4+              | PapayaWhip+              | PeachPuff+              | PeachPuff1+              | PeachPuff2+              | PeachPuff3+              | PeachPuff4+              | Peru+              | Pink+              | Pink1+              | Pink2+              | Pink3+              | Pink4+              | Plum+              | Plum1+              | Plum2+              | Plum3+              | Plum4+              | PowderBlue+              | Purple+              | Purple1+              | Purple2+              | Purple3+              | Purple4+              | Red+              | Red1+              | Red2+              | Red3+              | Red4+              | RosyBrown+              | RosyBrown1+              | RosyBrown2+              | RosyBrown3+              | RosyBrown4+              | RoyalBlue+              | RoyalBlue1+              | RoyalBlue2+              | RoyalBlue3+              | RoyalBlue4+              | SaddleBrown+              | Salmon+              | Salmon1+              | Salmon2+              | Salmon3+              | Salmon4+              | SandyBrown+              | SeaGreen+              | SeaGreen1+              | SeaGreen2+              | SeaGreen3+              | SeaGreen4+              | SeaShell+              | SeaShell1+              | SeaShell2+              | SeaShell3+              | SeaShell4+              | Sienna+              | Sienna1+              | Sienna2+              | Sienna3+              | Sienna4+              | SkyBlue+              | SkyBlue1+              | SkyBlue2+              | SkyBlue3+              | SkyBlue4+              | SlateBlue+              | SlateBlue1+              | SlateBlue2+              | SlateBlue3+              | SlateBlue4+              | SlateGray+              | SlateGray1+              | SlateGray2+              | SlateGray3+              | SlateGray4+              | Snow+              | Snow1+              | Snow2+              | Snow3+              | Snow4+              | SpringGreen+              | SpringGreen1+              | SpringGreen2+              | SpringGreen3+              | SpringGreen4+              | SteelBlue+              | SteelBlue1+              | SteelBlue2+              | SteelBlue3+              | SteelBlue4+              | Tan+              | Tan1+              | Tan2+              | Tan3+              | Tan4+              | Thistle+              | Thistle1+              | Thistle2+              | Thistle3+              | Thistle4+              | Tomato+              | Tomato1+              | Tomato2+              | Tomato3+              | Tomato4+              | Transparent -- ^ Equivalent to setting @Style [SItem Invisible []]@.+              | Turquoise+              | Turquoise1+              | Turquoise2+              | Turquoise3+              | Turquoise4+              | Violet+              | VioletRed+              | VioletRed1+              | VioletRed2+              | VioletRed3+              | VioletRed4+              | Wheat+              | Wheat1+              | Wheat2+              | Wheat3+              | Wheat4+              | White+              | WhiteSmoke+              | Yellow+              | Yellow1+              | Yellow2+              | Yellow3+              | Yellow4+              | YellowGreen+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot X11Color where+  unqtDot AliceBlue            = unqtText "aliceblue"+  unqtDot AntiqueWhite         = unqtText "antiquewhite"+  unqtDot AntiqueWhite1        = unqtText "antiquewhite1"+  unqtDot AntiqueWhite2        = unqtText "antiquewhite2"+  unqtDot AntiqueWhite3        = unqtText "antiquewhite3"+  unqtDot AntiqueWhite4        = unqtText "antiquewhite4"+  unqtDot Aquamarine           = unqtText "aquamarine"+  unqtDot Aquamarine1          = unqtText "aquamarine1"+  unqtDot Aquamarine2          = unqtText "aquamarine2"+  unqtDot Aquamarine3          = unqtText "aquamarine3"+  unqtDot Aquamarine4          = unqtText "aquamarine4"+  unqtDot Azure                = unqtText "azure"+  unqtDot Azure1               = unqtText "azure1"+  unqtDot Azure2               = unqtText "azure2"+  unqtDot Azure3               = unqtText "azure3"+  unqtDot Azure4               = unqtText "azure4"+  unqtDot Beige                = unqtText "beige"+  unqtDot Bisque               = unqtText "bisque"+  unqtDot Bisque1              = unqtText "bisque1"+  unqtDot Bisque2              = unqtText "bisque2"+  unqtDot Bisque3              = unqtText "bisque3"+  unqtDot Bisque4              = unqtText "bisque4"+  unqtDot Black                = unqtText "black"+  unqtDot BlanchedAlmond       = unqtText "blanchedalmond"+  unqtDot Blue                 = unqtText "blue"+  unqtDot Blue1                = unqtText "blue1"+  unqtDot Blue2                = unqtText "blue2"+  unqtDot Blue3                = unqtText "blue3"+  unqtDot Blue4                = unqtText "blue4"+  unqtDot BlueViolet           = unqtText "blueviolet"+  unqtDot Brown                = unqtText "brown"+  unqtDot Brown1               = unqtText "brown1"+  unqtDot Brown2               = unqtText "brown2"+  unqtDot Brown3               = unqtText "brown3"+  unqtDot Brown4               = unqtText "brown4"+  unqtDot Burlywood            = unqtText "burlywood"+  unqtDot Burlywood1           = unqtText "burlywood1"+  unqtDot Burlywood2           = unqtText "burlywood2"+  unqtDot Burlywood3           = unqtText "burlywood3"+  unqtDot Burlywood4           = unqtText "burlywood4"+  unqtDot CadetBlue            = unqtText "cadetblue"+  unqtDot CadetBlue1           = unqtText "cadetblue1"+  unqtDot CadetBlue2           = unqtText "cadetblue2"+  unqtDot CadetBlue3           = unqtText "cadetblue3"+  unqtDot CadetBlue4           = unqtText "cadetblue4"+  unqtDot Chartreuse           = unqtText "chartreuse"+  unqtDot Chartreuse1          = unqtText "chartreuse1"+  unqtDot Chartreuse2          = unqtText "chartreuse2"+  unqtDot Chartreuse3          = unqtText "chartreuse3"+  unqtDot Chartreuse4          = unqtText "chartreuse4"+  unqtDot Chocolate            = unqtText "chocolate"+  unqtDot Chocolate1           = unqtText "chocolate1"+  unqtDot Chocolate2           = unqtText "chocolate2"+  unqtDot Chocolate3           = unqtText "chocolate3"+  unqtDot Chocolate4           = unqtText "chocolate4"+  unqtDot Coral                = unqtText "coral"+  unqtDot Coral1               = unqtText "coral1"+  unqtDot Coral2               = unqtText "coral2"+  unqtDot Coral3               = unqtText "coral3"+  unqtDot Coral4               = unqtText "coral4"+  unqtDot CornFlowerBlue       = unqtText "cornflowerblue"+  unqtDot CornSilk             = unqtText "cornsilk"+  unqtDot CornSilk1            = unqtText "cornsilk1"+  unqtDot CornSilk2            = unqtText "cornsilk2"+  unqtDot CornSilk3            = unqtText "cornsilk3"+  unqtDot CornSilk4            = unqtText "cornsilk4"+  unqtDot Crimson              = unqtText "crimson"+  unqtDot Cyan                 = unqtText "cyan"+  unqtDot Cyan1                = unqtText "cyan1"+  unqtDot Cyan2                = unqtText "cyan2"+  unqtDot Cyan3                = unqtText "cyan3"+  unqtDot Cyan4                = unqtText "cyan4"+  unqtDot DarkGoldenrod        = unqtText "darkgoldenrod"+  unqtDot DarkGoldenrod1       = unqtText "darkgoldenrod1"+  unqtDot DarkGoldenrod2       = unqtText "darkgoldenrod2"+  unqtDot DarkGoldenrod3       = unqtText "darkgoldenrod3"+  unqtDot DarkGoldenrod4       = unqtText "darkgoldenrod4"+  unqtDot DarkGreen            = unqtText "darkgreen"+  unqtDot Darkkhaki            = unqtText "darkkhaki"+  unqtDot DarkOliveGreen       = unqtText "darkolivegreen"+  unqtDot DarkOliveGreen1      = unqtText "darkolivegreen1"+  unqtDot DarkOliveGreen2      = unqtText "darkolivegreen2"+  unqtDot DarkOliveGreen3      = unqtText "darkolivegreen3"+  unqtDot DarkOliveGreen4      = unqtText "darkolivegreen4"+  unqtDot DarkOrange           = unqtText "darkorange"+  unqtDot DarkOrange1          = unqtText "darkorange1"+  unqtDot DarkOrange2          = unqtText "darkorange2"+  unqtDot DarkOrange3          = unqtText "darkorange3"+  unqtDot DarkOrange4          = unqtText "darkorange4"+  unqtDot DarkOrchid           = unqtText "darkorchid"+  unqtDot DarkOrchid1          = unqtText "darkorchid1"+  unqtDot DarkOrchid2          = unqtText "darkorchid2"+  unqtDot DarkOrchid3          = unqtText "darkorchid3"+  unqtDot DarkOrchid4          = unqtText "darkorchid4"+  unqtDot DarkSalmon           = unqtText "darksalmon"+  unqtDot DarkSeaGreen         = unqtText "darkseagreen"+  unqtDot DarkSeaGreen1        = unqtText "darkseagreen1"+  unqtDot DarkSeaGreen2        = unqtText "darkseagreen2"+  unqtDot DarkSeaGreen3        = unqtText "darkseagreen3"+  unqtDot DarkSeaGreen4        = unqtText "darkseagreen4"+  unqtDot DarkSlateBlue        = unqtText "darkslateblue"+  unqtDot DarkSlateGray        = unqtText "darkslategray"+  unqtDot DarkSlateGray1       = unqtText "darkslategray1"+  unqtDot DarkSlateGray2       = unqtText "darkslategray2"+  unqtDot DarkSlateGray3       = unqtText "darkslategray3"+  unqtDot DarkSlateGray4       = unqtText "darkslategray4"+  unqtDot DarkTurquoise        = unqtText "darkturquoise"+  unqtDot DarkViolet           = unqtText "darkviolet"+  unqtDot DeepPink             = unqtText "deeppink"+  unqtDot DeepPink1            = unqtText "deeppink1"+  unqtDot DeepPink2            = unqtText "deeppink2"+  unqtDot DeepPink3            = unqtText "deeppink3"+  unqtDot DeepPink4            = unqtText "deeppink4"+  unqtDot DeepSkyBlue          = unqtText "deepskyblue"+  unqtDot DeepSkyBlue1         = unqtText "deepskyblue1"+  unqtDot DeepSkyBlue2         = unqtText "deepskyblue2"+  unqtDot DeepSkyBlue3         = unqtText "deepskyblue3"+  unqtDot DeepSkyBlue4         = unqtText "deepskyblue4"+  unqtDot DimGray              = unqtText "dimgray"+  unqtDot DodgerBlue           = unqtText "dodgerblue"+  unqtDot DodgerBlue1          = unqtText "dodgerblue1"+  unqtDot DodgerBlue2          = unqtText "dodgerblue2"+  unqtDot DodgerBlue3          = unqtText "dodgerblue3"+  unqtDot DodgerBlue4          = unqtText "dodgerblue4"+  unqtDot Firebrick            = unqtText "firebrick"+  unqtDot Firebrick1           = unqtText "firebrick1"+  unqtDot Firebrick2           = unqtText "firebrick2"+  unqtDot Firebrick3           = unqtText "firebrick3"+  unqtDot Firebrick4           = unqtText "firebrick4"+  unqtDot FloralWhite          = unqtText "floralwhite"+  unqtDot ForestGreen          = unqtText "forestgreen"+  unqtDot Gainsboro            = unqtText "gainsboro"+  unqtDot GhostWhite           = unqtText "ghostwhite"+  unqtDot Gold                 = unqtText "gold"+  unqtDot Gold1                = unqtText "gold1"+  unqtDot Gold2                = unqtText "gold2"+  unqtDot Gold3                = unqtText "gold3"+  unqtDot Gold4                = unqtText "gold4"+  unqtDot Goldenrod            = unqtText "goldenrod"+  unqtDot Goldenrod1           = unqtText "goldenrod1"+  unqtDot Goldenrod2           = unqtText "goldenrod2"+  unqtDot Goldenrod3           = unqtText "goldenrod3"+  unqtDot Goldenrod4           = unqtText "goldenrod4"+  unqtDot Gray                 = unqtText "gray"+  unqtDot Gray0                = unqtText "gray0"+  unqtDot Gray1                = unqtText "gray1"+  unqtDot Gray2                = unqtText "gray2"+  unqtDot Gray3                = unqtText "gray3"+  unqtDot Gray4                = unqtText "gray4"+  unqtDot Gray5                = unqtText "gray5"+  unqtDot Gray6                = unqtText "gray6"+  unqtDot Gray7                = unqtText "gray7"+  unqtDot Gray8                = unqtText "gray8"+  unqtDot Gray9                = unqtText "gray9"+  unqtDot Gray10               = unqtText "gray10"+  unqtDot Gray11               = unqtText "gray11"+  unqtDot Gray12               = unqtText "gray12"+  unqtDot Gray13               = unqtText "gray13"+  unqtDot Gray14               = unqtText "gray14"+  unqtDot Gray15               = unqtText "gray15"+  unqtDot Gray16               = unqtText "gray16"+  unqtDot Gray17               = unqtText "gray17"+  unqtDot Gray18               = unqtText "gray18"+  unqtDot Gray19               = unqtText "gray19"+  unqtDot Gray20               = unqtText "gray20"+  unqtDot Gray21               = unqtText "gray21"+  unqtDot Gray22               = unqtText "gray22"+  unqtDot Gray23               = unqtText "gray23"+  unqtDot Gray24               = unqtText "gray24"+  unqtDot Gray25               = unqtText "gray25"+  unqtDot Gray26               = unqtText "gray26"+  unqtDot Gray27               = unqtText "gray27"+  unqtDot Gray28               = unqtText "gray28"+  unqtDot Gray29               = unqtText "gray29"+  unqtDot Gray30               = unqtText "gray30"+  unqtDot Gray31               = unqtText "gray31"+  unqtDot Gray32               = unqtText "gray32"+  unqtDot Gray33               = unqtText "gray33"+  unqtDot Gray34               = unqtText "gray34"+  unqtDot Gray35               = unqtText "gray35"+  unqtDot Gray36               = unqtText "gray36"+  unqtDot Gray37               = unqtText "gray37"+  unqtDot Gray38               = unqtText "gray38"+  unqtDot Gray39               = unqtText "gray39"+  unqtDot Gray40               = unqtText "gray40"+  unqtDot Gray41               = unqtText "gray41"+  unqtDot Gray42               = unqtText "gray42"+  unqtDot Gray43               = unqtText "gray43"+  unqtDot Gray44               = unqtText "gray44"+  unqtDot Gray45               = unqtText "gray45"+  unqtDot Gray46               = unqtText "gray46"+  unqtDot Gray47               = unqtText "gray47"+  unqtDot Gray48               = unqtText "gray48"+  unqtDot Gray49               = unqtText "gray49"+  unqtDot Gray50               = unqtText "gray50"+  unqtDot Gray51               = unqtText "gray51"+  unqtDot Gray52               = unqtText "gray52"+  unqtDot Gray53               = unqtText "gray53"+  unqtDot Gray54               = unqtText "gray54"+  unqtDot Gray55               = unqtText "gray55"+  unqtDot Gray56               = unqtText "gray56"+  unqtDot Gray57               = unqtText "gray57"+  unqtDot Gray58               = unqtText "gray58"+  unqtDot Gray59               = unqtText "gray59"+  unqtDot Gray60               = unqtText "gray60"+  unqtDot Gray61               = unqtText "gray61"+  unqtDot Gray62               = unqtText "gray62"+  unqtDot Gray63               = unqtText "gray63"+  unqtDot Gray64               = unqtText "gray64"+  unqtDot Gray65               = unqtText "gray65"+  unqtDot Gray66               = unqtText "gray66"+  unqtDot Gray67               = unqtText "gray67"+  unqtDot Gray68               = unqtText "gray68"+  unqtDot Gray69               = unqtText "gray69"+  unqtDot Gray70               = unqtText "gray70"+  unqtDot Gray71               = unqtText "gray71"+  unqtDot Gray72               = unqtText "gray72"+  unqtDot Gray73               = unqtText "gray73"+  unqtDot Gray74               = unqtText "gray74"+  unqtDot Gray75               = unqtText "gray75"+  unqtDot Gray76               = unqtText "gray76"+  unqtDot Gray77               = unqtText "gray77"+  unqtDot Gray78               = unqtText "gray78"+  unqtDot Gray79               = unqtText "gray79"+  unqtDot Gray80               = unqtText "gray80"+  unqtDot Gray81               = unqtText "gray81"+  unqtDot Gray82               = unqtText "gray82"+  unqtDot Gray83               = unqtText "gray83"+  unqtDot Gray84               = unqtText "gray84"+  unqtDot Gray85               = unqtText "gray85"+  unqtDot Gray86               = unqtText "gray86"+  unqtDot Gray87               = unqtText "gray87"+  unqtDot Gray88               = unqtText "gray88"+  unqtDot Gray89               = unqtText "gray89"+  unqtDot Gray90               = unqtText "gray90"+  unqtDot Gray91               = unqtText "gray91"+  unqtDot Gray92               = unqtText "gray92"+  unqtDot Gray93               = unqtText "gray93"+  unqtDot Gray94               = unqtText "gray94"+  unqtDot Gray95               = unqtText "gray95"+  unqtDot Gray96               = unqtText "gray96"+  unqtDot Gray97               = unqtText "gray97"+  unqtDot Gray98               = unqtText "gray98"+  unqtDot Gray99               = unqtText "gray99"+  unqtDot Gray100              = unqtText "gray100"+  unqtDot Green                = unqtText "green"+  unqtDot Green1               = unqtText "green1"+  unqtDot Green2               = unqtText "green2"+  unqtDot Green3               = unqtText "green3"+  unqtDot Green4               = unqtText "green4"+  unqtDot GreenYellow          = unqtText "greenyellow"+  unqtDot HoneyDew             = unqtText "honeydew"+  unqtDot HoneyDew1            = unqtText "honeydew1"+  unqtDot HoneyDew2            = unqtText "honeydew2"+  unqtDot HoneyDew3            = unqtText "honeydew3"+  unqtDot HoneyDew4            = unqtText "honeydew4"+  unqtDot HotPink              = unqtText "hotpink"+  unqtDot HotPink1             = unqtText "hotpink1"+  unqtDot HotPink2             = unqtText "hotpink2"+  unqtDot HotPink3             = unqtText "hotpink3"+  unqtDot HotPink4             = unqtText "hotpink4"+  unqtDot IndianRed            = unqtText "indianred"+  unqtDot IndianRed1           = unqtText "indianred1"+  unqtDot IndianRed2           = unqtText "indianred2"+  unqtDot IndianRed3           = unqtText "indianred3"+  unqtDot IndianRed4           = unqtText "indianred4"+  unqtDot Indigo               = unqtText "indigo"+  unqtDot Ivory                = unqtText "ivory"+  unqtDot Ivory1               = unqtText "ivory1"+  unqtDot Ivory2               = unqtText "ivory2"+  unqtDot Ivory3               = unqtText "ivory3"+  unqtDot Ivory4               = unqtText "ivory4"+  unqtDot Khaki                = unqtText "khaki"+  unqtDot Khaki1               = unqtText "khaki1"+  unqtDot Khaki2               = unqtText "khaki2"+  unqtDot Khaki3               = unqtText "khaki3"+  unqtDot Khaki4               = unqtText "khaki4"+  unqtDot Lavender             = unqtText "lavender"+  unqtDot LavenderBlush        = unqtText "lavenderblush"+  unqtDot LavenderBlush1       = unqtText "lavenderblush1"+  unqtDot LavenderBlush2       = unqtText "lavenderblush2"+  unqtDot LavenderBlush3       = unqtText "lavenderblush3"+  unqtDot LavenderBlush4       = unqtText "lavenderblush4"+  unqtDot LawnGreen            = unqtText "lawngreen"+  unqtDot LemonChiffon         = unqtText "lemonchiffon"+  unqtDot LemonChiffon1        = unqtText "lemonchiffon1"+  unqtDot LemonChiffon2        = unqtText "lemonchiffon2"+  unqtDot LemonChiffon3        = unqtText "lemonchiffon3"+  unqtDot LemonChiffon4        = unqtText "lemonchiffon4"+  unqtDot LightBlue            = unqtText "lightblue"+  unqtDot LightBlue1           = unqtText "lightblue1"+  unqtDot LightBlue2           = unqtText "lightblue2"+  unqtDot LightBlue3           = unqtText "lightblue3"+  unqtDot LightBlue4           = unqtText "lightblue4"+  unqtDot LightCoral           = unqtText "lightcoral"+  unqtDot LightCyan            = unqtText "lightcyan"+  unqtDot LightCyan1           = unqtText "lightcyan1"+  unqtDot LightCyan2           = unqtText "lightcyan2"+  unqtDot LightCyan3           = unqtText "lightcyan3"+  unqtDot LightCyan4           = unqtText "lightcyan4"+  unqtDot LightGoldenrod       = unqtText "lightgoldenrod"+  unqtDot LightGoldenrod1      = unqtText "lightgoldenrod1"+  unqtDot LightGoldenrod2      = unqtText "lightgoldenrod2"+  unqtDot LightGoldenrod3      = unqtText "lightgoldenrod3"+  unqtDot LightGoldenrod4      = unqtText "lightgoldenrod4"+  unqtDot LightGoldenrodYellow = unqtText "lightgoldenrodyellow"+  unqtDot LightGray            = unqtText "lightgray"+  unqtDot LightPink            = unqtText "lightpink"+  unqtDot LightPink1           = unqtText "lightpink1"+  unqtDot LightPink2           = unqtText "lightpink2"+  unqtDot LightPink3           = unqtText "lightpink3"+  unqtDot LightPink4           = unqtText "lightpink4"+  unqtDot LightSalmon          = unqtText "lightsalmon"+  unqtDot LightSalmon1         = unqtText "lightsalmon1"+  unqtDot LightSalmon2         = unqtText "lightsalmon2"+  unqtDot LightSalmon3         = unqtText "lightsalmon3"+  unqtDot LightSalmon4         = unqtText "lightsalmon4"+  unqtDot LightSeaGreen        = unqtText "lightseagreen"+  unqtDot LightSkyBlue         = unqtText "lightskyblue"+  unqtDot LightSkyBlue1        = unqtText "lightskyblue1"+  unqtDot LightSkyBlue2        = unqtText "lightskyblue2"+  unqtDot LightSkyBlue3        = unqtText "lightskyblue3"+  unqtDot LightSkyBlue4        = unqtText "lightskyblue4"+  unqtDot LightSlateBlue       = unqtText "lightslateblue"+  unqtDot LightSlateGray       = unqtText "lightslategray"+  unqtDot LightSteelBlue       = unqtText "lightsteelblue"+  unqtDot LightSteelBlue1      = unqtText "lightsteelblue1"+  unqtDot LightSteelBlue2      = unqtText "lightsteelblue2"+  unqtDot LightSteelBlue3      = unqtText "lightsteelblue3"+  unqtDot LightSteelBlue4      = unqtText "lightsteelblue4"+  unqtDot LightYellow          = unqtText "lightyellow"+  unqtDot LightYellow1         = unqtText "lightyellow1"+  unqtDot LightYellow2         = unqtText "lightyellow2"+  unqtDot LightYellow3         = unqtText "lightyellow3"+  unqtDot LightYellow4         = unqtText "lightyellow4"+  unqtDot LimeGreen            = unqtText "limegreen"+  unqtDot Linen                = unqtText "linen"+  unqtDot Magenta              = unqtText "magenta"+  unqtDot Magenta1             = unqtText "magenta1"+  unqtDot Magenta2             = unqtText "magenta2"+  unqtDot Magenta3             = unqtText "magenta3"+  unqtDot Magenta4             = unqtText "magenta4"+  unqtDot Maroon               = unqtText "maroon"+  unqtDot Maroon1              = unqtText "maroon1"+  unqtDot Maroon2              = unqtText "maroon2"+  unqtDot Maroon3              = unqtText "maroon3"+  unqtDot Maroon4              = unqtText "maroon4"+  unqtDot MediumAquamarine     = unqtText "mediumaquamarine"+  unqtDot MediumBlue           = unqtText "mediumblue"+  unqtDot MediumOrchid         = unqtText "mediumorchid"+  unqtDot MediumOrchid1        = unqtText "mediumorchid1"+  unqtDot MediumOrchid2        = unqtText "mediumorchid2"+  unqtDot MediumOrchid3        = unqtText "mediumorchid3"+  unqtDot MediumOrchid4        = unqtText "mediumorchid4"+  unqtDot MediumPurple         = unqtText "mediumpurple"+  unqtDot MediumPurple1        = unqtText "mediumpurple1"+  unqtDot MediumPurple2        = unqtText "mediumpurple2"+  unqtDot MediumPurple3        = unqtText "mediumpurple3"+  unqtDot MediumPurple4        = unqtText "mediumpurple4"+  unqtDot MediumSeaGreen       = unqtText "mediumseagreen"+  unqtDot MediumSlateBlue      = unqtText "mediumslateblue"+  unqtDot MediumSpringGreen    = unqtText "mediumspringgreen"+  unqtDot MediumTurquoise      = unqtText "mediumturquoise"+  unqtDot MediumVioletRed      = unqtText "mediumvioletred"+  unqtDot MidnightBlue         = unqtText "midnightblue"+  unqtDot MintCream            = unqtText "mintcream"+  unqtDot MistyRose            = unqtText "mistyrose"+  unqtDot MistyRose1           = unqtText "mistyrose1"+  unqtDot MistyRose2           = unqtText "mistyrose2"+  unqtDot MistyRose3           = unqtText "mistyrose3"+  unqtDot MistyRose4           = unqtText "mistyrose4"+  unqtDot Moccasin             = unqtText "moccasin"+  unqtDot NavajoWhite          = unqtText "navajowhite"+  unqtDot NavajoWhite1         = unqtText "navajowhite1"+  unqtDot NavajoWhite2         = unqtText "navajowhite2"+  unqtDot NavajoWhite3         = unqtText "navajowhite3"+  unqtDot NavajoWhite4         = unqtText "navajowhite4"+  unqtDot Navy                 = unqtText "navy"+  unqtDot NavyBlue             = unqtText "navyblue"+  unqtDot OldLace              = unqtText "oldlace"+  unqtDot OliveDrab            = unqtText "olivedrab"+  unqtDot OliveDrab1           = unqtText "olivedrab1"+  unqtDot OliveDrab2           = unqtText "olivedrab2"+  unqtDot OliveDrab3           = unqtText "olivedrab3"+  unqtDot OliveDrab4           = unqtText "olivedrab4"+  unqtDot Orange               = unqtText "orange"+  unqtDot Orange1              = unqtText "orange1"+  unqtDot Orange2              = unqtText "orange2"+  unqtDot Orange3              = unqtText "orange3"+  unqtDot Orange4              = unqtText "orange4"+  unqtDot OrangeRed            = unqtText "orangered"+  unqtDot OrangeRed1           = unqtText "orangered1"+  unqtDot OrangeRed2           = unqtText "orangered2"+  unqtDot OrangeRed3           = unqtText "orangered3"+  unqtDot OrangeRed4           = unqtText "orangered4"+  unqtDot Orchid               = unqtText "orchid"+  unqtDot Orchid1              = unqtText "orchid1"+  unqtDot Orchid2              = unqtText "orchid2"+  unqtDot Orchid3              = unqtText "orchid3"+  unqtDot Orchid4              = unqtText "orchid4"+  unqtDot PaleGoldenrod        = unqtText "palegoldenrod"+  unqtDot PaleGreen            = unqtText "palegreen"+  unqtDot PaleGreen1           = unqtText "palegreen1"+  unqtDot PaleGreen2           = unqtText "palegreen2"+  unqtDot PaleGreen3           = unqtText "palegreen3"+  unqtDot PaleGreen4           = unqtText "palegreen4"+  unqtDot PaleTurquoise        = unqtText "paleturquoise"+  unqtDot PaleTurquoise1       = unqtText "paleturquoise1"+  unqtDot PaleTurquoise2       = unqtText "paleturquoise2"+  unqtDot PaleTurquoise3       = unqtText "paleturquoise3"+  unqtDot PaleTurquoise4       = unqtText "paleturquoise4"+  unqtDot PaleVioletRed        = unqtText "palevioletred"+  unqtDot PaleVioletRed1       = unqtText "palevioletred1"+  unqtDot PaleVioletRed2       = unqtText "palevioletred2"+  unqtDot PaleVioletRed3       = unqtText "palevioletred3"+  unqtDot PaleVioletRed4       = unqtText "palevioletred4"+  unqtDot PapayaWhip           = unqtText "papayawhip"+  unqtDot PeachPuff            = unqtText "peachpuff"+  unqtDot PeachPuff1           = unqtText "peachpuff1"+  unqtDot PeachPuff2           = unqtText "peachpuff2"+  unqtDot PeachPuff3           = unqtText "peachpuff3"+  unqtDot PeachPuff4           = unqtText "peachpuff4"+  unqtDot Peru                 = unqtText "peru"+  unqtDot Pink                 = unqtText "pink"+  unqtDot Pink1                = unqtText "pink1"+  unqtDot Pink2                = unqtText "pink2"+  unqtDot Pink3                = unqtText "pink3"+  unqtDot Pink4                = unqtText "pink4"+  unqtDot Plum                 = unqtText "plum"+  unqtDot Plum1                = unqtText "plum1"+  unqtDot Plum2                = unqtText "plum2"+  unqtDot Plum3                = unqtText "plum3"+  unqtDot Plum4                = unqtText "plum4"+  unqtDot PowderBlue           = unqtText "powderblue"+  unqtDot Purple               = unqtText "purple"+  unqtDot Purple1              = unqtText "purple1"+  unqtDot Purple2              = unqtText "purple2"+  unqtDot Purple3              = unqtText "purple3"+  unqtDot Purple4              = unqtText "purple4"+  unqtDot Red                  = unqtText "red"+  unqtDot Red1                 = unqtText "red1"+  unqtDot Red2                 = unqtText "red2"+  unqtDot Red3                 = unqtText "red3"+  unqtDot Red4                 = unqtText "red4"+  unqtDot RosyBrown            = unqtText "rosybrown"+  unqtDot RosyBrown1           = unqtText "rosybrown1"+  unqtDot RosyBrown2           = unqtText "rosybrown2"+  unqtDot RosyBrown3           = unqtText "rosybrown3"+  unqtDot RosyBrown4           = unqtText "rosybrown4"+  unqtDot RoyalBlue            = unqtText "royalblue"+  unqtDot RoyalBlue1           = unqtText "royalblue1"+  unqtDot RoyalBlue2           = unqtText "royalblue2"+  unqtDot RoyalBlue3           = unqtText "royalblue3"+  unqtDot RoyalBlue4           = unqtText "royalblue4"+  unqtDot SaddleBrown          = unqtText "saddlebrown"+  unqtDot Salmon               = unqtText "salmon"+  unqtDot Salmon1              = unqtText "salmon1"+  unqtDot Salmon2              = unqtText "salmon2"+  unqtDot Salmon3              = unqtText "salmon3"+  unqtDot Salmon4              = unqtText "salmon4"+  unqtDot SandyBrown           = unqtText "sandybrown"+  unqtDot SeaGreen             = unqtText "seagreen"+  unqtDot SeaGreen1            = unqtText "seagreen1"+  unqtDot SeaGreen2            = unqtText "seagreen2"+  unqtDot SeaGreen3            = unqtText "seagreen3"+  unqtDot SeaGreen4            = unqtText "seagreen4"+  unqtDot SeaShell             = unqtText "seashell"+  unqtDot SeaShell1            = unqtText "seashell1"+  unqtDot SeaShell2            = unqtText "seashell2"+  unqtDot SeaShell3            = unqtText "seashell3"+  unqtDot SeaShell4            = unqtText "seashell4"+  unqtDot Sienna               = unqtText "sienna"+  unqtDot Sienna1              = unqtText "sienna1"+  unqtDot Sienna2              = unqtText "sienna2"+  unqtDot Sienna3              = unqtText "sienna3"+  unqtDot Sienna4              = unqtText "sienna4"+  unqtDot SkyBlue              = unqtText "skyblue"+  unqtDot SkyBlue1             = unqtText "skyblue1"+  unqtDot SkyBlue2             = unqtText "skyblue2"+  unqtDot SkyBlue3             = unqtText "skyblue3"+  unqtDot SkyBlue4             = unqtText "skyblue4"+  unqtDot SlateBlue            = unqtText "slateblue"+  unqtDot SlateBlue1           = unqtText "slateblue1"+  unqtDot SlateBlue2           = unqtText "slateblue2"+  unqtDot SlateBlue3           = unqtText "slateblue3"+  unqtDot SlateBlue4           = unqtText "slateblue4"+  unqtDot SlateGray            = unqtText "slategray"+  unqtDot SlateGray1           = unqtText "slategray1"+  unqtDot SlateGray2           = unqtText "slategray2"+  unqtDot SlateGray3           = unqtText "slategray3"+  unqtDot SlateGray4           = unqtText "slategray4"+  unqtDot Snow                 = unqtText "snow"+  unqtDot Snow1                = unqtText "snow1"+  unqtDot Snow2                = unqtText "snow2"+  unqtDot Snow3                = unqtText "snow3"+  unqtDot Snow4                = unqtText "snow4"+  unqtDot SpringGreen          = unqtText "springgreen"+  unqtDot SpringGreen1         = unqtText "springgreen1"+  unqtDot SpringGreen2         = unqtText "springgreen2"+  unqtDot SpringGreen3         = unqtText "springgreen3"+  unqtDot SpringGreen4         = unqtText "springgreen4"+  unqtDot SteelBlue            = unqtText "steelblue"+  unqtDot SteelBlue1           = unqtText "steelblue1"+  unqtDot SteelBlue2           = unqtText "steelblue2"+  unqtDot SteelBlue3           = unqtText "steelblue3"+  unqtDot SteelBlue4           = unqtText "steelblue4"+  unqtDot Tan                  = unqtText "tan"+  unqtDot Tan1                 = unqtText "tan1"+  unqtDot Tan2                 = unqtText "tan2"+  unqtDot Tan3                 = unqtText "tan3"+  unqtDot Tan4                 = unqtText "tan4"+  unqtDot Thistle              = unqtText "thistle"+  unqtDot Thistle1             = unqtText "thistle1"+  unqtDot Thistle2             = unqtText "thistle2"+  unqtDot Thistle3             = unqtText "thistle3"+  unqtDot Thistle4             = unqtText "thistle4"+  unqtDot Tomato               = unqtText "tomato"+  unqtDot Tomato1              = unqtText "tomato1"+  unqtDot Tomato2              = unqtText "tomato2"+  unqtDot Tomato3              = unqtText "tomato3"+  unqtDot Tomato4              = unqtText "tomato4"+  unqtDot Transparent          = unqtText "transparent"+  unqtDot Turquoise            = unqtText "turquoise"+  unqtDot Turquoise1           = unqtText "turquoise1"+  unqtDot Turquoise2           = unqtText "turquoise2"+  unqtDot Turquoise3           = unqtText "turquoise3"+  unqtDot Turquoise4           = unqtText "turquoise4"+  unqtDot Violet               = unqtText "violet"+  unqtDot VioletRed            = unqtText "violetred"+  unqtDot VioletRed1           = unqtText "violetred1"+  unqtDot VioletRed2           = unqtText "violetred2"+  unqtDot VioletRed3           = unqtText "violetred3"+  unqtDot VioletRed4           = unqtText "violetred4"+  unqtDot Wheat                = unqtText "wheat"+  unqtDot Wheat1               = unqtText "wheat1"+  unqtDot Wheat2               = unqtText "wheat2"+  unqtDot Wheat3               = unqtText "wheat3"+  unqtDot Wheat4               = unqtText "wheat4"+  unqtDot White                = unqtText "white"+  unqtDot WhiteSmoke           = unqtText "whitesmoke"+  unqtDot Yellow               = unqtText "yellow"+  unqtDot Yellow1              = unqtText "yellow1"+  unqtDot Yellow2              = unqtText "yellow2"+  unqtDot Yellow3              = unqtText "yellow3"+  unqtDot Yellow4              = unqtText "yellow4"+  unqtDot YellowGreen          = unqtText "yellowgreen"++instance ParseDot X11Color where+  parseUnqt = stringValue [ ("aliceblue", AliceBlue)+                          , ("antiquewhite", AntiqueWhite)+                          , ("antiquewhite1", AntiqueWhite1)+                          , ("antiquewhite2", AntiqueWhite2)+                          , ("antiquewhite3", AntiqueWhite3)+                          , ("antiquewhite4", AntiqueWhite4)+                          , ("aquamarine", Aquamarine)+                          , ("aquamarine1", Aquamarine1)+                          , ("aquamarine2", Aquamarine2)+                          , ("aquamarine3", Aquamarine3)+                          , ("aquamarine4", Aquamarine4)+                          , ("azure", Azure)+                          , ("azure1", Azure1)+                          , ("azure2", Azure2)+                          , ("azure3", Azure3)+                          , ("azure4", Azure4)+                          , ("beige", Beige)+                          , ("bisque", Bisque)+                          , ("bisque1", Bisque1)+                          , ("bisque2", Bisque2)+                          , ("bisque3", Bisque3)+                          , ("bisque4", Bisque4)+                          , ("black", Black)+                          , ("blanchedalmond", BlanchedAlmond)+                          , ("blue", Blue)+                          , ("blue1", Blue1)+                          , ("blue2", Blue2)+                          , ("blue3", Blue3)+                          , ("blue4", Blue4)+                          , ("blueviolet", BlueViolet)+                          , ("brown", Brown)+                          , ("brown1", Brown1)+                          , ("brown2", Brown2)+                          , ("brown3", Brown3)+                          , ("brown4", Brown4)+                          , ("burlywood", Burlywood)+                          , ("burlywood1", Burlywood1)+                          , ("burlywood2", Burlywood2)+                          , ("burlywood3", Burlywood3)+                          , ("burlywood4", Burlywood4)+                          , ("cadetblue", CadetBlue)+                          , ("cadetblue1", CadetBlue1)+                          , ("cadetblue2", CadetBlue2)+                          , ("cadetblue3", CadetBlue3)+                          , ("cadetblue4", CadetBlue4)+                          , ("chartreuse", Chartreuse)+                          , ("chartreuse1", Chartreuse1)+                          , ("chartreuse2", Chartreuse2)+                          , ("chartreuse3", Chartreuse3)+                          , ("chartreuse4", Chartreuse4)+                          , ("chocolate", Chocolate)+                          , ("chocolate1", Chocolate1)+                          , ("chocolate2", Chocolate2)+                          , ("chocolate3", Chocolate3)+                          , ("chocolate4", Chocolate4)+                          , ("coral", Coral)+                          , ("coral1", Coral1)+                          , ("coral2", Coral2)+                          , ("coral3", Coral3)+                          , ("coral4", Coral4)+                          , ("cornflowerblue", CornFlowerBlue)+                          , ("cornsilk", CornSilk)+                          , ("cornsilk1", CornSilk1)+                          , ("cornsilk2", CornSilk2)+                          , ("cornsilk3", CornSilk3)+                          , ("cornsilk4", CornSilk4)+                          , ("crimson", Crimson)+                          , ("cyan", Cyan)+                          , ("cyan1", Cyan1)+                          , ("cyan2", Cyan2)+                          , ("cyan3", Cyan3)+                          , ("cyan4", Cyan4)+                          , ("darkgoldenrod", DarkGoldenrod)+                          , ("darkgoldenrod1", DarkGoldenrod1)+                          , ("darkgoldenrod2", DarkGoldenrod2)+                          , ("darkgoldenrod3", DarkGoldenrod3)+                          , ("darkgoldenrod4", DarkGoldenrod4)+                          , ("darkgreen", DarkGreen)+                          , ("darkkhaki", Darkkhaki)+                          , ("darkolivegreen", DarkOliveGreen)+                          , ("darkolivegreen1", DarkOliveGreen1)+                          , ("darkolivegreen2", DarkOliveGreen2)+                          , ("darkolivegreen3", DarkOliveGreen3)+                          , ("darkolivegreen4", DarkOliveGreen4)+                          , ("darkorange", DarkOrange)+                          , ("darkorange1", DarkOrange1)+                          , ("darkorange2", DarkOrange2)+                          , ("darkorange3", DarkOrange3)+                          , ("darkorange4", DarkOrange4)+                          , ("darkorchid", DarkOrchid)+                          , ("darkorchid1", DarkOrchid1)+                          , ("darkorchid2", DarkOrchid2)+                          , ("darkorchid3", DarkOrchid3)+                          , ("darkorchid4", DarkOrchid4)+                          , ("darksalmon", DarkSalmon)+                          , ("darkseagreen", DarkSeaGreen)+                          , ("darkseagreen1", DarkSeaGreen1)+                          , ("darkseagreen2", DarkSeaGreen2)+                          , ("darkseagreen3", DarkSeaGreen3)+                          , ("darkseagreen4", DarkSeaGreen4)+                          , ("darkslateblue", DarkSlateBlue)+                          , ("darkslategray", DarkSlateGray)+                          , ("darkslategrey", DarkSlateGray)+                          , ("darkslategray1", DarkSlateGray1)+                          , ("darkslategrey1", DarkSlateGray1)+                          , ("darkslategray2", DarkSlateGray2)+                          , ("darkslategrey2", DarkSlateGray2)+                          , ("darkslategray3", DarkSlateGray3)+                          , ("darkslategrey3", DarkSlateGray3)+                          , ("darkslategray4", DarkSlateGray4)+                          , ("darkslategrey4", DarkSlateGray4)+                          , ("darkturquoise", DarkTurquoise)+                          , ("darkviolet", DarkViolet)+                          , ("deeppink", DeepPink)+                          , ("deeppink1", DeepPink1)+                          , ("deeppink2", DeepPink2)+                          , ("deeppink3", DeepPink3)+                          , ("deeppink4", DeepPink4)+                          , ("deepskyblue", DeepSkyBlue)+                          , ("deepskyblue1", DeepSkyBlue1)+                          , ("deepskyblue2", DeepSkyBlue2)+                          , ("deepskyblue3", DeepSkyBlue3)+                          , ("deepskyblue4", DeepSkyBlue4)+                          , ("dimgray", DimGray)+                          , ("dimgrey", DimGray)+                          , ("dodgerblue", DodgerBlue)+                          , ("dodgerblue1", DodgerBlue1)+                          , ("dodgerblue2", DodgerBlue2)+                          , ("dodgerblue3", DodgerBlue3)+                          , ("dodgerblue4", DodgerBlue4)+                          , ("firebrick", Firebrick)+                          , ("firebrick1", Firebrick1)+                          , ("firebrick2", Firebrick2)+                          , ("firebrick3", Firebrick3)+                          , ("firebrick4", Firebrick4)+                          , ("floralwhite", FloralWhite)+                          , ("forestgreen", ForestGreen)+                          , ("gainsboro", Gainsboro)+                          , ("ghostwhite", GhostWhite)+                          , ("gold", Gold)+                          , ("gold1", Gold1)+                          , ("gold2", Gold2)+                          , ("gold3", Gold3)+                          , ("gold4", Gold4)+                          , ("goldenrod", Goldenrod)+                          , ("goldenrod1", Goldenrod1)+                          , ("goldenrod2", Goldenrod2)+                          , ("goldenrod3", Goldenrod3)+                          , ("goldenrod4", Goldenrod4)+                          , ("gray", Gray)+                          , ("grey", Gray)+                          , ("gray0", Gray0)+                          , ("grey0", Gray0)+                          , ("gray1", Gray1)+                          , ("grey1", Gray1)+                          , ("gray2", Gray2)+                          , ("grey2", Gray2)+                          , ("gray3", Gray3)+                          , ("grey3", Gray3)+                          , ("gray4", Gray4)+                          , ("grey4", Gray4)+                          , ("gray5", Gray5)+                          , ("grey5", Gray5)+                          , ("gray6", Gray6)+                          , ("grey6", Gray6)+                          , ("gray7", Gray7)+                          , ("grey7", Gray7)+                          , ("gray8", Gray8)+                          , ("grey8", Gray8)+                          , ("gray9", Gray9)+                          , ("grey9", Gray9)+                          , ("gray10", Gray10)+                          , ("grey10", Gray10)+                          , ("gray11", Gray11)+                          , ("grey11", Gray11)+                          , ("gray12", Gray12)+                          , ("grey12", Gray12)+                          , ("gray13", Gray13)+                          , ("grey13", Gray13)+                          , ("gray14", Gray14)+                          , ("grey14", Gray14)+                          , ("gray15", Gray15)+                          , ("grey15", Gray15)+                          , ("gray16", Gray16)+                          , ("grey16", Gray16)+                          , ("gray17", Gray17)+                          , ("grey17", Gray17)+                          , ("gray18", Gray18)+                          , ("grey18", Gray18)+                          , ("gray19", Gray19)+                          , ("grey19", Gray19)+                          , ("gray20", Gray20)+                          , ("grey20", Gray20)+                          , ("gray21", Gray21)+                          , ("grey21", Gray21)+                          , ("gray22", Gray22)+                          , ("grey22", Gray22)+                          , ("gray23", Gray23)+                          , ("grey23", Gray23)+                          , ("gray24", Gray24)+                          , ("grey24", Gray24)+                          , ("gray25", Gray25)+                          , ("grey25", Gray25)+                          , ("gray26", Gray26)+                          , ("grey26", Gray26)+                          , ("gray27", Gray27)+                          , ("grey27", Gray27)+                          , ("gray28", Gray28)+                          , ("grey28", Gray28)+                          , ("gray29", Gray29)+                          , ("grey29", Gray29)+                          , ("gray30", Gray30)+                          , ("grey30", Gray30)+                          , ("gray31", Gray31)+                          , ("grey31", Gray31)+                          , ("gray32", Gray32)+                          , ("grey32", Gray32)+                          , ("gray33", Gray33)+                          , ("grey33", Gray33)+                          , ("gray34", Gray34)+                          , ("grey34", Gray34)+                          , ("gray35", Gray35)+                          , ("grey35", Gray35)+                          , ("gray36", Gray36)+                          , ("grey36", Gray36)+                          , ("gray37", Gray37)+                          , ("grey37", Gray37)+                          , ("gray38", Gray38)+                          , ("grey38", Gray38)+                          , ("gray39", Gray39)+                          , ("grey39", Gray39)+                          , ("gray40", Gray40)+                          , ("grey40", Gray40)+                          , ("gray41", Gray41)+                          , ("grey41", Gray41)+                          , ("gray42", Gray42)+                          , ("grey42", Gray42)+                          , ("gray43", Gray43)+                          , ("grey43", Gray43)+                          , ("gray44", Gray44)+                          , ("grey44", Gray44)+                          , ("gray45", Gray45)+                          , ("grey45", Gray45)+                          , ("gray46", Gray46)+                          , ("grey46", Gray46)+                          , ("gray47", Gray47)+                          , ("grey47", Gray47)+                          , ("gray48", Gray48)+                          , ("grey48", Gray48)+                          , ("gray49", Gray49)+                          , ("grey49", Gray49)+                          , ("gray50", Gray50)+                          , ("grey50", Gray50)+                          , ("gray51", Gray51)+                          , ("grey51", Gray51)+                          , ("gray52", Gray52)+                          , ("grey52", Gray52)+                          , ("gray53", Gray53)+                          , ("grey53", Gray53)+                          , ("gray54", Gray54)+                          , ("grey54", Gray54)+                          , ("gray55", Gray55)+                          , ("grey55", Gray55)+                          , ("gray56", Gray56)+                          , ("grey56", Gray56)+                          , ("gray57", Gray57)+                          , ("grey57", Gray57)+                          , ("gray58", Gray58)+                          , ("grey58", Gray58)+                          , ("gray59", Gray59)+                          , ("grey59", Gray59)+                          , ("gray60", Gray60)+                          , ("grey60", Gray60)+                          , ("gray61", Gray61)+                          , ("grey61", Gray61)+                          , ("gray62", Gray62)+                          , ("grey62", Gray62)+                          , ("gray63", Gray63)+                          , ("grey63", Gray63)+                          , ("gray64", Gray64)+                          , ("grey64", Gray64)+                          , ("gray65", Gray65)+                          , ("grey65", Gray65)+                          , ("gray66", Gray66)+                          , ("grey66", Gray66)+                          , ("gray67", Gray67)+                          , ("grey67", Gray67)+                          , ("gray68", Gray68)+                          , ("grey68", Gray68)+                          , ("gray69", Gray69)+                          , ("grey69", Gray69)+                          , ("gray70", Gray70)+                          , ("grey70", Gray70)+                          , ("gray71", Gray71)+                          , ("grey71", Gray71)+                          , ("gray72", Gray72)+                          , ("grey72", Gray72)+                          , ("gray73", Gray73)+                          , ("grey73", Gray73)+                          , ("gray74", Gray74)+                          , ("grey74", Gray74)+                          , ("gray75", Gray75)+                          , ("grey75", Gray75)+                          , ("gray76", Gray76)+                          , ("grey76", Gray76)+                          , ("gray77", Gray77)+                          , ("grey77", Gray77)+                          , ("gray78", Gray78)+                          , ("grey78", Gray78)+                          , ("gray79", Gray79)+                          , ("grey79", Gray79)+                          , ("gray80", Gray80)+                          , ("grey80", Gray80)+                          , ("gray81", Gray81)+                          , ("grey81", Gray81)+                          , ("gray82", Gray82)+                          , ("grey82", Gray82)+                          , ("gray83", Gray83)+                          , ("grey83", Gray83)+                          , ("gray84", Gray84)+                          , ("grey84", Gray84)+                          , ("gray85", Gray85)+                          , ("grey85", Gray85)+                          , ("gray86", Gray86)+                          , ("grey86", Gray86)+                          , ("gray87", Gray87)+                          , ("grey87", Gray87)+                          , ("gray88", Gray88)+                          , ("grey88", Gray88)+                          , ("gray89", Gray89)+                          , ("grey89", Gray89)+                          , ("gray90", Gray90)+                          , ("grey90", Gray90)+                          , ("gray91", Gray91)+                          , ("grey91", Gray91)+                          , ("gray92", Gray92)+                          , ("grey92", Gray92)+                          , ("gray93", Gray93)+                          , ("grey93", Gray93)+                          , ("gray94", Gray94)+                          , ("grey94", Gray94)+                          , ("gray95", Gray95)+                          , ("grey95", Gray95)+                          , ("gray96", Gray96)+                          , ("grey96", Gray96)+                          , ("gray97", Gray97)+                          , ("grey97", Gray97)+                          , ("gray98", Gray98)+                          , ("grey98", Gray98)+                          , ("gray99", Gray99)+                          , ("grey99", Gray99)+                          , ("gray100", Gray100)+                          , ("grey100", Gray100)+                          , ("green", Green)+                          , ("green1", Green1)+                          , ("green2", Green2)+                          , ("green3", Green3)+                          , ("green4", Green4)+                          , ("greenyellow", GreenYellow)+                          , ("honeydew", HoneyDew)+                          , ("honeydew1", HoneyDew1)+                          , ("honeydew2", HoneyDew2)+                          , ("honeydew3", HoneyDew3)+                          , ("honeydew4", HoneyDew4)+                          , ("hotpink", HotPink)+                          , ("hotpink1", HotPink1)+                          , ("hotpink2", HotPink2)+                          , ("hotpink3", HotPink3)+                          , ("hotpink4", HotPink4)+                          , ("indianred", IndianRed)+                          , ("indianred1", IndianRed1)+                          , ("indianred2", IndianRed2)+                          , ("indianred3", IndianRed3)+                          , ("indianred4", IndianRed4)+                          , ("indigo", Indigo)+                          , ("ivory", Ivory)+                          , ("ivory1", Ivory1)+                          , ("ivory2", Ivory2)+                          , ("ivory3", Ivory3)+                          , ("ivory4", Ivory4)+                          , ("khaki", Khaki)+                          , ("khaki1", Khaki1)+                          , ("khaki2", Khaki2)+                          , ("khaki3", Khaki3)+                          , ("khaki4", Khaki4)+                          , ("lavender", Lavender)+                          , ("lavenderblush", LavenderBlush)+                          , ("lavenderblush1", LavenderBlush1)+                          , ("lavenderblush2", LavenderBlush2)+                          , ("lavenderblush3", LavenderBlush3)+                          , ("lavenderblush4", LavenderBlush4)+                          , ("lawngreen", LawnGreen)+                          , ("lemonchiffon", LemonChiffon)+                          , ("lemonchiffon1", LemonChiffon1)+                          , ("lemonchiffon2", LemonChiffon2)+                          , ("lemonchiffon3", LemonChiffon3)+                          , ("lemonchiffon4", LemonChiffon4)+                          , ("lightblue", LightBlue)+                          , ("lightblue1", LightBlue1)+                          , ("lightblue2", LightBlue2)+                          , ("lightblue3", LightBlue3)+                          , ("lightblue4", LightBlue4)+                          , ("lightcoral", LightCoral)+                          , ("lightcyan", LightCyan)+                          , ("lightcyan1", LightCyan1)+                          , ("lightcyan2", LightCyan2)+                          , ("lightcyan3", LightCyan3)+                          , ("lightcyan4", LightCyan4)+                          , ("lightgoldenrod", LightGoldenrod)+                          , ("lightgoldenrod1", LightGoldenrod1)+                          , ("lightgoldenrod2", LightGoldenrod2)+                          , ("lightgoldenrod3", LightGoldenrod3)+                          , ("lightgoldenrod4", LightGoldenrod4)+                          , ("lightgoldenrodyellow", LightGoldenrodYellow)+                          , ("lightgray", LightGray)+                          , ("lightgrey", LightGray)+                          , ("lightpink", LightPink)+                          , ("lightpink1", LightPink1)+                          , ("lightpink2", LightPink2)+                          , ("lightpink3", LightPink3)+                          , ("lightpink4", LightPink4)+                          , ("lightsalmon", LightSalmon)+                          , ("lightsalmon1", LightSalmon1)+                          , ("lightsalmon2", LightSalmon2)+                          , ("lightsalmon3", LightSalmon3)+                          , ("lightsalmon4", LightSalmon4)+                          , ("lightseagreen", LightSeaGreen)+                          , ("lightskyblue", LightSkyBlue)+                          , ("lightskyblue1", LightSkyBlue1)+                          , ("lightskyblue2", LightSkyBlue2)+                          , ("lightskyblue3", LightSkyBlue3)+                          , ("lightskyblue4", LightSkyBlue4)+                          , ("lightslateblue", LightSlateBlue)+                          , ("lightslategray", LightSlateGray)+                          , ("lightslategrey", LightSlateGray)+                          , ("lightsteelblue", LightSteelBlue)+                          , ("lightsteelblue1", LightSteelBlue1)+                          , ("lightsteelblue2", LightSteelBlue2)+                          , ("lightsteelblue3", LightSteelBlue3)+                          , ("lightsteelblue4", LightSteelBlue4)+                          , ("lightyellow", LightYellow)+                          , ("lightyellow1", LightYellow1)+                          , ("lightyellow2", LightYellow2)+                          , ("lightyellow3", LightYellow3)+                          , ("lightyellow4", LightYellow4)+                          , ("limegreen", LimeGreen)+                          , ("linen", Linen)+                          , ("magenta", Magenta)+                          , ("magenta1", Magenta1)+                          , ("magenta2", Magenta2)+                          , ("magenta3", Magenta3)+                          , ("magenta4", Magenta4)+                          , ("maroon", Maroon)+                          , ("maroon1", Maroon1)+                          , ("maroon2", Maroon2)+                          , ("maroon3", Maroon3)+                          , ("maroon4", Maroon4)+                          , ("mediumaquamarine", MediumAquamarine)+                          , ("mediumblue", MediumBlue)+                          , ("mediumorchid", MediumOrchid)+                          , ("mediumorchid1", MediumOrchid1)+                          , ("mediumorchid2", MediumOrchid2)+                          , ("mediumorchid3", MediumOrchid3)+                          , ("mediumorchid4", MediumOrchid4)+                          , ("mediumpurple", MediumPurple)+                          , ("mediumpurple1", MediumPurple1)+                          , ("mediumpurple2", MediumPurple2)+                          , ("mediumpurple3", MediumPurple3)+                          , ("mediumpurple4", MediumPurple4)+                          , ("mediumseagreen", MediumSeaGreen)+                          , ("mediumslateblue", MediumSlateBlue)+                          , ("mediumspringgreen", MediumSpringGreen)+                          , ("mediumturquoise", MediumTurquoise)+                          , ("mediumvioletred", MediumVioletRed)+                          , ("midnightblue", MidnightBlue)+                          , ("mintcream", MintCream)+                          , ("mistyrose", MistyRose)+                          , ("mistyrose1", MistyRose1)+                          , ("mistyrose2", MistyRose2)+                          , ("mistyrose3", MistyRose3)+                          , ("mistyrose4", MistyRose4)+                          , ("moccasin", Moccasin)+                          , ("navajowhite", NavajoWhite)+                          , ("navajowhite1", NavajoWhite1)+                          , ("navajowhite2", NavajoWhite2)+                          , ("navajowhite3", NavajoWhite3)+                          , ("navajowhite4", NavajoWhite4)+                          , ("navy", Navy)+                          , ("navyblue", NavyBlue)+                          , ("oldlace", OldLace)+                          , ("olivedrab", OliveDrab)+                          , ("olivedrab1", OliveDrab1)+                          , ("olivedrab2", OliveDrab2)+                          , ("olivedrab3", OliveDrab3)+                          , ("olivedrab4", OliveDrab4)+                          , ("orange", Orange)+                          , ("orange1", Orange1)+                          , ("orange2", Orange2)+                          , ("orange3", Orange3)+                          , ("orange4", Orange4)+                          , ("orangered", OrangeRed)+                          , ("orangered1", OrangeRed1)+                          , ("orangered2", OrangeRed2)+                          , ("orangered3", OrangeRed3)+                          , ("orangered4", OrangeRed4)+                          , ("orchid", Orchid)+                          , ("orchid1", Orchid1)+                          , ("orchid2", Orchid2)+                          , ("orchid3", Orchid3)+                          , ("orchid4", Orchid4)+                          , ("palegoldenrod", PaleGoldenrod)+                          , ("palegreen", PaleGreen)+                          , ("palegreen1", PaleGreen1)+                          , ("palegreen2", PaleGreen2)+                          , ("palegreen3", PaleGreen3)+                          , ("palegreen4", PaleGreen4)+                          , ("paleturquoise", PaleTurquoise)+                          , ("paleturquoise1", PaleTurquoise1)+                          , ("paleturquoise2", PaleTurquoise2)+                          , ("paleturquoise3", PaleTurquoise3)+                          , ("paleturquoise4", PaleTurquoise4)+                          , ("palevioletred", PaleVioletRed)+                          , ("palevioletred1", PaleVioletRed1)+                          , ("palevioletred2", PaleVioletRed2)+                          , ("palevioletred3", PaleVioletRed3)+                          , ("palevioletred4", PaleVioletRed4)+                          , ("papayawhip", PapayaWhip)+                          , ("peachpuff", PeachPuff)+                          , ("peachpuff1", PeachPuff1)+                          , ("peachpuff2", PeachPuff2)+                          , ("peachpuff3", PeachPuff3)+                          , ("peachpuff4", PeachPuff4)+                          , ("peru", Peru)+                          , ("pink", Pink)+                          , ("pink1", Pink1)+                          , ("pink2", Pink2)+                          , ("pink3", Pink3)+                          , ("pink4", Pink4)+                          , ("plum", Plum)+                          , ("plum1", Plum1)+                          , ("plum2", Plum2)+                          , ("plum3", Plum3)+                          , ("plum4", Plum4)+                          , ("powderblue", PowderBlue)+                          , ("purple", Purple)+                          , ("purple1", Purple1)+                          , ("purple2", Purple2)+                          , ("purple3", Purple3)+                          , ("purple4", Purple4)+                          , ("red", Red)+                          , ("red1", Red1)+                          , ("red2", Red2)+                          , ("red3", Red3)+                          , ("red4", Red4)+                          , ("rosybrown", RosyBrown)+                          , ("rosybrown1", RosyBrown1)+                          , ("rosybrown2", RosyBrown2)+                          , ("rosybrown3", RosyBrown3)+                          , ("rosybrown4", RosyBrown4)+                          , ("royalblue", RoyalBlue)+                          , ("royalblue1", RoyalBlue1)+                          , ("royalblue2", RoyalBlue2)+                          , ("royalblue3", RoyalBlue3)+                          , ("royalblue4", RoyalBlue4)+                          , ("saddlebrown", SaddleBrown)+                          , ("salmon", Salmon)+                          , ("salmon1", Salmon1)+                          , ("salmon2", Salmon2)+                          , ("salmon3", Salmon3)+                          , ("salmon4", Salmon4)+                          , ("sandybrown", SandyBrown)+                          , ("seagreen", SeaGreen)+                          , ("seagreen1", SeaGreen1)+                          , ("seagreen2", SeaGreen2)+                          , ("seagreen3", SeaGreen3)+                          , ("seagreen4", SeaGreen4)+                          , ("seashell", SeaShell)+                          , ("seashell1", SeaShell1)+                          , ("seashell2", SeaShell2)+                          , ("seashell3", SeaShell3)+                          , ("seashell4", SeaShell4)+                          , ("sienna", Sienna)+                          , ("sienna1", Sienna1)+                          , ("sienna2", Sienna2)+                          , ("sienna3", Sienna3)+                          , ("sienna4", Sienna4)+                          , ("skyblue", SkyBlue)+                          , ("skyblue1", SkyBlue1)+                          , ("skyblue2", SkyBlue2)+                          , ("skyblue3", SkyBlue3)+                          , ("skyblue4", SkyBlue4)+                          , ("slateblue", SlateBlue)+                          , ("slateblue1", SlateBlue1)+                          , ("slateblue2", SlateBlue2)+                          , ("slateblue3", SlateBlue3)+                          , ("slateblue4", SlateBlue4)+                          , ("slategray", SlateGray)+                          , ("slategrey", SlateGray)+                          , ("slategray1", SlateGray1)+                          , ("slategrey1", SlateGray1)+                          , ("slategray2", SlateGray2)+                          , ("slategrey2", SlateGray2)+                          , ("slategray3", SlateGray3)+                          , ("slategrey3", SlateGray3)+                          , ("slategray4", SlateGray4)+                          , ("slategrey4", SlateGray4)+                          , ("snow", Snow)+                          , ("snow1", Snow1)+                          , ("snow2", Snow2)+                          , ("snow3", Snow3)+                          , ("snow4", Snow4)+                          , ("springgreen", SpringGreen)+                          , ("springgreen1", SpringGreen1)+                          , ("springgreen2", SpringGreen2)+                          , ("springgreen3", SpringGreen3)+                          , ("springgreen4", SpringGreen4)+                          , ("steelblue", SteelBlue)+                          , ("steelblue1", SteelBlue1)+                          , ("steelblue2", SteelBlue2)+                          , ("steelblue3", SteelBlue3)+                          , ("steelblue4", SteelBlue4)+                          , ("tan", Tan)+                          , ("tan1", Tan1)+                          , ("tan2", Tan2)+                          , ("tan3", Tan3)+                          , ("tan4", Tan4)+                          , ("thistle", Thistle)+                          , ("thistle1", Thistle1)+                          , ("thistle2", Thistle2)+                          , ("thistle3", Thistle3)+                          , ("thistle4", Thistle4)+                          , ("tomato", Tomato)+                          , ("tomato1", Tomato1)+                          , ("tomato2", Tomato2)+                          , ("tomato3", Tomato3)+                          , ("tomato4", Tomato4)+                          , ("transparent", Transparent)+                          , ("invis", Transparent)+                          , ("none", Transparent)+                          , ("turquoise", Turquoise)+                          , ("turquoise1", Turquoise1)+                          , ("turquoise2", Turquoise2)+                          , ("turquoise3", Turquoise3)+                          , ("turquoise4", Turquoise4)+                          , ("violet", Violet)+                          , ("violetred", VioletRed)+                          , ("violetred1", VioletRed1)+                          , ("violetred2", VioletRed2)+                          , ("violetred3", VioletRed3)+                          , ("violetred4", VioletRed4)+                          , ("wheat", Wheat)+                          , ("wheat1", Wheat1)+                          , ("wheat2", Wheat2)+                          , ("wheat3", Wheat3)+                          , ("wheat4", Wheat4)+                          , ("white", White)+                          , ("whitesmoke", WhiteSmoke)+                          , ("yellow", Yellow)+                          , ("yellow1", Yellow1)+                          , ("yellow2", Yellow2)+                          , ("yellow3", Yellow3)+                          , ("yellow4", Yellow4)+                          , ("yellowgreen", YellowGreen)+                          ]  -- | Attempt to convert a 'Color' into a 'Colour' value with an alpha --   channel.  The use of 'Maybe' is because 'BrewerColor' values
+ Data/GraphViz/Attributes/Complete.hs view
@@ -0,0 +1,2750 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+   Module      : Data.GraphViz.Attributes.Complete+   Description : Definition of the Graphviz attributes.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   If you are just using graphviz to create basic Dot graphs, then you+   probably want to use "Data.GraphViz.Attributes" rather than this+   module.++   This module defines the various attributes that different parts of+   a Graphviz graph can have.  These attributes are based on the+   documentation found at:+     <http://graphviz.org/doc/info/attrs.html>++   For more information on usage, etc. please see that document.++   A summary of known current constraints\/limitations\/differences:++   * Note that for an edge, in /Dot/ parlance if the edge goes from+     /A/ to /B/, then /A/ is the tail node and /B/ is the head node+     (since /A/ is at the tail end of the arrow).++   * @ColorList@, @DoubleList@ and @PointfList@ are defined as actual+     lists (@'LayerList'@ needs a newtype for other reasons).  All of these+     are assumed to be non-empty lists.  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.  The optional '!' and+     third value for Point are also available.++   * 'Rect' uses two 'Point' values to denote the lower-left and+     top-right corners.++   * The two 'LabelLoc' attributes have been combined.++   * @SplineType@ has been replaced with @['Spline']@.++   * Only polygon-based 'Shape's are available.++   * Not every 'Attribute' is fully documented/described.  However,+     all those which have specific allowed values should be covered.++   * Deprecated 'Overlap' algorithms are not defined.++   * The global @Orientation@ attribute is not defined, as it is+     difficult to distinguish from the node-based 'Orientation'+     'Attribute'; also, its behaviour is duplicated by 'Rotate'.++   * The @charset@ attribute is not available, as graphviz only+     supports UTF-8 encoding (as it is not currently feasible nor needed to+     also support Latin1 encoding).++ -}+module Data.GraphViz.Attributes.Complete+       ( -- * The actual /Dot/ attributes.+         -- $attributes+         Attribute(..)+       , Attributes+       , sameAttribute+       , defaultAttributeValue+         -- ** Validity functions on @Attribute@ values.+       , usedByGraphs+       , usedBySubGraphs+       , usedByClusters+       , usedByNodes+       , usedByEdges+       , validUnknown++         -- ** Custom attributes.+       , AttributeName+       , CustomAttribute+       , customAttribute+       , isCustom+       , isSpecifiedCustom+       , customValue+       , customName+       , findCustoms+       , findSpecifiedCustom+       , deleteCustomAttributes+       , deleteSpecifiedCustom++         -- * Value types for @Attribute@s.+       , module Data.GraphViz.Attributes.Colors++         -- ** Labels+       , EscString+       , Label(..)+       , VerticalPlacement(..)+       , module Data.GraphViz.Attributes.HTML+         -- *** Types representing the Dot grammar for records.+       , RecordFields+       , RecordField(..)+       , Rect(..)+       , Justification(..)++         -- ** Nodes+       , Shape(..)+       , ScaleType(..)++         -- ** Edges+       , DirType(..)+       , EdgeType(..)+         -- *** Modifying where edges point+       , PortName(..)+       , PortPos(..)+       , CompassPoint(..)+         -- *** Arrows+       , ArrowType(..)+       , ArrowShape(..)+       , ArrowModifier(..)+       , ArrowFill(..)+       , ArrowSide(..)+         -- **** @ArrowModifier@ values+       , noMods+       , openMod++         -- ** Positioning+       , Point(..)+       , createPoint+       , Pos(..)+       , Spline(..)+       , DPoint(..)++         -- ** Layout+       , AspectType(..)+       , ClusterMode(..)+       , Model(..)+       , Overlap(..)+       , Root(..)+       , OutputMode(..)+       , Pack(..)+       , PackMode(..)+       , PageDir(..)+       , QuadType(..)+       , RankType(..)+       , RankDir(..)+       , StartType(..)+       , ViewPort(..)+       , FocusType(..)+       , Ratios(..)++         -- ** Modes+       , ModeType(..)+       , DEConstraints(..)++         -- ** Layers+       , LayerSep(..)+       , LayerRange(..)+       , LayerID(..)+       , LayerList(..)++         -- ** Stylistic+       , SmoothType(..)+       , STStyle(..)+       , StyleItem(..)+       , StyleName(..)+       ) where++import Data.GraphViz.Attributes.Colors+import Data.GraphViz.Attributes.HTML+import Data.GraphViz.Attributes.Internal+import Data.GraphViz.Util+import Data.GraphViz.Parsing+import Data.GraphViz.Printing+import Data.GraphViz.State(getLayerSep, setLayerSep)+import Data.GraphViz.Exception(GraphvizException(NotCustomAttr), throw)++import Data.List(partition)+import Data.Maybe(isJust)+import Data.Word(Word16)+import qualified Data.Set as S+import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)+import Control.Monad(liftM, liftM2)++-- -----------------------------------------------------------------------------++{- $attributes++   These attributes have been implemented in a /permissive/ manner:+   that is, rather than split them up based on which type of value+   they are allowed, they have all been included in the one data type,+   with functions to determine if they are indeed valid for what+   they're being applied to.++   To interpret the /Valid for/ listings:++     [@G@] Valid for Graphs.++     [@C@] Valid for Clusters.++     [@S@] Valid for Sub-Graphs (and also Clusters).++     [@N@] Valid for Nodes.++     [@E@] Valid for Edges.++   The /Default/ listings are those that the various Graphviz commands+   use if that 'Attribute' isn't specified (in cases where this is+   /none/, this is equivalent to a 'Nothing' value; that is, no value+   is used).  The /Parsing Default/ listings represent what value is+   used (i.e. corresponds to 'True') when the 'Attribute' name is+   listed on its own in /Dot/ source code.++   Please note that the 'UnknownAttribute' 'Attribute' is defined+   primarily for backwards-compatibility purposes.  It is possible to use+   it directly for custom purposes; for more information, please see+   'CustomAttribute'.  The 'deleteCustomAttributes' can be used to delete+   these values.++ -}++-- | Attributes are used to customise the layout and design of Dot+--   graphs.  Care must be taken to ensure that the attribute you use+--   is valid, as not all attributes can be used everywhere.+data Attribute+  = Damping Double                      -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only+  | K Double                            -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only+  | URL EscString                       -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only+  | ArrowHead ArrowType                 -- ^ /Valid for/: E; /Default/: @'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/: @'X11Color' 'Transparent'@+  | Center Bool                         -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+  | ClusterRank ClusterMode             -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only+  | ColorScheme ColorScheme             -- ^ /Valid for/: ENCG; /Default/: @'X11'@+  | Color [Color]                       -- ^ /Valid for/: ENC; /Default/: @['X11Color' 'Black']@+  | Comment Text                        -- ^ /Valid for/: ENG; /Default/: @\"\"@+  | Compound Bool                       -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only+  | Concentrate Bool                    -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+  | Constraint Bool                     -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: dot only+  | Decorate Bool                       -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'+  | DefaultDist Double                  -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(|V|)@; /Minimum/: @epsilon@; /Notes/: neato only+  | Dimen Int                           -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only+  | Dim Int                             -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only+  | Dir DirType                         -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)+  | DirEdgeConstraints DEConstraints    -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only+  | Distortion Double                   -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@+  | DPI Double                          -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym+  | EdgeURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | EdgeTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | EdgeTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Epsilon Double                      -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only+  | ESep DPoint                         -- ^ /Valid for/: G; /Default/: @'DVal' 3@; /Notes/: not dot+  | FillColor Color                     -- ^ /Valid for/: NC; /Default/: @'X11Color' 'LightGray'@ (nodes), @'X11Color' 'Black'@ (clusters)+  | FixedSize Bool                      -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'+  | FontColor Color                     -- ^ /Valid for/: ENGC; /Default/: @'X11Color' 'Black'@+  | FontName Text                       -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@+  | FontNames Text                      -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only+  | FontPath Text                       -- ^ /Valid for/: G; /Default/: system dependent+  | FontSize Double                     -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@+  | Group Text                          -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only+  | HeadURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | HeadClip Bool                       -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'+  | HeadLabel Label                     -- ^ /Valid for/: E; /Default/: 'StrLabel' @\"\"@+  | HeadPort PortPos                    -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@+  | HeadTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | HeadTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Height Double                       -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@+  | ID Label                            -- ^ /Valid for/: GNE; /Default/: @'StrLabel' \"\"@; /Notes/: svg, postscript, map only+  | Image Text                          -- ^ /Valid for/: N; /Default/: @\"\"@+  | ImageScale ScaleType                -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'+  | LabelURL EscString                  -- ^ /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/: @'X11Color' 'Black'@+  | LabelFontName Text                  -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@+  | LabelFontSize Double                -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@+  | LabelJust Justification             -- ^ /Valid for/: GC; /Default/: @'JCenter'@+  | LabelLoc VerticalPlacement          -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)+  | LabelTarget EscString               -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | LabelTooltip EscString              -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Label Label                         -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)+  | Landscape Bool                      -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'+  | LayerSep LayerSep                   -- ^ /Valid for/: G; /Default/: @'LSep' \" :\t\"@+  | Layers LayerList                    -- ^ /Valid for/: G; /Default/: @'LL' []@+  | Layer LayerRange                    -- ^ /Valid for/: EN+  | Layout Text                         -- ^ /Valid for/: G; /Default/: @\"\"@+  | Len Double                          -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only+  | LevelsGap Double                    -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only+  | Levels Int                          -- ^ /Valid for/: G; /Default/: @'maxBound'@; /Minimum/: @0@; /Notes/: sfdp only+  | LHead Text                          -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+  | LPos Point                          -- ^ /Valid for/: EGC; /Notes/: write only+  | LTail Text                          -- ^ /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+  | Model Model                         -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only+  | Mode ModeType                       -- ^ /Valid for/: G; /Default/: @'Major'@; /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+  | Nslimit1 Double                     -- ^ /Valid for/: G; /Notes/: dot only+  | Nslimit Double                      -- ^ /Valid for/: G; /Notes/: dot only+  | Ordering Text                       -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: dot only+  | Orientation Double                  -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@+  | OutputOrder OutputMode              -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@+  | OverlapScaling Double               -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only+  | Overlap Overlap                     -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot+  | PackMode PackMode                   -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot+  | Pack Pack                           -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'DoPack'; /Notes/: not dot+  | Pad DPoint                          -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)+  | PageDir PageDir                     -- ^ /Valid for/: G; /Default/: @'Bl'@+  | Page Point                          -- ^ /Valid for/: G+  | PenColor Color                      -- ^ /Valid for/: C; /Default/: @'X11Color' 'Black'@+  | PenWidth Double                     -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@+  | Peripheries Int                     -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0+  | Pin Bool                            -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only+  | Pos Pos                             -- ^ /Valid for/: EN+  | QuadTree QuadType                   -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only+  | Quantum Double                      -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@+  | RankDir RankDir                     -- ^ /Valid for/: G; /Default/: @'FromTop'@; /Notes/: dot only+  | RankSep [Double]                    -- ^ /Valid for/: G; /Default/: @[0.5]@ (dot), @[1.0]@ (twopi); /Minimum/: [0.02]; /Notes/: twopi, dot only+  | Rank RankType                       -- ^ /Valid for/: S; /Notes/: 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 Text                       -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+  | SameTail Text                       -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only+  | SamplePoints Int                    -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)+  | SearchSize Int                      -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only+  | Sep DPoint                          -- ^ /Valid for/: G; /Default/: @'DVal' 4@; /Notes/: not dot+  | ShapeFile Text                      -- ^ /Valid for/: N; /Default/: @\"\"@+  | Shape Shape                         -- ^ /Valid for/: N; /Default/: @'Ellipse'@+  | ShowBoxes Int                       -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only+  | Sides Int                           -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@+  | Size Point                          -- ^ /Valid for/: G+  | Skew Double                         -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@+  | Smoothing SmoothType                -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only+  | SortV Word16                        -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@+  | Splines EdgeType                    -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges'+  | Start StartType                     -- ^ /Valid for/: G; /Notes/: fdp, neato only+  | StyleSheet Text                     -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only+  | Style [StyleItem]                   -- ^ /Valid for/: ENC+  | TailURL EscString                   -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only+  | TailClip Bool                       -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'+  | TailLabel Label                     -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@+  | TailPort PortPos                    -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@+  | TailTarget EscString                -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only+  | TailTooltip EscString               -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only+  | Target EscString                    -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only+  | Tooltip EscString                   -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only+  | TrueColor Bool                      -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only+  | Vertices [Point]                    -- ^ /Valid for/: N; /Notes/: write only+  | ViewPort ViewPort                   -- ^ /Valid for/: G; /Default/: none+  | VoroMargin Double                   -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not dot+  | Weight Double                       -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0@ (dot), @1@ (neato,fdp,sfdp)+  | Width Double                        -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@+  | Z Double                            -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-MAXFLOAT@, @-1000@+  | UnknownAttribute AttributeName Text -- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively.+  deriving (Eq, Ord, Show, Read)++type Attributes = [Attribute]++-- | The name for an UnknownAttribute; must satisfy  'validUnknown'.+type AttributeName = Text++instance PrintDot Attribute where+  unqtDot (Damping v)            = printField "Damping" v+  unqtDot (K v)                  = printField "K" v+  unqtDot (URL v)                = printField "URL" v+  unqtDot (ArrowHead v)          = printField "arrowhead" v+  unqtDot (ArrowSize v)          = printField "arrowsize" v+  unqtDot (ArrowTail v)          = printField "arrowtail" v+  unqtDot (Aspect v)             = printField "aspect" v+  unqtDot (Bb v)                 = printField "bb" v+  unqtDot (BgColor v)            = printField "bgcolor" v+  unqtDot (Center v)             = printField "center" v+  unqtDot (ClusterRank v)        = printField "clusterrank" v+  unqtDot (ColorScheme v)        = printField "colorscheme" v+  unqtDot (Color v)              = printField "color" v+  unqtDot (Comment v)            = printField "comment" v+  unqtDot (Compound v)           = printField "compound" v+  unqtDot (Concentrate v)        = printField "concentrate" v+  unqtDot (Constraint v)         = printField "constraint" v+  unqtDot (Decorate v)           = printField "decorate" v+  unqtDot (DefaultDist v)        = printField "defaultdist" v+  unqtDot (Dimen v)              = printField "dimen" v+  unqtDot (Dim v)                = printField "dim" 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 (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 (Label v)              = printField "label" v+  unqtDot (Landscape v)          = printField "landscape" v+  unqtDot (LayerSep v)           = printField "layersep" v+  unqtDot (Layers v)             = printField "layers" v+  unqtDot (Layer v)              = printField "layer" v+  unqtDot (Layout v)             = printField "layout" v+  unqtDot (Len v)                = printField "len" v+  unqtDot (LevelsGap v)          = printField "levelsgap" v+  unqtDot (Levels v)             = printField "levels" v+  unqtDot (LHead v)              = printField "lhead" v+  unqtDot (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 (Model v)              = printField "model" v+  unqtDot (Mode v)               = printField "mode" 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 (Nslimit1 v)           = printField "nslimit1" v+  unqtDot (Nslimit v)            = printField "nslimit" v+  unqtDot (Ordering v)           = printField "ordering" v+  unqtDot (Orientation v)        = printField "orientation" v+  unqtDot (OutputOrder v)        = printField "outputorder" v+  unqtDot (OverlapScaling v)     = printField "overlap_scaling" v+  unqtDot (Overlap v)            = printField "overlap" v+  unqtDot (PackMode v)           = printField "packmode" v+  unqtDot (Pack v)               = printField "pack" v+  unqtDot (Pad v)                = printField "pad" v+  unqtDot (PageDir v)            = printField "pagedir" v+  unqtDot (Page v)               = printField "page" 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 (RankDir v)            = printField "rankdir" v+  unqtDot (RankSep v)            = printField "ranksep" v+  unqtDot (Rank v)               = printField "rank" 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 (ShapeFile v)          = printField "shapefile" v+  unqtDot (Shape v)              = printField "shape" v+  unqtDot (ShowBoxes v)          = printField "showboxes" v+  unqtDot (Sides v)              = printField "sides" v+  unqtDot (Size v)               = printField "size" v+  unqtDot (Skew v)               = printField "skew" v+  unqtDot (Smoothing v)          = printField "smoothing" v+  unqtDot (SortV v)              = printField "sortv" v+  unqtDot (Splines v)            = printField "splines" v+  unqtDot (Start v)              = printField "start" v+  unqtDot (StyleSheet v)         = printField "stylesheet" v+  unqtDot (Style v)              = printField "style" 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+  unqtDot (UnknownAttribute a v) = toDot a <> equals <> toDot v++  listToDot = unqtListToDot++instance ParseDot Attribute where+  parseUnqt = stringParse (concat [ parseField Damping "Damping"+                                  , parseField K "K"+                                  , parseFields URL ["URL", "href"]+                                  , parseField ArrowHead "arrowhead"+                                  , parseField ArrowSize "arrowsize"+                                  , parseField ArrowTail "arrowtail"+                                  , parseField Aspect "aspect"+                                  , parseField Bb "bb"+                                  , parseField BgColor "bgcolor"+                                  , parseFieldBool Center "center"+                                  , parseField ClusterRank "clusterrank"+                                  , parseField ColorScheme "colorscheme"+                                  , parseField Color "color"+                                  , parseField Comment "comment"+                                  , parseFieldBool Compound "compound"+                                  , parseFieldBool Concentrate "concentrate"+                                  , parseFieldBool Constraint "constraint"+                                  , parseFieldBool Decorate "decorate"+                                  , parseField DefaultDist "defaultdist"+                                  , parseField Dimen "dimen"+                                  , parseField Dim "dim"+                                  , parseField Dir "dir"+                                  , parseFieldDef DirEdgeConstraints EdgeConstraints "diredgeconstraints"+                                  , parseField Distortion "distortion"+                                  , parseFields DPI ["dpi", "resolution"]+                                  , parseFields EdgeURL ["edgeURL", "edgehref"]+                                  , parseField EdgeTarget "edgetarget"+                                  , parseField EdgeTooltip "edgetooltip"+                                  , parseField Epsilon "epsilon"+                                  , parseField ESep "esep"+                                  , parseField FillColor "fillcolor"+                                  , parseFieldBool FixedSize "fixedsize"+                                  , parseField FontColor "fontcolor"+                                  , parseField FontName "fontname"+                                  , parseField FontNames "fontnames"+                                  , parseField FontPath "fontpath"+                                  , parseField FontSize "fontsize"+                                  , parseField Group "group"+                                  , parseFields HeadURL ["headURL", "headhref"]+                                  , parseFieldBool HeadClip "headclip"+                                  , parseField HeadLabel "headlabel"+                                  , parseField HeadPort "headport"+                                  , parseField HeadTarget "headtarget"+                                  , parseField HeadTooltip "headtooltip"+                                  , parseField Height "height"+                                  , parseField ID "id"+                                  , parseField Image "image"+                                  , parseFieldDef ImageScale UniformScale "imagescale"+                                  , parseFields LabelURL ["labelURL", "labelhref"]+                                  , parseField LabelAngle "labelangle"+                                  , parseField LabelDistance "labeldistance"+                                  , parseFieldBool LabelFloat "labelfloat"+                                  , parseField LabelFontColor "labelfontcolor"+                                  , parseField LabelFontName "labelfontname"+                                  , parseField LabelFontSize "labelfontsize"+                                  , parseField LabelJust "labeljust"+                                  , parseField LabelLoc "labelloc"+                                  , parseField LabelTarget "labeltarget"+                                  , parseField LabelTooltip "labeltooltip"+                                  , parseField Label "label"+                                  , parseFieldBool Landscape "landscape"+                                  , parseField LayerSep "layersep"+                                  , parseField Layers "layers"+                                  , parseField Layer "layer"+                                  , parseField Layout "layout"+                                  , parseField Len "len"+                                  , parseField LevelsGap "levelsgap"+                                  , parseField Levels "levels"+                                  , parseField LHead "lhead"+                                  , parseField LPos "lp"+                                  , parseField LTail "ltail"+                                  , parseField Margin "margin"+                                  , parseField MaxIter "maxiter"+                                  , parseField MCLimit "mclimit"+                                  , parseField MinDist "mindist"+                                  , parseField MinLen "minlen"+                                  , parseField Model "model"+                                  , parseField Mode "mode"+                                  , parseFieldBool Mosek "mosek"+                                  , parseField NodeSep "nodesep"+                                  , parseFieldBool NoJustify "nojustify"+                                  , parseFieldBool Normalize "normalize"+                                  , parseField Nslimit1 "nslimit1"+                                  , parseField Nslimit "nslimit"+                                  , parseField Ordering "ordering"+                                  , parseField Orientation "orientation"+                                  , parseField OutputOrder "outputorder"+                                  , parseField OverlapScaling "overlap_scaling"+                                  , parseFieldDef Overlap KeepOverlaps "overlap"+                                  , parseField PackMode "packmode"+                                  , parseFieldDef Pack DoPack "pack"+                                  , parseField Pad "pad"+                                  , parseField PageDir "pagedir"+                                  , parseField Page "page"+                                  , parseField PenColor "pencolor"+                                  , parseField PenWidth "penwidth"+                                  , parseField Peripheries "peripheries"+                                  , parseFieldBool Pin "pin"+                                  , parseField Pos "pos"+                                  , parseFieldDef QuadTree NormalQT "quadtree"+                                  , parseField Quantum "quantum"+                                  , parseField RankDir "rankdir"+                                  , parseField RankSep "ranksep"+                                  , parseField Rank "rank"+                                  , parseField Ratio "ratio"+                                  , parseField Rects "rects"+                                  , parseFieldBool Regular "regular"+                                  , parseFieldBool ReMinCross "remincross"+                                  , parseField RepulsiveForce "repulsiveforce"+                                  , parseFieldDef Root IsCentral "root"+                                  , parseField Rotate "rotate"+                                  , parseField SameHead "samehead"+                                  , parseField SameTail "sametail"+                                  , parseField SamplePoints "samplepoints"+                                  , parseField SearchSize "searchsize"+                                  , parseField Sep "sep"+                                  , parseField ShapeFile "shapefile"+                                  , parseField Shape "shape"+                                  , parseField ShowBoxes "showboxes"+                                  , parseField Sides "sides"+                                  , parseField Size "size"+                                  , parseField Skew "skew"+                                  , parseField Smoothing "smoothing"+                                  , parseField SortV "sortv"+                                  , parseFieldDef Splines SplineEdges "splines"+                                  , parseField Start "start"+                                  , parseField StyleSheet "stylesheet"+                                  , parseField Style "style"+                                  , parseFields TailURL ["tailURL", "tailhref"]+                                  , parseFieldBool TailClip "tailclip"+                                  , parseField TailLabel "taillabel"+                                  , parseField TailPort "tailport"+                                  , parseField TailTarget "tailtarget"+                                  , parseField TailTooltip "tailtooltip"+                                  , parseField Target "target"+                                  , parseField Tooltip "tooltip"+                                  , parseFieldBool TrueColor "truecolor"+                                  , parseField Vertices "vertices"+                                  , parseField ViewPort "viewport"+                                  , parseField VoroMargin "voro_margin"+                                  , parseField Weight "weight"+                                  , parseField Width "width"+                                  , parseField Z "z"+                                  ])+              `onFail`+              liftM2 UnknownAttribute stringBlock (parseEq >> parse)++  parse = parseUnqt++  parseList = parseUnqtList++-- | Determine if this 'Attribute' is valid for use with Graphs.+usedByGraphs                      :: Attribute -> Bool+usedByGraphs Damping{}            = True+usedByGraphs K{}                  = True+usedByGraphs URL{}                = True+usedByGraphs Aspect{}             = True+usedByGraphs Bb{}                 = True+usedByGraphs BgColor{}            = True+usedByGraphs Center{}             = True+usedByGraphs ClusterRank{}        = True+usedByGraphs ColorScheme{}        = True+usedByGraphs Comment{}            = True+usedByGraphs Compound{}           = True+usedByGraphs Concentrate{}        = True+usedByGraphs DefaultDist{}        = True+usedByGraphs Dimen{}              = True+usedByGraphs Dim{}                = 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 LabelJust{}          = True+usedByGraphs LabelLoc{}           = True+usedByGraphs Label{}              = True+usedByGraphs Landscape{}          = True+usedByGraphs LayerSep{}           = True+usedByGraphs Layers{}             = True+usedByGraphs Layout{}             = True+usedByGraphs LevelsGap{}          = True+usedByGraphs Levels{}             = True+usedByGraphs LPos{}               = True+usedByGraphs Margin{}             = True+usedByGraphs MaxIter{}            = True+usedByGraphs MCLimit{}            = True+usedByGraphs MinDist{}            = True+usedByGraphs Model{}              = True+usedByGraphs Mode{}               = True+usedByGraphs Mosek{}              = True+usedByGraphs NodeSep{}            = True+usedByGraphs NoJustify{}          = True+usedByGraphs Normalize{}          = True+usedByGraphs Nslimit1{}           = True+usedByGraphs Nslimit{}            = True+usedByGraphs Ordering{}           = True+usedByGraphs OutputOrder{}        = True+usedByGraphs OverlapScaling{}     = True+usedByGraphs Overlap{}            = True+usedByGraphs PackMode{}           = True+usedByGraphs Pack{}               = True+usedByGraphs Pad{}                = True+usedByGraphs PageDir{}            = True+usedByGraphs Page{}               = 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 UnknownAttribute{}   = 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 ColorScheme{}      = True+usedByClusters Color{}            = True+usedByClusters FillColor{}        = True+usedByClusters FontColor{}        = True+usedByClusters FontName{}         = True+usedByClusters FontSize{}         = True+usedByClusters LabelJust{}        = True+usedByClusters LabelLoc{}         = True+usedByClusters Label{}            = 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 UnknownAttribute{} = True+usedByClusters _                  = False++-- | Determine if this 'Attribute' is valid for use with SubGraphs.+usedBySubGraphs                    :: Attribute -> Bool+usedBySubGraphs Rank{}             = True+usedBySubGraphs UnknownAttribute{} = True+usedBySubGraphs _                  = False++-- | Determine if this 'Attribute' is valid for use with Nodes.+usedByNodes                    :: Attribute -> Bool+usedByNodes URL{}              = True+usedByNodes ColorScheme{}      = True+usedByNodes Color{}            = True+usedByNodes Comment{}          = True+usedByNodes Distortion{}       = True+usedByNodes FillColor{}        = True+usedByNodes FixedSize{}        = True+usedByNodes FontColor{}        = True+usedByNodes FontName{}         = True+usedByNodes FontSize{}         = True+usedByNodes Group{}            = True+usedByNodes Height{}           = True+usedByNodes ID{}               = True+usedByNodes Image{}            = True+usedByNodes ImageScale{}       = True+usedByNodes LabelLoc{}         = True+usedByNodes Label{}            = 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 ShapeFile{}        = True+usedByNodes Shape{}            = True+usedByNodes ShowBoxes{}        = True+usedByNodes Sides{}            = True+usedByNodes Skew{}             = True+usedByNodes SortV{}            = True+usedByNodes Style{}            = True+usedByNodes Target{}           = True+usedByNodes Tooltip{}          = True+usedByNodes Vertices{}         = True+usedByNodes Width{}            = True+usedByNodes Z{}                = True+usedByNodes UnknownAttribute{} = True+usedByNodes _                  = False++-- | Determine if this 'Attribute' is valid for use with Edges.+usedByEdges                    :: Attribute -> Bool+usedByEdges URL{}              = True+usedByEdges ArrowHead{}        = True+usedByEdges ArrowSize{}        = True+usedByEdges ArrowTail{}        = True+usedByEdges ColorScheme{}      = True+usedByEdges Color{}            = True+usedByEdges Comment{}          = True+usedByEdges Constraint{}       = True+usedByEdges Decorate{}         = True+usedByEdges Dir{}              = True+usedByEdges EdgeURL{}          = True+usedByEdges EdgeTarget{}       = True+usedByEdges EdgeTooltip{}      = True+usedByEdges 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 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 Label{}            = 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 UnknownAttribute{} = True+usedByEdges _                  = False++-- | Determine if two 'Attributes' are the same type of 'Attribute'.+sameAttribute                                                 :: Attribute -> Attribute -> Bool+sameAttribute Damping{}               Damping{}               = True+sameAttribute K{}                     K{}                     = True+sameAttribute URL{}                   URL{}                   = True+sameAttribute ArrowHead{}             ArrowHead{}             = True+sameAttribute ArrowSize{}             ArrowSize{}             = True+sameAttribute ArrowTail{}             ArrowTail{}             = True+sameAttribute Aspect{}                Aspect{}                = True+sameAttribute Bb{}                    Bb{}                    = True+sameAttribute BgColor{}               BgColor{}               = True+sameAttribute Center{}                Center{}                = True+sameAttribute ClusterRank{}           ClusterRank{}           = True+sameAttribute ColorScheme{}           ColorScheme{}           = True+sameAttribute Color{}                 Color{}                 = True+sameAttribute Comment{}               Comment{}               = True+sameAttribute Compound{}              Compound{}              = True+sameAttribute Concentrate{}           Concentrate{}           = True+sameAttribute Constraint{}            Constraint{}            = True+sameAttribute Decorate{}              Decorate{}              = True+sameAttribute DefaultDist{}           DefaultDist{}           = True+sameAttribute Dimen{}                 Dimen{}                 = True+sameAttribute Dim{}                   Dim{}                   = True+sameAttribute Dir{}                   Dir{}                   = True+sameAttribute DirEdgeConstraints{}    DirEdgeConstraints{}    = True+sameAttribute Distortion{}            Distortion{}            = True+sameAttribute DPI{}                   DPI{}                   = True+sameAttribute EdgeURL{}               EdgeURL{}               = True+sameAttribute EdgeTarget{}            EdgeTarget{}            = True+sameAttribute EdgeTooltip{}           EdgeTooltip{}           = True+sameAttribute Epsilon{}               Epsilon{}               = True+sameAttribute ESep{}                  ESep{}                  = True+sameAttribute FillColor{}             FillColor{}             = True+sameAttribute FixedSize{}             FixedSize{}             = True+sameAttribute FontColor{}             FontColor{}             = True+sameAttribute FontName{}              FontName{}              = True+sameAttribute FontNames{}             FontNames{}             = True+sameAttribute FontPath{}              FontPath{}              = True+sameAttribute FontSize{}              FontSize{}              = True+sameAttribute Group{}                 Group{}                 = True+sameAttribute HeadURL{}               HeadURL{}               = True+sameAttribute HeadClip{}              HeadClip{}              = True+sameAttribute HeadLabel{}             HeadLabel{}             = True+sameAttribute HeadPort{}              HeadPort{}              = True+sameAttribute HeadTarget{}            HeadTarget{}            = True+sameAttribute HeadTooltip{}           HeadTooltip{}           = True+sameAttribute Height{}                Height{}                = True+sameAttribute ID{}                    ID{}                    = True+sameAttribute Image{}                 Image{}                 = True+sameAttribute ImageScale{}            ImageScale{}            = True+sameAttribute LabelURL{}              LabelURL{}              = True+sameAttribute LabelAngle{}            LabelAngle{}            = True+sameAttribute LabelDistance{}         LabelDistance{}         = True+sameAttribute LabelFloat{}            LabelFloat{}            = True+sameAttribute LabelFontColor{}        LabelFontColor{}        = True+sameAttribute LabelFontName{}         LabelFontName{}         = True+sameAttribute LabelFontSize{}         LabelFontSize{}         = True+sameAttribute LabelJust{}             LabelJust{}             = True+sameAttribute LabelLoc{}              LabelLoc{}              = True+sameAttribute LabelTarget{}           LabelTarget{}           = True+sameAttribute LabelTooltip{}          LabelTooltip{}          = True+sameAttribute Label{}                 Label{}                 = True+sameAttribute Landscape{}             Landscape{}             = True+sameAttribute LayerSep{}              LayerSep{}              = True+sameAttribute Layers{}                Layers{}                = True+sameAttribute Layer{}                 Layer{}                 = True+sameAttribute Layout{}                Layout{}                = True+sameAttribute Len{}                   Len{}                   = True+sameAttribute LevelsGap{}             LevelsGap{}             = True+sameAttribute Levels{}                Levels{}                = True+sameAttribute LHead{}                 LHead{}                 = True+sameAttribute LPos{}                  LPos{}                  = True+sameAttribute LTail{}                 LTail{}                 = True+sameAttribute Margin{}                Margin{}                = True+sameAttribute MaxIter{}               MaxIter{}               = True+sameAttribute MCLimit{}               MCLimit{}               = True+sameAttribute MinDist{}               MinDist{}               = True+sameAttribute MinLen{}                MinLen{}                = True+sameAttribute Model{}                 Model{}                 = True+sameAttribute Mode{}                  Mode{}                  = True+sameAttribute Mosek{}                 Mosek{}                 = True+sameAttribute NodeSep{}               NodeSep{}               = True+sameAttribute NoJustify{}             NoJustify{}             = True+sameAttribute Normalize{}             Normalize{}             = True+sameAttribute Nslimit1{}              Nslimit1{}              = True+sameAttribute Nslimit{}               Nslimit{}               = True+sameAttribute Ordering{}              Ordering{}              = True+sameAttribute Orientation{}           Orientation{}           = True+sameAttribute OutputOrder{}           OutputOrder{}           = True+sameAttribute OverlapScaling{}        OverlapScaling{}        = True+sameAttribute Overlap{}               Overlap{}               = True+sameAttribute PackMode{}              PackMode{}              = True+sameAttribute Pack{}                  Pack{}                  = True+sameAttribute Pad{}                   Pad{}                   = True+sameAttribute PageDir{}               PageDir{}               = True+sameAttribute Page{}                  Page{}                  = True+sameAttribute PenColor{}              PenColor{}              = True+sameAttribute PenWidth{}              PenWidth{}              = True+sameAttribute Peripheries{}           Peripheries{}           = True+sameAttribute Pin{}                   Pin{}                   = True+sameAttribute Pos{}                   Pos{}                   = True+sameAttribute QuadTree{}              QuadTree{}              = True+sameAttribute Quantum{}               Quantum{}               = True+sameAttribute RankDir{}               RankDir{}               = True+sameAttribute RankSep{}               RankSep{}               = True+sameAttribute Rank{}                  Rank{}                  = True+sameAttribute Ratio{}                 Ratio{}                 = True+sameAttribute Rects{}                 Rects{}                 = True+sameAttribute Regular{}               Regular{}               = True+sameAttribute ReMinCross{}            ReMinCross{}            = True+sameAttribute RepulsiveForce{}        RepulsiveForce{}        = True+sameAttribute Root{}                  Root{}                  = True+sameAttribute Rotate{}                Rotate{}                = True+sameAttribute SameHead{}              SameHead{}              = True+sameAttribute SameTail{}              SameTail{}              = True+sameAttribute SamplePoints{}          SamplePoints{}          = True+sameAttribute SearchSize{}            SearchSize{}            = True+sameAttribute Sep{}                   Sep{}                   = True+sameAttribute ShapeFile{}             ShapeFile{}             = True+sameAttribute Shape{}                 Shape{}                 = True+sameAttribute ShowBoxes{}             ShowBoxes{}             = True+sameAttribute Sides{}                 Sides{}                 = True+sameAttribute Size{}                  Size{}                  = True+sameAttribute Skew{}                  Skew{}                  = True+sameAttribute Smoothing{}             Smoothing{}             = True+sameAttribute SortV{}                 SortV{}                 = True+sameAttribute Splines{}               Splines{}               = True+sameAttribute Start{}                 Start{}                 = True+sameAttribute StyleSheet{}            StyleSheet{}            = True+sameAttribute Style{}                 Style{}                 = True+sameAttribute TailURL{}               TailURL{}               = True+sameAttribute TailClip{}              TailClip{}              = True+sameAttribute TailLabel{}             TailLabel{}             = True+sameAttribute TailPort{}              TailPort{}              = True+sameAttribute TailTarget{}            TailTarget{}            = True+sameAttribute TailTooltip{}           TailTooltip{}           = True+sameAttribute Target{}                Target{}                = True+sameAttribute Tooltip{}               Tooltip{}               = True+sameAttribute TrueColor{}             TrueColor{}             = True+sameAttribute Vertices{}              Vertices{}              = True+sameAttribute ViewPort{}              ViewPort{}              = True+sameAttribute VoroMargin{}            VoroMargin{}            = True+sameAttribute Weight{}                Weight{}                = True+sameAttribute Width{}                 Width{}                 = True+sameAttribute Z{}                     Z{}                     = True+sameAttribute (UnknownAttribute a1 _) (UnknownAttribute a2 _) = a1 == a2+sameAttribute _                       _                       = False++-- | Return the default value for a specific 'Attribute' if possible; graph/cluster values are preferred over node/edge values.+defaultAttributeValue                      :: Attribute -> Maybe Attribute+defaultAttributeValue Damping{}            = Just $ Damping 0.99+defaultAttributeValue K{}                  = Just $ K 0.3+defaultAttributeValue URL{}                = Just $ URL ""+defaultAttributeValue ArrowHead{}          = Just $ ArrowHead normal+defaultAttributeValue ArrowSize{}          = Just $ ArrowSize 1+defaultAttributeValue ArrowTail{}          = Just $ ArrowTail normal+defaultAttributeValue BgColor{}            = Just $ BgColor (X11Color Transparent)+defaultAttributeValue Center{}             = Just $ Center False+defaultAttributeValue ClusterRank{}        = Just $ ClusterRank Local+defaultAttributeValue ColorScheme{}        = Just $ ColorScheme X11+defaultAttributeValue Color{}              = Just $ Color [X11Color Black]+defaultAttributeValue Comment{}            = Just $ Comment ""+defaultAttributeValue Compound{}           = Just $ Compound False+defaultAttributeValue Concentrate{}        = Just $ Concentrate False+defaultAttributeValue Constraint{}         = Just $ Constraint True+defaultAttributeValue Decorate{}           = Just $ Decorate False+defaultAttributeValue Dimen{}              = Just $ Dimen 2+defaultAttributeValue Dim{}                = Just $ Dim 2+defaultAttributeValue DirEdgeConstraints{} = Just $ DirEdgeConstraints NoConstraints+defaultAttributeValue Distortion{}         = Just $ Distortion 0+defaultAttributeValue EdgeURL{}            = Just $ EdgeURL ""+defaultAttributeValue ESep{}               = Just $ ESep (DVal 3)+defaultAttributeValue FillColor{}          = Just $ FillColor (X11Color Black)+defaultAttributeValue FixedSize{}          = Just $ FixedSize False+defaultAttributeValue FontColor{}          = Just $ FontColor (X11Color Black)+defaultAttributeValue FontName{}           = Just $ FontName "Times-Roman"+defaultAttributeValue FontNames{}          = Just $ FontNames ""+defaultAttributeValue FontSize{}           = Just $ FontSize 14+defaultAttributeValue Group{}              = Just $ Group ""+defaultAttributeValue HeadURL{}            = Just $ HeadURL ""+defaultAttributeValue HeadClip{}           = Just $ HeadClip True+defaultAttributeValue HeadLabel{}          = Just $ HeadLabel (StrLabel "")+defaultAttributeValue HeadPort{}           = Just $ HeadPort (CompassPoint CenterPoint)+defaultAttributeValue HeadTarget{}         = Just $ HeadTarget ""+defaultAttributeValue HeadTooltip{}        = Just $ HeadTooltip ""+defaultAttributeValue Height{}             = Just $ Height 0.5+defaultAttributeValue ID{}                 = Just $ ID (StrLabel "")+defaultAttributeValue Image{}              = Just $ Image ""+defaultAttributeValue ImageScale{}         = Just $ ImageScale NoScale+defaultAttributeValue LabelURL{}           = Just $ LabelURL ""+defaultAttributeValue LabelAngle{}         = Just $ LabelAngle (-25)+defaultAttributeValue LabelDistance{}      = Just $ LabelDistance 1+defaultAttributeValue LabelFloat{}         = Just $ LabelFloat False+defaultAttributeValue LabelFontColor{}     = Just $ LabelFontColor (X11Color Black)+defaultAttributeValue LabelFontName{}      = Just $ LabelFontName "Times-Roman"+defaultAttributeValue LabelFontSize{}      = Just $ LabelFontSize 14+defaultAttributeValue LabelJust{}          = Just $ LabelJust JCenter+defaultAttributeValue LabelLoc{}           = Just $ LabelLoc VTop+defaultAttributeValue LabelTarget{}        = Just $ LabelTarget ""+defaultAttributeValue LabelTooltip{}       = Just $ LabelTooltip ""+defaultAttributeValue Label{}              = Just $ Label (StrLabel "")+defaultAttributeValue Landscape{}          = Just $ Landscape False+defaultAttributeValue LayerSep{}           = Just $ LayerSep (LSep " :\t")+defaultAttributeValue Layers{}             = Just $ Layers (LL [])+defaultAttributeValue Layout{}             = Just $ Layout ""+defaultAttributeValue LevelsGap{}          = Just $ LevelsGap 0+defaultAttributeValue Levels{}             = Just $ Levels maxBound+defaultAttributeValue LHead{}              = Just $ LHead ""+defaultAttributeValue LTail{}              = Just $ LTail ""+defaultAttributeValue MCLimit{}            = Just $ MCLimit 1+defaultAttributeValue MinDist{}            = Just $ MinDist 1+defaultAttributeValue MinLen{}             = Just $ MinLen 1+defaultAttributeValue Model{}              = Just $ Model ShortPath+defaultAttributeValue Mode{}               = Just $ Mode Major+defaultAttributeValue Mosek{}              = Just $ Mosek False+defaultAttributeValue NodeSep{}            = Just $ NodeSep 0.25+defaultAttributeValue NoJustify{}          = Just $ NoJustify False+defaultAttributeValue Normalize{}          = Just $ Normalize False+defaultAttributeValue Ordering{}           = Just $ Ordering ""+defaultAttributeValue Orientation{}        = Just $ Orientation 0+defaultAttributeValue OutputOrder{}        = Just $ OutputOrder BreadthFirst+defaultAttributeValue OverlapScaling{}     = Just $ OverlapScaling (-4)+defaultAttributeValue Overlap{}            = Just $ Overlap KeepOverlaps+defaultAttributeValue PackMode{}           = Just $ PackMode PackNode+defaultAttributeValue Pack{}               = Just $ Pack DontPack+defaultAttributeValue Pad{}                = Just $ Pad (DVal 0.0555)+defaultAttributeValue PageDir{}            = Just $ PageDir Bl+defaultAttributeValue PenColor{}           = Just $ PenColor (X11Color Black)+defaultAttributeValue PenWidth{}           = Just $ PenWidth 1+defaultAttributeValue Peripheries{}        = Just $ Peripheries 1+defaultAttributeValue Pin{}                = Just $ Pin False+defaultAttributeValue QuadTree{}           = Just $ QuadTree NormalQT+defaultAttributeValue Quantum{}            = Just $ Quantum 0+defaultAttributeValue RankDir{}            = Just $ RankDir FromTop+defaultAttributeValue Regular{}            = Just $ Regular False+defaultAttributeValue ReMinCross{}         = Just $ ReMinCross False+defaultAttributeValue RepulsiveForce{}     = Just $ RepulsiveForce 1+defaultAttributeValue Root{}               = Just $ Root (NodeName "")+defaultAttributeValue Rotate{}             = Just $ Rotate 0+defaultAttributeValue SameHead{}           = Just $ SameHead ""+defaultAttributeValue SameTail{}           = Just $ SameTail ""+defaultAttributeValue SearchSize{}         = Just $ SearchSize 30+defaultAttributeValue Sep{}                = Just $ Sep (DVal 4)+defaultAttributeValue ShapeFile{}          = Just $ ShapeFile ""+defaultAttributeValue Shape{}              = Just $ Shape Ellipse+defaultAttributeValue ShowBoxes{}          = Just $ ShowBoxes 0+defaultAttributeValue Sides{}              = Just $ Sides 4+defaultAttributeValue Skew{}               = Just $ Skew 0+defaultAttributeValue Smoothing{}          = Just $ Smoothing NoSmooth+defaultAttributeValue SortV{}              = Just $ SortV 0+defaultAttributeValue Splines{}            = Just $ Splines SplineEdges+defaultAttributeValue StyleSheet{}         = Just $ StyleSheet ""+defaultAttributeValue TailURL{}            = Just $ TailURL ""+defaultAttributeValue TailClip{}           = Just $ TailClip True+defaultAttributeValue TailLabel{}          = Just $ TailLabel (StrLabel "")+defaultAttributeValue TailPort{}           = Just $ TailPort (CompassPoint CenterPoint)+defaultAttributeValue TailTarget{}         = Just $ TailTarget ""+defaultAttributeValue TailTooltip{}        = Just $ TailTooltip ""+defaultAttributeValue Target{}             = Just $ Target ""+defaultAttributeValue Tooltip{}            = Just $ Tooltip ""+defaultAttributeValue VoroMargin{}         = Just $ VoroMargin 0.05+defaultAttributeValue Width{}              = Just $ Width 0.75+defaultAttributeValue Z{}                  = Just $ Z 0+defaultAttributeValue _                    = Nothing++-- | Determine if the provided 'Text' value is a valid name for an 'UnknownAttribute'.+validUnknown     :: AttributeName -> Bool+validUnknown txt = T.toLower txt `S.notMember` names+                   && isIDString txt+  where+    names = (S.fromList . map T.toLower+             $ [ "Damping"+               , "K"+               , "URL"+               , "href"+               , "arrowhead"+               , "arrowsize"+               , "arrowtail"+               , "aspect"+               , "bb"+               , "bgcolor"+               , "center"+               , "clusterrank"+               , "colorscheme"+               , "color"+               , "comment"+               , "compound"+               , "concentrate"+               , "constraint"+               , "decorate"+               , "defaultdist"+               , "dimen"+               , "dim"+               , "dir"+               , "diredgeconstraints"+               , "distortion"+               , "dpi"+               , "resolution"+               , "edgeURL"+               , "edgehref"+               , "edgetarget"+               , "edgetooltip"+               , "epsilon"+               , "esep"+               , "fillcolor"+               , "fixedsize"+               , "fontcolor"+               , "fontname"+               , "fontnames"+               , "fontpath"+               , "fontsize"+               , "group"+               , "headURL"+               , "headhref"+               , "headclip"+               , "headlabel"+               , "headport"+               , "headtarget"+               , "headtooltip"+               , "height"+               , "id"+               , "image"+               , "imagescale"+               , "labelURL"+               , "labelhref"+               , "labelangle"+               , "labeldistance"+               , "labelfloat"+               , "labelfontcolor"+               , "labelfontname"+               , "labelfontsize"+               , "labeljust"+               , "labelloc"+               , "labeltarget"+               , "labeltooltip"+               , "label"+               , "landscape"+               , "layersep"+               , "layers"+               , "layer"+               , "layout"+               , "len"+               , "levelsgap"+               , "levels"+               , "lhead"+               , "lp"+               , "ltail"+               , "margin"+               , "maxiter"+               , "mclimit"+               , "mindist"+               , "minlen"+               , "model"+               , "mode"+               , "mosek"+               , "nodesep"+               , "nojustify"+               , "normalize"+               , "nslimit1"+               , "nslimit"+               , "ordering"+               , "orientation"+               , "outputorder"+               , "overlap_scaling"+               , "overlap"+               , "packmode"+               , "pack"+               , "pad"+               , "pagedir"+               , "page"+               , "pencolor"+               , "penwidth"+               , "peripheries"+               , "pin"+               , "pos"+               , "quadtree"+               , "quantum"+               , "rankdir"+               , "ranksep"+               , "rank"+               , "ratio"+               , "rects"+               , "regular"+               , "remincross"+               , "repulsiveforce"+               , "root"+               , "rotate"+               , "samehead"+               , "sametail"+               , "samplepoints"+               , "searchsize"+               , "sep"+               , "shapefile"+               , "shape"+               , "showboxes"+               , "sides"+               , "size"+               , "skew"+               , "smoothing"+               , "sortv"+               , "splines"+               , "start"+               , "stylesheet"+               , "style"+               , "tailURL"+               , "tailhref"+               , "tailclip"+               , "taillabel"+               , "tailport"+               , "tailtarget"+               , "tailtooltip"+               , "target"+               , "tooltip"+               , "truecolor"+               , "vertices"+               , "viewport"+               , "voro_margin"+               , "weight"+               , "width"+               , "z"+               , "charset" -- Defined upstream, just not used here.+               ])+            `S.union`+            keywords+{- Delete to here -}++-- -----------------------------------------------------------------------------++{- | If performing any custom pre-/post-processing on Dot code, you+     may wish to utilise some custom 'Attributes'.  These are wrappers+     around the 'UnknownAttribute' constructor (and thus 'CustomAttribute'+     is just an alias for 'Attribute').++     You should ensure that 'validUnknown' is 'True' for any potential+     custom attribute name.++-}+type CustomAttribute = Attribute++-- | Create a custom attribute.+customAttribute :: AttributeName -> Text -> CustomAttribute+customAttribute = UnknownAttribute++-- | Determines whether or not this is a custom attribute.+isCustom                    :: Attribute -> Bool+isCustom UnknownAttribute{} = True+isCustom _                  = False++isSpecifiedCustom :: AttributeName -> Attribute -> Bool+isSpecifiedCustom nm (UnknownAttribute nm' _) = nm == nm'+isSpecifiedCustom _  _                        = False++-- | The value of a custom attribute.  Will throw a+--   'GraphvizException' if the provided 'Attribute' isn't a custom+--   one.+customValue :: CustomAttribute -> Text+customValue (UnknownAttribute _ v) = v+customValue attr                   = throw . NotCustomAttr . T.unpack+                                     $ printIt attr++-- | The name of a custom attribute.  Will throw a+--   'GraphvizException' if the provided 'Attribute' isn't a custom+--   one.+customName :: CustomAttribute -> AttributeName+customName (UnknownAttribute nm _) = nm+customName attr                    = throw . NotCustomAttr . T.unpack+                                      $ printIt attr++-- | Returns all custom attributes and the list of non-custom Attributes.+findCustoms :: Attributes -> ([CustomAttribute], Attributes)+findCustoms = partition isCustom++-- | Find the (first instance of the) specified custom attribute and+--   returns it along with all other Attributes.+findSpecifiedCustom :: AttributeName -> Attributes+                       -> Maybe (CustomAttribute, Attributes)+findSpecifiedCustom nm attrs+  = case break (isSpecifiedCustom nm) attrs of+      (bf,cust:aft) -> Just (cust, bf ++ aft)+      _             -> Nothing++-- | Delete all custom attributes (actually, this will delete all+--   'UnknownAttribute' values; as such it can also be used to remove+--   legacy attributes).+deleteCustomAttributes :: Attributes -> Attributes+deleteCustomAttributes = filter (not . isCustom)++-- | Removes all instances of the specified custom attribute.+deleteSpecifiedCustom :: AttributeName -> Attributes -> Attributes+deleteSpecifiedCustom nm = filter (not . isSpecifiedCustom nm)++-- -----------------------------------------------------------------------------++{- |++   Some 'Attribute's (mainly label-like ones) take a 'String' argument+   that allows for extra escape codes.  This library doesn't do any+   extra checks or special parsing for these escape codes, but usage+   of 'EscString' rather than 'Text' indicates that the Graphviz+   tools will recognise these extra escape codes for these+   'Attribute's.++   The extra escape codes include (note that these are all Strings):++     [@\\N@] Replace with the name of the node (for Node 'Attribute's).++     [@\\G@] Replace with the name of the graph (for Node 'Attribute's)+             or the name of the graph or cluster, whichever is+             applicable (for Graph, Cluster and Edge 'Attribute's).++     [@\\E@] Replace with the name of the edge, formed by the two+             adjoining nodes and the edge type (for Edge 'Attribute's).++     [@\\T@] Replace with the name of the tail node (for Edge+             'Attribute's).++     [@\\H@] Replace with the name of the head node (for Edge+             'Attribute's).++     [@\\L@] Replace with the object's label (for all 'Attribute's).++   Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or+   'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines+   centered, left-justified and right-justified respectively.++ -}+type EscString = Text++-- -----------------------------------------------------------------------------++-- | /Dot/ has a basic grammar of arrow shapes which allows usage of+--   up to 1,544,761 different shapes from 9 different basic+--   'ArrowShape's.  Note that whilst an explicit list is used in the+--   definition of 'ArrowType', there must be at least one tuple and a+--   maximum of 4 (since that is what is required by Dot).  For more+--   information, see: <http://graphviz.org/doc/info/arrows.html>+--+--   The 19 basic arrows shown on the overall attributes page have+--   been defined below as a convenience.  Parsing of the 5+--   backward-compatible special cases is also supported.+newtype ArrowType = AType [(ArrowModifier, ArrowShape)]+    deriving (Eq, Ord, Show, Read)++-- Used for default+normal :: ArrowType+normal = AType [(noMods, Normal)]++-- Used for backward-compatible parsing+eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType++eDiamond = AType [(openMod, Diamond)]+openArr = AType [(noMods, Vee)]+halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]+emptyArr = AType [(openMod, Normal)]+invEmpty = AType [ (noMods, Inv)+                 , (openMod, Normal)]++instance PrintDot ArrowType where+  unqtDot (AType mas) = hcat $ mapM appMod mas+    where+      appMod (m, a) = unqtDot m <> unqtDot a++instance ParseDot ArrowType where+  parseUnqt = specialArrowParse+              `onFail`+              do mas <- many1 $ do m <- parseUnqt+                                   a <- parseUnqt+                                   return (m,a)+                 return $ AType mas++specialArrowParse :: Parse ArrowType+specialArrowParse = stringValue [ ("ediamond", eDiamond)+                                , ("open", openArr)+                                , ("halfopen", halfOpen)+                                , ("empty", emptyArr)+                                , ("invempty", invEmpty)+                                ]++data ArrowShape = Box+                | Crow+                | Diamond+                | DotArrow+                | Inv+                | NoArrow+                | Normal+                | Tee+                | Vee+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ArrowShape where+  unqtDot Box      = unqtText "box"+  unqtDot Crow     = unqtText "crow"+  unqtDot Diamond  = unqtText "diamond"+  unqtDot DotArrow = unqtText "dot"+  unqtDot Inv      = unqtText "inv"+  unqtDot NoArrow  = unqtText "none"+  unqtDot Normal   = unqtText "normal"+  unqtDot Tee      = unqtText "tee"+  unqtDot Vee      = unqtText "vee"++instance ParseDot ArrowShape where+  parseUnqt = stringValue [ ("box", Box)+                          , ("crow", Crow)+                          , ("diamond", Diamond)+                          , ("dot", DotArrow)+                          , ("inv", Inv)+                          , ("none", NoArrow)+                          , ("normal", Normal)+                          , ("tee", Tee)+                          , ("vee", Vee)+                          ]++-- | What modifications to apply to an 'ArrowShape'.+data ArrowModifier = ArrMod { arrowFill :: ArrowFill+                            , arrowSide :: ArrowSide+                            }+                   deriving (Eq, Ord, Show, Read)++-- | Apply no modifications to an 'ArrowShape'.+noMods :: ArrowModifier+noMods = ArrMod FilledArrow BothSides++-- | 'OpenArrow' and 'BothSides'+openMod :: ArrowModifier+openMod = ArrMod OpenArrow BothSides++instance PrintDot ArrowModifier where+  unqtDot (ArrMod f s) = unqtDot f <> unqtDot s++instance ParseDot ArrowModifier where+  parseUnqt = do f <- parseUnqt+                 s <- parseUnqt+                 return $ ArrMod f s++data ArrowFill = OpenArrow+               | FilledArrow+               deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ArrowFill where+  unqtDot OpenArrow   = char 'o'+  unqtDot FilledArrow = empty++instance ParseDot ArrowFill where+  parseUnqt = liftM (bool FilledArrow OpenArrow . isJust)+              $ optional (character 'o')++  -- Not used individually+  parse = parseUnqt++-- | Represents which side (when looking towards the node the arrow is+--   pointing to) is drawn.+data ArrowSide = LeftSide+               | RightSide+               | BothSides+               deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ArrowSide where+  unqtDot LeftSide  = char 'l'+  unqtDot RightSide = char 'r'+  unqtDot BothSides = empty++instance ParseDot ArrowSide where+  parseUnqt = liftM getSideType+              $ optional (oneOf $ map character ['l', 'r'])+    where+      getSideType = maybe BothSides+                          (bool RightSide LeftSide . (==) 'l')++  -- Not used individually+  parse = parseUnqt++-- -----------------------------------------------------------------------------++data AspectType = RatioOnly Double+                | RatioPassCount Double Int+                deriving (Eq, Ord, Show, Read)++instance PrintDot AspectType where+  unqtDot (RatioOnly r)        = unqtDot r+  unqtDot (RatioPassCount r p) = commaDel r p++  toDot at@RatioOnly{}      = unqtDot at+  toDot at@RatioPassCount{} = dquotes $ unqtDot at++instance ParseDot AspectType where+  parseUnqt = liftM (uncurry RatioPassCount) commaSepUnqt+              `onFail`+              liftM RatioOnly parseUnqt+++  parse = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)+          `onFail`+          liftM RatioOnly parse++-- -----------------------------------------------------------------------------++-- | Should only have 2D points (i.e. created with 'createPoint').+data Rect = Rect Point Point+            deriving (Eq, Ord, Show, Read)++instance PrintDot Rect where+  unqtDot (Rect p1 p2) = commaDel p1 p2++  toDot = dquotes . unqtDot++  unqtListToDot = hsep . mapM unqtDot++instance ParseDot Rect where+  parseUnqt = liftM (uncurry Rect) $ commaSep' parsePoint2D parsePoint2D++  parse = quotedParse parseUnqt++  parseUnqtList = sepBy1 parseUnqt whitespace++-- -----------------------------------------------------------------------------++data ClusterMode = Local+                 | Global+                 | NoCluster+                 deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ClusterMode where+  unqtDot Local     = unqtText "local"+  unqtDot Global    = unqtText "global"+  unqtDot NoCluster = unqtText "none"++instance ParseDot ClusterMode where+  parseUnqt = oneOf [ stringRep Local "local"+                    , stringRep Global "global"+                    , stringRep NoCluster "none"+                    ]++-- -----------------------------------------------------------------------------++-- | Specify where to place arrow heads on an edge.+data DirType = Forward -- ^ Draw a directed edge with an arrow to the+                       --   node it's pointing go.+             | Back    -- ^ Draw a reverse directed edge with an arrow+                       --   to the node it's coming from.+             | Both    -- ^ Draw arrows on both ends of the edge.+             | NoDir   -- ^ Draw an undirected edge.+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot DirType where+  unqtDot Forward = unqtText "forward"+  unqtDot Back    = unqtText "back"+  unqtDot Both    = unqtText "both"+  unqtDot NoDir   = unqtText "none"++instance ParseDot DirType where+  parseUnqt = oneOf [ stringRep Forward "forward"+                    , stringRep Back "back"+                    , stringRep Both "both"+                    , stringRep NoDir "none"+                    ]++-- -----------------------------------------------------------------------------++-- | Only when @mode == 'IpSep'@.+data DEConstraints = EdgeConstraints+                   | NoConstraints+                   | HierConstraints+                   deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot DEConstraints where+  unqtDot EdgeConstraints = unqtDot True+  unqtDot NoConstraints   = unqtDot False+  unqtDot HierConstraints = text "hier"++instance ParseDot DEConstraints where+  parseUnqt = liftM (bool NoConstraints EdgeConstraints) parse+              `onFail`+              stringRep HierConstraints "hier"++-- -----------------------------------------------------------------------------++-- | Either a 'Double' or a (2D) 'Point' (i.e. created with+--   'createPoint').+data DPoint = DVal Double+            | PVal Point+            deriving (Eq, Ord, Show, Read)++instance PrintDot DPoint where+  unqtDot (DVal d) = unqtDot d+  unqtDot (PVal p) = unqtDot p++  toDot (DVal d) = toDot d+  toDot (PVal p) = toDot p++instance ParseDot DPoint where+  parseUnqt = liftM PVal parsePoint2D+              `onFail`+              liftM DVal parseUnqt++  parse = quotedParse parseUnqt+          `onFail`+          liftM DVal parseUnqt++-- -----------------------------------------------------------------------------++data ModeType = Major+              | KK+              | Hier+              | IpSep+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ModeType where+  unqtDot Major = text "major"+  unqtDot KK    = text "KK"+  unqtDot Hier  = text "hier"+  unqtDot IpSep = text "ipsep"++instance ParseDot ModeType where+  parseUnqt = oneOf [ stringRep Major "major"+                    , stringRep KK "KK"+                    , stringRep Hier "hier"+                    , stringRep IpSep "ipsep"+                    ]++-- -----------------------------------------------------------------------------++data Model = ShortPath+           | SubSet+           | Circuit+           deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Model where+  unqtDot ShortPath = text "shortpath"+  unqtDot SubSet    = text "subset"+  unqtDot Circuit   = text "circuit"++instance ParseDot Model where+  parseUnqt = oneOf [ stringRep ShortPath "shortpath"+                    , stringRep SubSet "subset"+                    , stringRep Circuit "circuit"+                    ]++-- -----------------------------------------------------------------------------++data Label = StrLabel EscString+           | HtmlLabel HtmlLabel -- ^ If 'PlainText' is used, the+                                 --   'HtmlLabel' value is the entire+                                 --   \"shape\"; if anything else+                                 --   except 'PointShape' is used then+                                 --   the 'HtmlLabel' is embedded+                                 --   within the shape.+           | RecordLabel RecordFields -- ^ For nodes only; requires+                                      --   either 'Record' or+                                      --   'MRecord' as the shape.+           deriving (Eq, Ord, Show, Read)++instance PrintDot Label where+  unqtDot (StrLabel s)     = unqtDot s+  unqtDot (HtmlLabel h)    = angled $ unqtDot h+  unqtDot (RecordLabel fs) = unqtDot fs++  toDot (StrLabel s)     = toDot s+  toDot h@HtmlLabel{}    = unqtDot h+  toDot (RecordLabel fs) = toDot fs++instance ParseDot Label where+  -- Don't have to worry about being able to tell the difference+  -- between an HtmlLabel and a RecordLabel starting with a PortPos,+  -- since the latter will be in quotes and the former won't.++  parseUnqt = oneOf [ liftM HtmlLabel $ parseAngled parseUnqt+                    , liftM RecordLabel parseUnqt+                    , liftM StrLabel parseUnqt+                    ]++  parse = oneOf [ liftM HtmlLabel $ parseAngled parse+                , liftM RecordLabel parse+                , liftM StrLabel parse+                ]++-- -----------------------------------------------------------------------------++-- | A RecordFields value should never be empty.+type RecordFields = [RecordField]++-- | Specifies the sub-values of a record-based label.  By default,+--   the cells are laid out horizontally; use 'FlipFields' to change+--   the orientation of the fields (can be applied recursively).  To+--   change the default orientation, use 'RankDir'.+data RecordField = LabelledTarget PortName EscString+                 | PortName PortName -- ^ Will result in no label for+                                     --   that cell.+                 | FieldLabel EscString+                 | FlipFields RecordFields+                 deriving (Eq, Ord, Show, Read)++instance PrintDot RecordField where+  -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.+  unqtDot (LabelledTarget t s) = printPortName t <+> unqtRecordString s+  unqtDot (PortName t)         = printPortName t+  unqtDot (FieldLabel s)       = unqtRecordString s+  unqtDot (FlipFields rs)      = braces $ unqtDot rs++  toDot (FieldLabel s) = printEscaped recordEscChars s+  toDot rf             = dquotes $ unqtDot rf++  unqtListToDot [f] = unqtDot f+  unqtListToDot fs  = hcat . punctuate (char '|') $ mapM unqtDot fs++  listToDot [f] = toDot f+  listToDot fs  = dquotes $ unqtListToDot fs++instance ParseDot RecordField where+  parseUnqt = do t <- liftM PN $ parseAngled parseRecord+                 ml <- optional (whitespace >> parseRecord)+                 return $ maybe (PortName t)+                                (LabelledTarget t)+                                ml+              `onFail`+              liftM FieldLabel parseRecord+              `onFail`+              liftM FlipFields (parseBraced parseUnqt)++  parse = quotedParse parseUnqt++  parseUnqtList = wrapWhitespace $ sepBy1 parseUnqt (wrapWhitespace $ character '|')++  -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it+  -- will cause parsing problems for other 'Label' types.+  parseList = do rfs <- quotedParse parseUnqtList+                 if validRFs rfs+                   then return rfs+                   else fail "This is a StrLabel, not a RecordLabel"+    where+      validRFs [FieldLabel str] = T.any (`elem` recordEscChars) str+      validRFs _                = True++-- | Print a 'PortName' value as expected within a Record data+--   structure.+printPortName :: PortName -> DotCode+printPortName = angled . unqtRecordString . portName++parseRecord :: Parse Text+parseRecord = parseEscaped False recordEscChars []++unqtRecordString :: Text -> DotCode+unqtRecordString = unqtEscaped recordEscChars++recordEscChars :: [Char]+recordEscChars = ['{', '}', '|', ' ', '<', '>']++-- -----------------------------------------------------------------------------++data Point = Point { xCoord   :: Double+                   , yCoord   :: Double+                      -- | Can only be 'Just' for @'Dim' 3@ or greater.+                   , zCoord   :: Maybe Double+                     -- | Input to Graphviz only: specify that the+                     --   node position should not change.+                   , forcePos :: Bool+                   }+           deriving (Eq, Ord, Show, Read)++-- | Create a point with only @x@ and @y@ values.+createPoint     :: Double -> Double -> Point+createPoint x y = Point x y Nothing False++parsePoint2D :: Parse Point+parsePoint2D = liftM (uncurry createPoint) commaSepUnqt++instance PrintDot Point where+  unqtDot (Point x y mz frs) = bool id (<> char '!') frs+                               . maybe id (\ z -> (<> unqtDot z) . (<> comma)) mz+                               $ commaDel x y++  toDot = dquotes . unqtDot++  unqtListToDot = hsep . mapM unqtDot++  listToDot = dquotes . unqtListToDot++instance ParseDot Point where+  parseUnqt = do (x,y) <- commaSepUnqt+                 mz <- optional $ parseComma >> parseUnqt+                 bng <- liftM isJust . optional $ character '!'+                 return $ Point x y mz bng++  parse = quotedParse parseUnqt++  parseUnqtList = sepBy1 parseUnqt whitespace++-- -----------------------------------------------------------------------------++data Overlap = KeepOverlaps+             | RemoveOverlaps+             | ScaleOverlaps+             | ScaleXYOverlaps+             | PrismOverlap (Maybe Word16) -- ^ Only when sfdp is+                                           --   available, @'Nothing'@+                                           --   is equivalent to+                                           --   @'Just' 1000@.+             | CompressOverlap+             | VpscOverlap+             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@+             deriving (Eq, Ord, Show, Read)++instance PrintDot Overlap where+  unqtDot KeepOverlaps     = unqtDot True+  unqtDot 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 ScaleXYOverlaps "scalexy"+                    , stringRep ScaleOverlaps "scale"+                    , string "prism" >> liftM PrismOverlap (optional parse)+                    , stringRep CompressOverlap "compress"+                    , stringRep VpscOverlap "vpsc"+                    , stringRep IpsepOverlap "ipsep"+                    ]++-- -----------------------------------------------------------------------------++newtype LayerSep = LSep Text+                 deriving (Eq, Ord, Show, Read)++instance PrintDot LayerSep where+  unqtDot (LSep ls) = do setLayerSep $ T.unpack ls+                         unqtDot ls++  toDot (LSep ls) = do setLayerSep $ T.unpack ls+                       toDot ls++instance ParseDot LayerSep where+  parseUnqt = do ls <- parseUnqt+                 setLayerSep $ T.unpack ls+                 return $ LSep ls++  parse = do ls <- parse+             setLayerSep $ T.unpack ls+             return $ LSep ls++data LayerRange = LRID LayerID+                | LRS LayerID LayerID+                deriving (Eq, Ord, Show, Read)++instance PrintDot LayerRange where+  unqtDot (LRID lid)    = unqtDot lid+  unqtDot (LRS id1 id2) = do ls <- getLayerSep+                             let s = unqtDot $ head ls+                             unqtDot id1 <> s <> unqtDot id2++  toDot (LRID lid) = toDot lid+  toDot lrs        = dquotes $ unqtDot lrs++instance ParseDot LayerRange where+  parseUnqt = do id1 <- parseUnqt+                 _   <- parseLayerSep+                 id2 <- parseUnqt+                 return $ LRS id1 id2+              `onFail`+              liftM LRID parseUnqt+++  parse = quotedParse ( do id1 <- parseUnqt+                           _   <- parseLayerSep+                           id2 <- parseUnqt+                           return $ LRS id1 id2+                      )+          `onFail`+          liftM LRID parse++parseLayerSep :: Parse ()+parseLayerSep = do ls <- getLayerSep+                   many1Satisfy (`elem` ls)+                   return ()++parseLayerName :: Parse Text+parseLayerName = parseEscaped False [] =<< getLayerSep++parseLayerName' :: Parse Text+parseLayerName' = stringBlock+                  `onFail`+                  quotedParse parseLayerName++-- | You should not have any layer separator characters for the+--   'LRName' option, as they won't be parseable.+data LayerID = AllLayers+             | LRInt Int+             | LRName Text -- ^ Should not be a number of @"all"@.+             deriving (Eq, Ord, Show, Read)++instance PrintDot LayerID where+  unqtDot AllLayers   = text "all"+  unqtDot (LRInt n)   = unqtDot n+  unqtDot (LRName nm) = unqtDot nm++  toDot (LRName nm) = toDot nm+  -- Other two don't need quotes+  toDot li          = unqtDot li++  unqtListToDot ll = do ls <- getLayerSep+                        let s = unqtDot $ head ls+                        hcat . punctuate s $ mapM unqtDot ll++  listToDot [l] = toDot l+  -- Might not need quotes, but probably will.  Can't tell either+  -- way since we don't know what the separator character will be.+  listToDot ll  = dquotes $ unqtDot ll++instance ParseDot LayerID where+  parseUnqt = liftM checkLayerName parseLayerName -- tests for Int and All++  parse = oneOf [ liftM checkLayerName parseLayerName'+                , liftM LRInt parse -- Mainly for unquoted case.+                ]++checkLayerName     :: Text -> LayerID+checkLayerName str = maybe checkAll LRInt $ stringToInt str+  where+    checkAll = if T.toLower str == "all"+               then AllLayers+               else LRName str++-- | A list of layer names.  The names should all be 'LRName' values,+--   and when printed will use an arbitrary character from+--   'defLayerSep'.+newtype LayerList = LL [LayerID]+                  deriving (Eq, Ord, Show, Read)++instance PrintDot LayerList where+  unqtDot (LL ll) = unqtDot ll++  toDot (LL ll) = toDot ll++instance ParseDot LayerList where+  parseUnqt = liftM LL $ sepBy1 parseUnqt parseLayerSep++  parse = quotedParse parseUnqt+          `onFail`+          liftM (LL . (:[]) . LRName) stringBlock+          `onFail`+          quotedParse (stringRep (LL []) "")++-- -----------------------------------------------------------------------------++data OutputMode = BreadthFirst | NodesFirst | EdgesFirst+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot OutputMode where+  unqtDot BreadthFirst = text "breadthfirst"+  unqtDot NodesFirst   = text "nodesfirst"+  unqtDot EdgesFirst   = text "edgesfirst"++instance ParseDot OutputMode where+  parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"+                    , stringRep NodesFirst "nodesfirst"+                    , stringRep EdgesFirst "edgesfirst"+                    ]++-- -----------------------------------------------------------------------------++data Pack = DoPack+          | DontPack+          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.+          deriving (Eq, Ord, Show, Read)++instance PrintDot Pack where+  unqtDot DoPack         = unqtDot True+  unqtDot DontPack       = unqtDot False+  unqtDot (PackMargin m) = unqtDot m++instance ParseDot Pack where+  -- What happens if it parses 0?  It's non-negative, but parses as False+  parseUnqt = oneOf [ liftM PackMargin parseUnqt+                    , liftM (bool DontPack DoPack) onlyBool+                    ]++-- -----------------------------------------------------------------------------++data PackMode = PackNode+              | PackClust+              | PackGraph+              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort+                                                -- by user, number of+                                                -- rows/cols+              deriving (Eq, Ord, Show, Read)++instance PrintDot PackMode where+  unqtDot PackNode           = text "node"+  unqtDot PackClust          = text "clust"+  unqtDot PackGraph          = text "graph"+  unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder+                               $ text "array"+    where+      addNum = maybe id (flip (<>) . unqtDot) mi+      isUnder = if c || u+                then flip (<>) $ char '_'+                else id+      isC = if c+            then flip (<>) $ char 'c'+            else id+      isU = if u+            then flip (<>) $ char 'u'+            else id++instance ParseDot PackMode where+  parseUnqt = oneOf [ stringRep PackNode "node"+                    , stringRep PackClust "clust"+                    , stringRep PackGraph "graph"+                    , do string "array"+                         mcu <- optional $ do character '_'+                                              many1 $ satisfy isCU+                         let c = hasCharacter mcu 'c'+                             u = hasCharacter mcu 'u'+                         mi <- optional parseUnqt+                         return $ PackArray c u mi+                    ]+    where+      hasCharacter ms c = maybe False (elem c) ms+      -- Also checks and removes quote characters+      isCU = flip elem ['c', 'u']++-- -----------------------------------------------------------------------------++data Pos = PointPos Point+         | SplinePos [Spline]+         deriving (Eq, Ord, Show, Read)++instance PrintDot Pos where+  unqtDot (PointPos p)   = unqtDot p+  unqtDot (SplinePos ss) = unqtDot ss++  toDot (PointPos p)   = toDot p+  toDot (SplinePos ss) = toDot ss++instance ParseDot Pos where+  -- Have to be careful with this: if we try to parse points first,+  -- then a spline with no start and end points will erroneously get+  -- parsed as a point and then the parser will crash as it expects a+  -- closing quote character...+  parseUnqt = do splns <- parseUnqt+                 case splns of+                   [Spline Nothing Nothing [p]] -> return $ PointPos p+                   _                            -> return $ SplinePos splns++  parse = quotedParse parseUnqt++-- -----------------------------------------------------------------------------++-- | Controls how (and if) edges are represented.+data EdgeType = SplineEdges+              | LineEdges+              | NoEdges+              | PolyLine+              | CompoundEdge -- ^ fdp only+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot EdgeType where+  unqtDot SplineEdges  = toDot True+  unqtDot LineEdges    = toDot False+  unqtDot NoEdges      = empty+  unqtDot PolyLine     = text "polyline"+  unqtDot CompoundEdge = text "compound"++  toDot NoEdges = dquotes empty+  toDot et      = unqtDot et++instance ParseDot EdgeType where+  -- Can't parse NoEdges without quotes.+  parseUnqt = oneOf [ liftM (bool LineEdges SplineEdges) parse+                    , stringRep SplineEdges "spline"+                    , stringRep LineEdges "line"+                    , stringRep PolyLine "polyline"+                    , stringRep CompoundEdge "compound"+                    ]++  parse = stringRep NoEdges "\"\""+          `onFail`+          optionalQuoted parseUnqt++-- -----------------------------------------------------------------------------++-- | Upper-case first character is major order;+--   lower-case second character is minor order.+data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot PageDir where+  unqtDot Bl = text "BL"+  unqtDot Br = text "BR"+  unqtDot Tl = text "TL"+  unqtDot Tr = text "TR"+  unqtDot Rb = text "RB"+  unqtDot Rt = text "RT"+  unqtDot Lb = text "LB"+  unqtDot Lt = text "LT"++instance ParseDot PageDir where+  parseUnqt = stringValue [ ("BL", Bl)+                          , ("BR", Br)+                          , ("TL", Tl)+                          , ("TR", Tr)+                          , ("RB", Rb)+                          , ("RT", Rt)+                          , ("LB", Lb)+                          , ("LT", Lt)+                          ]++-- -----------------------------------------------------------------------------++-- | The number of points in the list must be equivalent to 1 mod 3;+--   note that this is not checked.+data Spline = Spline (Maybe Point) (Maybe Point) [Point]+            deriving (Eq, Ord, Show, Read)++instance PrintDot Spline where+  unqtDot (Spline ms me ps) = addS . addE+                             . hsep+                             $ mapM unqtDot ps+    where+      addP t = maybe id ((<+>) . commaDel t)+      addS = addP 's' ms+      addE = addP 'e' me++  toDot = dquotes . unqtDot++  unqtListToDot = hcat . punctuate semi . mapM unqtDot++  listToDot = dquotes . unqtListToDot++instance ParseDot Spline where+  parseUnqt = do ms <- parseP 's'+                 me <- parseP 'e'+                 ps <- sepBy1 parseUnqt whitespace+                 return $ Spline ms me ps+      where+        parseP t = optional $ do character t+                                 parseComma+                                 parseUnqt `discard` whitespace++  parse = quotedParse parseUnqt++  parseUnqtList = sepBy1 parseUnqt (character ';')++-- -----------------------------------------------------------------------------++data QuadType = NormalQT+              | FastQT+              | NoQT+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot QuadType where+  unqtDot NormalQT = text "normal"+  unqtDot FastQT   = text "fast"+  unqtDot NoQT     = text "none"++instance ParseDot QuadType where+  -- Have to take into account the slightly different interpretation+  -- of Bool used as an option for parsing QuadType+  parseUnqt = oneOf [ stringRep NormalQT "normal"+                    , stringRep FastQT "fast"+                    , stringRep NoQT "none"+                    , character '2'   >> return FastQT -- weird bool+                    , liftM (bool NoQT NormalQT) parse+                    ]++-- -----------------------------------------------------------------------------++-- | Specify the root node either as a Node attribute or a Graph attribute.+data Root = IsCentral     -- ^ For Nodes only+          | NotCentral    -- ^ For Nodes only+          | NodeName Text -- ^ For Graphs only+          deriving (Eq, Ord, Show, Read)++instance PrintDot Root where+  unqtDot IsCentral    = unqtDot True+  unqtDot NotCentral   = unqtDot False+  unqtDot (NodeName n) = unqtDot n++  toDot (NodeName n) = toDot n+  toDot r            = unqtDot r++instance ParseDot Root where+  parseUnqt = liftM (bool NotCentral IsCentral) onlyBool+              `onFail`+              liftM NodeName parseUnqt++  parse = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool)+          `onFail`+          liftM NodeName parse++-- -----------------------------------------------------------------------------++data RankType = SameRank+              | MinRank+              | SourceRank+              | MaxRank+              | SinkRank+              deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot RankType where+  unqtDot SameRank   = text "same"+  unqtDot MinRank    = text "min"+  unqtDot SourceRank = text "source"+  unqtDot MaxRank    = text "max"+  unqtDot SinkRank   = text "sink"++instance ParseDot RankType where+  parseUnqt = stringValue [ ("same", SameRank)+                          , ("min", MinRank)+                          , ("source", SourceRank)+                          , ("max", MaxRank)+                          , ("sink", SinkRank)+                          ]++-- -----------------------------------------------------------------------------++data RankDir = FromTop+             | FromLeft+             | FromBottom+             | FromRight+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot RankDir where+  unqtDot FromTop    = text "TB"+  unqtDot FromLeft   = text "LR"+  unqtDot FromBottom = text "BT"+  unqtDot FromRight  = text "RL"++instance ParseDot RankDir where+  parseUnqt = oneOf [ stringRep FromTop "TB"+                    , stringRep FromLeft "LR"+                    , stringRep FromBottom "BT"+                    , stringRep FromRight "RL"+                    ]++-- -----------------------------------------------------------------------------++data Shape+    = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.+    | Polygon+    | Ellipse+    | Circle+    | PointShape+    | Egg+    | Triangle+    | PlainText -- ^ Has synonym of /none/.+    | DiamondShape+    | Trapezium+    | Parallelogram+    | House+    | Pentagon+    | Hexagon+    | Septagon+    | Octagon+    | DoubleCircle+    | DoubleOctagon+    | TripleOctagon+    | InvTriangle+    | InvTrapezium+    | InvHouse+    | MDiamond+    | MSquare+    | MCircle+    | Note+    | Tab+    | Folder+    | Box3D+    | Component+    | Record -- ^ Must specify the record shape with a 'Label'.+    | MRecord -- ^ Must specify the record shape with a 'Label'.+    deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Shape where+  unqtDot BoxShape      = text "box"+  unqtDot Polygon       = text "polygon"+  unqtDot Ellipse       = text "ellipse"+  unqtDot Circle        = text "circle"+  unqtDot PointShape    = text "point"+  unqtDot Egg           = text "egg"+  unqtDot Triangle      = text "triangle"+  unqtDot PlainText     = text "plaintext"+  unqtDot DiamondShape  = text "diamond"+  unqtDot Trapezium     = text "trapezium"+  unqtDot Parallelogram = text "parallelogram"+  unqtDot House         = text "house"+  unqtDot Pentagon      = text "pentagon"+  unqtDot Hexagon       = text "hexagon"+  unqtDot Septagon      = text "septagon"+  unqtDot Octagon       = text "octagon"+  unqtDot DoubleCircle  = text "doublecircle"+  unqtDot DoubleOctagon = text "doubleoctagon"+  unqtDot TripleOctagon = text "tripleoctagon"+  unqtDot InvTriangle   = text "invtriangle"+  unqtDot InvTrapezium  = text "invtrapezium"+  unqtDot InvHouse      = text "invhouse"+  unqtDot MDiamond      = text "Mdiamond"+  unqtDot MSquare       = text "Msquare"+  unqtDot MCircle       = text "Mcircle"+  unqtDot Note          = text "note"+  unqtDot Tab           = text "tab"+  unqtDot Folder        = text "folder"+  unqtDot Box3D         = text "box3d"+  unqtDot Component     = text "component"+  unqtDot Record        = text "record"+  unqtDot MRecord       = text "Mrecord"++instance ParseDot Shape where+  parseUnqt = stringValue [ ("box3d", Box3D)+                          , ("box", BoxShape)+                          , ("rectangle", BoxShape)+                          , ("rect", BoxShape)+                          , ("polygon", Polygon)+                          , ("ellipse", Ellipse)+                          , ("circle", Circle)+                          , ("point", PointShape)+                          , ("egg", Egg)+                          , ("triangle", Triangle)+                          , ("plaintext", PlainText)+                          , ("none", PlainText)+                          , ("diamond", DiamondShape)+                          , ("trapezium", Trapezium)+                          , ("parallelogram", Parallelogram)+                          , ("house", House)+                          , ("pentagon", Pentagon)+                          , ("hexagon", Hexagon)+                          , ("septagon", Septagon)+                          , ("octagon", Octagon)+                          , ("doublecircle", DoubleCircle)+                          , ("doubleoctagon", DoubleOctagon)+                          , ("tripleoctagon", TripleOctagon)+                          , ("invtriangle", InvTriangle)+                          , ("invtrapezium", InvTrapezium)+                          , ("invhouse", InvHouse)+                          , ("Mdiamond", MDiamond)+                          , ("Msquare", MSquare)+                          , ("Mcircle", MCircle)+                          , ("note", Note)+                          , ("tab", Tab)+                          , ("folder", Folder)+                          , ("component", Component)+                          , ("record", Record)+                          , ("Mrecord", MRecord)+                          ]++-- -----------------------------------------------------------------------------++data SmoothType = NoSmooth+                | AvgDist+                | GraphDist+                | PowerDist+                | RNG+                | Spring+                | TriangleSmooth+                deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot SmoothType where+  unqtDot NoSmooth       = text "none"+  unqtDot AvgDist        = text "avg_dist"+  unqtDot GraphDist      = text "graph_dist"+  unqtDot PowerDist      = text "power_dist"+  unqtDot RNG            = text "rng"+  unqtDot Spring         = text "spring"+  unqtDot TriangleSmooth = text "triangle"++instance ParseDot SmoothType where+  parseUnqt = oneOf [ stringRep NoSmooth "none"+                    , stringRep AvgDist "avg_dist"+                    , stringRep GraphDist "graph_dist"+                    , stringRep PowerDist "power_dist"+                    , stringRep RNG "rng"+                    , stringRep Spring "spring"+                    , stringRep TriangleSmooth "triangle"+                    ]++-- -----------------------------------------------------------------------------++data StartType = StartStyle STStyle+               | StartSeed Int+               | StartStyleSeed STStyle Int+               deriving (Eq, Ord, Show, Read)++instance PrintDot StartType where+  unqtDot (StartStyle ss)       = unqtDot ss+  unqtDot (StartSeed s)         = unqtDot s+  unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s++instance ParseDot StartType where+  parseUnqt = oneOf [ do ss <- parseUnqt+                         s  <- parseUnqt+                         return $ StartStyleSeed ss s+                    , liftM StartStyle parseUnqt+                    , liftM StartSeed parseUnqt+                    ]++data STStyle = RegularStyle+             | SelfStyle+             | RandomStyle+             deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot STStyle where+  unqtDot RegularStyle = text "regular"+  unqtDot SelfStyle    = text "self"+  unqtDot RandomStyle  = text "random"++instance ParseDot STStyle where+  parseUnqt = oneOf [ stringRep RegularStyle "regular"+                    , stringRep SelfStyle "self"+                    , stringRep RandomStyle "random"+                    ]++-- -----------------------------------------------------------------------------++-- | An individual style item.  Except for 'DD', the @['String']@+--   should be empty.+data StyleItem = SItem StyleName [Text]+               deriving (Eq, Ord, Show, Read)++instance PrintDot StyleItem where+  unqtDot (SItem nm args)+    | null args = dnm+    | otherwise = dnm <> parens args'+    where+      dnm = unqtDot nm+      args' = hcat . punctuate comma $ mapM unqtDot args++  toDot si@(SItem nm args)+    | null args = toDot nm+    | otherwise = dquotes $ unqtDot si++  unqtListToDot = hcat . punctuate comma . mapM unqtDot++  listToDot [SItem nm []] = toDot nm+  listToDot sis           = dquotes $ unqtListToDot sis++instance ParseDot StyleItem where+  parseUnqt = do nm <- parseUnqt+                 args <- tryParseList' parseArgs+                 return $ SItem nm args++  parse = quotedParse (liftM2 SItem parseUnqt parseArgs)+          `onFail`+          liftM (flip SItem []) parse++  parseUnqtList = sepBy1 parseUnqt parseComma++  parseList = quotedParse parseUnqtList+              `onFail`+              -- Might not necessarily need to be quoted if a singleton...+              liftM return parse++parseArgs :: Parse [Text]+parseArgs = bracketSep (character '(')+                       parseComma+                       (character ')')+                       parseStyleName++data StyleName = Dashed    -- ^ Nodes and Edges+               | Dotted    -- ^ Nodes and Edges+               | Solid     -- ^ Nodes and Edges+               | Bold      -- ^ Nodes and Edges+               | Invisible -- ^ Nodes and Edges+               | Filled    -- ^ Nodes and Clusters+               | Diagonals -- ^ Nodes only+               | Rounded   -- ^ Nodes and Clusters+               | DD Text   -- ^ Device Dependent+               deriving (Eq, Ord, Show, Read)++instance PrintDot StyleName where+  unqtDot Dashed    = text "dashed"+  unqtDot Dotted    = text "dotted"+  unqtDot Solid     = text "solid"+  unqtDot Bold      = text "bold"+  unqtDot Invisible = text "invis"+  unqtDot Filled    = text "filled"+  unqtDot Diagonals = text "diagonals"+  unqtDot Rounded   = text "rounded"+  unqtDot (DD nm)   = unqtDot nm++  toDot (DD nm) = toDot nm+  toDot sn      = unqtDot sn++instance ParseDot StyleName where+  parseUnqt = liftM checkDD parseStyleName++  parse = quotedParse parseUnqt+          `onFail`+          liftM checkDD quotelessString++checkDD     :: Text -> StyleName+checkDD str = case T.toLower str of+                "dashed"    -> Dashed+                "dotted"    -> Dotted+                "solid"     -> Solid+                "bold"      -> Bold+                "invis"     -> Invisible+                "filled"    -> Filled+                "diagonals" -> Diagonals+                "rounded"   -> Rounded+                _           -> DD str++parseStyleName :: Parse Text+parseStyleName = do f <- orEscaped . noneOf $ ' ' : disallowedChars+                    r <- parseEscaped True [] disallowedChars+                    return $ f `T.cons` r+  where+    disallowedChars = [quoteChar, '(', ')', ',']+    -- Used because the first character has slightly stricter requirements than the rest.+    orSlash p = stringRep '\\' "\\\\" `onFail` p+    orEscaped = orQuote . orSlash++-- -----------------------------------------------------------------------------++data ViewPort = VP { wVal  :: Double+                   , hVal  :: Double+                   , zVal  :: Double+                   , focus :: Maybe FocusType+                   }+              deriving (Eq, Ord, Show, Read)++instance PrintDot ViewPort where+  unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)+               $ focus vp+    where+      vs = hcat . punctuate comma+           $ mapM (unqtDot . flip ($) vp) [wVal, hVal, zVal]++  toDot = dquotes . unqtDot++instance ParseDot ViewPort where+  parseUnqt = do wv <- parseUnqt+                 parseComma+                 hv <- parseUnqt+                 parseComma+                 zv <- parseUnqt+                 mf <- optional $ parseComma >> parseUnqt+                 return $ VP wv hv zv mf++  parse = quotedParse parseUnqt++-- | For use with 'ViewPort'.+data FocusType = XY Point+               | NodeFocus Text+               deriving (Eq, Ord, Show, Read)++instance PrintDot FocusType where+  unqtDot (XY p)         = unqtDot p+  unqtDot (NodeFocus nm) = unqtDot nm++  toDot (XY p)         = toDot p+  toDot (NodeFocus nm) = toDot nm++instance ParseDot FocusType where+  parseUnqt = liftM XY parseUnqt+              `onFail`+              liftM NodeFocus parseUnqt++  parse = liftM XY parse+          `onFail`+          liftM NodeFocus parse++-- -----------------------------------------------------------------------------++data VerticalPlacement = VTop+                       | VCenter -- ^ Only valid for Nodes.+                       | VBottom+                       deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot VerticalPlacement where+  unqtDot VTop    = char 't'+  unqtDot VCenter = char 'c'+  unqtDot VBottom = char 'b'++instance ParseDot VerticalPlacement where+  parseUnqt = oneOf [ stringRep VTop "t"+                    , stringRep VCenter "c"+                    , stringRep VBottom "b"+                    ]++-- -----------------------------------------------------------------------------++data ScaleType = UniformScale+               | NoScale+               | FillWidth+               | FillHeight+               | FillBoth+               deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot ScaleType where+  unqtDot UniformScale = unqtDot True+  unqtDot NoScale      = unqtDot False+  unqtDot FillWidth    = text "width"+  unqtDot FillHeight   = text "height"+  unqtDot FillBoth     = text "both"++instance ParseDot ScaleType where+  parseUnqt = oneOf [ stringRep UniformScale "true"+                    , stringRep NoScale "false"+                    , stringRep FillWidth "width"+                    , stringRep FillHeight "height"+                    , stringRep FillBoth "both"+                    ]++-- -----------------------------------------------------------------------------++data Justification = JLeft+                   | JRight+                   | JCenter+                   deriving (Eq, Ord, Bounded, Enum, Show, Read)++instance PrintDot Justification where+  unqtDot JLeft   = char 'l'+  unqtDot JRight  = char 'r'+  unqtDot JCenter = char 'c'++instance ParseDot Justification where+  parseUnqt = oneOf [ stringRep JLeft "l"+                    , stringRep JRight "r"+                    , stringRep JCenter "c"+                    ]++-- -----------------------------------------------------------------------------++data Ratios = AspectRatio Double+            | FillRatio+            | CompressRatio+            | ExpandRatio+            | AutoRatio+            deriving (Eq, Ord, Show, Read)++instance PrintDot Ratios where+  unqtDot (AspectRatio r) = unqtDot r+  unqtDot FillRatio       = text "fill"+  unqtDot CompressRatio   = text "compress"+  unqtDot ExpandRatio     = text "expand"+  unqtDot AutoRatio       = text "auto"++instance ParseDot Ratios where+  parseUnqt = oneOf [ liftM AspectRatio parseUnqt+                    , stringRep FillRatio "fill"+                    , stringRep CompressRatio "compress"+                    , stringRep ExpandRatio "expand"+                    , stringRep AutoRatio "auto"+                    ]
Data/GraphViz/Attributes/HTML.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings, PatternGuards #-}+ {- |    Module      : Data.GraphViz.Attributes.HTML    Description : Specification of HTML-like types for Graphviz.@@ -72,11 +74,13 @@ import Numeric(readHex) import Data.Char(chr, ord, isSpace) import Data.Function(on)-import Data.List(groupBy, delete)-import Data.Maybe(maybeToList, listToMaybe)+import Data.List(delete)+import Data.Maybe(catMaybes, listToMaybe) import Data.Word(Word8, Word16) import qualified Data.Map as Map-import Control.Monad(liftM)+import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)+import Control.Monad(liftM, liftM2)  -- ----------------------------------------------------------------------------- @@ -114,7 +118,7 @@ type HtmlText = [HtmlTextItem]  -- | Textual items in HTML-like labels.-data HtmlTextItem = HtmlStr String+data HtmlTextItem = HtmlStr Text                     -- | Only accepts an optional 'HtmlAlign'                     --   'HtmlAttribute'; defined this way for ease of                     --   printing/parsing.@@ -127,7 +131,7 @@   unqtDot (HtmlNewline as)  = printHtmlEmptyTag (text "BR") as   unqtDot (HtmlFont as txt) = printHtmlFontTag as $ unqtDot txt -  unqtListToDot = hcat . map unqtDot+  unqtListToDot = hcat . mapM unqtDot    listToDot = unqtListToDot @@ -190,7 +194,7 @@     where       tr = text "TR" -  unqtListToDot = hcat . map unqtDot+  unqtListToDot = align . cat . mapM unqtDot    listToDot = unqtListToDot @@ -217,7 +221,7 @@   unqtDot (HtmlLabelCell as l) = printCell as $ unqtDot l   unqtDot (HtmlImgCell as img) = printCell as $ unqtDot img -  unqtListToDot = hsep . map unqtDot+  unqtListToDot = hsep . mapM unqtDot    listToDot = unqtListToDot @@ -269,17 +273,17 @@                    | HtmlCellSpacing Word8 -- ^ Valid for: 'HtmlTable', 'HtmlCell'.  Default is @2@; maximum is @127@.                    | HtmlColor Color       -- ^ Valid for: 'HtmlTable', 'HtmlCell'.                    | HtmlColSpan Word16    -- ^ Valid for: 'HtmlCell'.  Default is @1@.-                   | HtmlFace String       -- ^ Valid for: 'tableFontAttrs', 'HtmlFont'.+                   | HtmlFace Text       -- ^ Valid for: 'tableFontAttrs', 'HtmlFont'.                    | HtmlFixedSize Bool    -- ^ Valid for: 'HtmlTable', 'HtmlCell'.  Default is @'False'@.                    | HtmlHeight Word16     -- ^ Valid for: 'HtmlTable', 'HtmlCell'.-                   | HtmlHRef String       -- ^ Valid for: 'HtmlTable', 'HtmlCell'.+                   | HtmlHRef Text       -- ^ Valid for: 'HtmlTable', 'HtmlCell'.                    | HtmlPointSize Double  -- ^ Valid for: 'tableFontAttrs', 'HtmlFont'.                    | HtmlPort PortName     -- ^ Valid for: 'HtmlTable', 'HtmlCell'.                    | HtmlRowSpan Word16    -- ^ Valid for: 'HtmlCell'.                    | HtmlScale HtmlScale   -- ^ Valid for: 'HtmlImg'.                    | HtmlSrc FilePath      -- ^ Valid for: 'HtmlImg'.-                   | HtmlTarget String     -- ^ Valid for: 'HtmlTable', 'HtmlCell'.-                   | HtmlTitle String      -- ^ Valid for: 'HtmlTable', 'HtmlCell'.  Has an alias of @TOOLTIP@.+                   | HtmlTarget Text     -- ^ Valid for: 'HtmlTable', 'HtmlCell'.+                   | HtmlTitle Text      -- ^ Valid for: 'HtmlTable', 'HtmlCell'.  Has an alias of @TOOLTIP@.                    | HtmlVAlign HtmlVAlign -- ^ Valid for: 'HtmlTable', 'HtmlCell'.                    | HtmlWidth Word16      -- ^ Valid for: 'HtmlTable', 'HtmlCell'.                    deriving (Eq, Ord, Show, Read)@@ -302,24 +306,24 @@   unqtDot (HtmlPort v)        = printHtmlField' "PORT" . escapeAttribute $ portName v   unqtDot (HtmlRowSpan v)     = printHtmlField  "ROWSPAN" v   unqtDot (HtmlScale v)       = printHtmlField  "SCALE" v-  unqtDot (HtmlSrc v)         = printHtmlField' "SRC" $ escapeAttribute v+  unqtDot (HtmlSrc v)         = printHtmlField' "SRC" . escapeAttribute $ T.pack v   unqtDot (HtmlTarget v)      = printHtmlField' "TARGET" $ escapeAttribute v   unqtDot (HtmlTitle v)       = printHtmlField' "TITLE" $ escapeAttribute v   unqtDot (HtmlVAlign v)      = printHtmlField  "VALIGN" v   unqtDot (HtmlWidth v)       = printHtmlField  "WIDTH" v -  unqtListToDot = hsep . map unqtDot+  unqtListToDot = hsep . mapM unqtDot    listToDot = unqtListToDot  -- | Only to be used when the 'PrintDot' instance of @a@ matches the --   HTML syntax (i.e. numbers and @Html*@ values; 'Color' values also --   seem to work).-printHtmlField   :: (PrintDot a) => String -> a -> DotCode+printHtmlField   :: (PrintDot a) => Text -> a -> DotCode printHtmlField f = printHtmlField' f . unqtDot -printHtmlField'     :: String -> DotCode -> DotCode-printHtmlField' f v = text f <> equals <> doubleQuotes v+printHtmlField'     :: Text -> DotCode -> DotCode+printHtmlField' f v = text f <> equals <> dquotes v  instance ParseDot HtmlAttribute where   parseUnqt = oneOf [ parseHtmlField  HtmlAlign "ALIGN"@@ -339,7 +343,7 @@                     , parseHtmlField' (HtmlPort . PN) "PORT" unescapeAttribute                     , parseHtmlField  HtmlRowSpan "ROWSPAN"                     , parseHtmlField  HtmlScale "SCALE"-                    , parseHtmlField' HtmlSrc "SRC" unescapeAttribute+                    , parseHtmlField' HtmlSrc "SRC" $ liftM T.unpack unescapeAttribute                     , parseHtmlField' HtmlTarget "TARGET" unescapeAttribute                     , parseHtmlField' HtmlTitle "TITLE" unescapeAttribute                       `onFail`@@ -444,22 +448,22 @@  -- ----------------------------------------------------------------------------- -escapeAttribute :: String -> DotCode+escapeAttribute :: Text -> DotCode escapeAttribute = escapeHtml False -escapeValue :: String -> DotCode+escapeValue :: Text -> DotCode escapeValue = escapeHtml True -escapeHtml               :: Bool -> String -> DotCode-escapeHtml quotesAllowed = hcat-                           . concatMap escapeSegment-                           . groupBy ((==) `on` isSpace)+escapeHtml               :: Bool -> Text -> DotCode+escapeHtml quotesAllowed = hcat . liftM concat+                           . mapM (escapeSegment . T.unpack)+                           . T.groupBy ((==) `on` isSpace)   where     -- Note: use numeric version of space rather than nbsp, since this     -- matches what Graphviz does (since Inkscape apparently can't     -- cope with nbsp).-    escapeSegment (s:sps) | isSpace s = char s : map numEscape sps-    escapeSegment txt                 = map xmlChar txt+    escapeSegment (s:sps) | isSpace s = liftM2 (:) (char s) $ mapM numEscape sps+    escapeSegment txt                 = mapM xmlChar txt      allowQuotes = if quotesAllowed                   then Map.delete '"'@@ -472,30 +476,32 @@     escape' e = char '&' <> e <> char ';'     escape = escape' . text -unescapeAttribute :: Parse String+unescapeAttribute :: Parse Text unescapeAttribute = unescapeHtml False -unescapeValue :: Parse String+unescapeValue :: Parse Text unescapeValue = unescapeHtml True  -- | Parses an HTML-compatible 'String', de-escaping known characters. --   Note: this /will/ fail if an unknown non-numeric HTML-escape is --   used.-unescapeHtml               :: Bool -> Parse String-unescapeHtml quotesAllowed = liftM concat+unescapeHtml               :: Bool -> Parse Text+unescapeHtml quotesAllowed = liftM (T.pack . catMaybes)                              . many1 . oneOf $ [ parseEscpd                                                , validChars                                                ]   where+    parseEscpd :: Parse (Maybe Char)     parseEscpd = do character '&'-                    esc <- many1 $ satisfy (';' /=)+                    esc <- many1Satisfy (';' /=)                     character ';'-                    let c = case esc of-                              ('#':'x':hex) -> readMaybe readHex hex-                              ('#':'X':hex) -> readMaybe readHex hex-                              ('#':dec)     -> readMaybe readInt dec-                              _             -> esc `Map.lookup` escMap-                    return $ maybeToList c+                    let c = case T.uncons $ T.toLower esc of+                              Just ('#',dec) | Just ('x',hex) <- T.uncons dec+                                               -> readMaybe readHex $ T.unpack hex+                                             | otherwise+                                               -> readMaybe readInt $ T.unpack dec+                              _                -> esc `Map.lookup` escMap+                    return c      readMaybe f str = do (n, []) <- listToMaybe $ f str                          return $ chr n@@ -508,12 +514,12 @@      escMap = Map.fromList htmlUnescapes -    validChars = liftM return $ satisfy (`notElem` needEscaping)+    validChars = liftM Just $ satisfy (`notElem` needEscaping)     needEscaping = allowQuotes $ map fst htmlEscapes  -- | The characters that need to be escaped and what they need to be --   replaced with (sans @'&'@).-htmlEscapes :: [(Char, String)]+htmlEscapes :: [(Char, Text)] htmlEscapes = [ ('"', "quot")               , ('<', "lt")               , ('>', "gt")@@ -521,12 +527,12 @@               ]               ++ map numEscape ['-', '\'']   where-    numEscape c = (c, '#' : show (ord c))+    numEscape c = (c, T.pack $ '#' : show (ord c))  -- | Flip the order and add extra values that might be escaped.  More --   specifically, provide the escape code for spaces (@\"nbsp\"@) and --   apostrophes (@\"apos\"@) since they aren't used for escaping.-htmlUnescapes :: [(String, Char)]+htmlUnescapes :: [(Text, Char)] htmlUnescapes = maybeEscaped                 ++                 map (uncurry (flip (,))) htmlEscapes
Data/GraphViz/Attributes/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-}  {- |@@ -26,6 +27,7 @@ import Data.Maybe(isNothing) import qualified Data.Map as Map import Data.Map(Map)+import Data.Text.Lazy(Text) import Control.Monad(liftM, liftM2)  -- -----------------------------------------------------------------------------@@ -41,7 +43,7 @@ --   HTML-like labels).  Note that it is not valid for a 'PortName' --   value to contain a colon (@:@) character; it is assumed that it --   doesn't.-newtype PortName = PN { portName :: String }+newtype PortName = PN { portName :: Text }                  deriving (Eq, Ord, Show, Read)  instance PrintDot PortName where@@ -53,9 +55,9 @@   parseUnqt = liftM PN               $ parseEscaped False [] ['"', ':'] -  parse= quotedParse parseUnqt-         `onFail`-         unqtPortName+  parse = quotedParse parseUnqt+          `onFail`+          unqtPortName  unqtPortName :: Parse PortName unqtPortName = liftM PN quotelessString@@ -64,27 +66,27 @@  data PortPos = LabelledPort PortName (Maybe CompassPoint)              | CompassPoint CompassPoint-    deriving (Eq, Ord, Show, Read)+             deriving (Eq, Ord, Show, Read)  instance PrintDot PortPos where-    unqtDot (LabelledPort n mc) = unqtDot n-                                  <> maybe empty (colon <>) (fmap unqtDot mc)-    unqtDot (CompassPoint cp)   = unqtDot cp+  unqtDot (LabelledPort n mc) = unqtDot n+                                <> maybe empty (colon <>) (fmap unqtDot mc)+  unqtDot (CompassPoint cp)   = unqtDot cp -    toDot (LabelledPort n Nothing) = toDot n-    toDot lp@LabelledPort{}        = doubleQuotes $ unqtDot lp-    toDot cp                       = unqtDot cp+  toDot (LabelledPort n Nothing) = toDot n+  toDot lp@LabelledPort{}        = dquotes $ unqtDot lp+  toDot cp                       = unqtDot cp  instance ParseDot PortPos where-    parseUnqt = do n <- parseUnqt-                   mc <- optional $ character ':' >> parseUnqt-                   return $ if isNothing mc-                            then checkPortName n-                            else LabelledPort n mc+  parseUnqt = do n <- parseUnqt+                 mc <- optional $ character ':' >> parseUnqt+                 return $ if isNothing mc+                          then checkPortName n+                          else LabelledPort n mc -    parse = quotedParse parseUnqt-            `onFail`-            liftM checkPortName unqtPortName+  parse = quotedParse parseUnqt+          `onFail`+          liftM checkPortName unqtPortName  checkPortName    :: PortName -> PortPos checkPortName pn = maybe (LabelledPort pn Nothing) CompassPoint@@ -108,35 +110,35 @@                   | NorthWest                   | CenterPoint                   | NoCP-                    deriving (Eq, Ord, Bounded, Enum, Show, Read)+                  deriving (Eq, Ord, Bounded, Enum, 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 "_"+  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-    -- Have to take care of longer parsing values first.-    parseUnqt = oneOf [ stringRep NorthEast "ne"-                      , stringRep NorthWest "nw"-                      , stringRep North "n"-                      , stringRep SouthEast "se"-                      , stringRep SouthWest "sw"-                      , stringRep South "s"-                      , stringRep East "e"-                      , stringRep West "w"-                      , stringRep CenterPoint "c"-                      , stringRep NoCP "_"-                      ]+  -- Have to take care of longer parsing values first.+  parseUnqt = oneOf [ stringRep NorthEast "ne"+                    , stringRep NorthWest "nw"+                    , stringRep North "n"+                    , stringRep SouthEast "se"+                    , stringRep SouthWest "sw"+                    , stringRep South "s"+                    , stringRep East "e"+                    , stringRep West "w"+                    , stringRep CenterPoint "c"+                    , stringRep NoCP "_"+                    ] -compassLookup :: Map String CompassPoint+compassLookup :: Map Text CompassPoint compassLookup = Map.fromList [ ("ne", NorthEast)                              , ("nw", NorthWest)                              , ("n", North)
+ Data/GraphViz/Attributes/Same.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Attributes.Same+   Description : Consider Attributes equal on constructors.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module is used when @a1 == a2@ should return @True@ if they+   are the same Attribute, even if they don't have the same value+   (typically for 'Set's).+-}+module Data.GraphViz.Attributes.Same+       ( SameAttr+       , SAttrs+       , toSAttr+       , unSame+       ) where++import Data.GraphViz.Attributes.Complete(Attribute, Attributes, sameAttribute)++import Data.Function(on)+import qualified Data.Set as Set+import Data.Set(Set)++-- -----------------------------------------------------------------------------++-- | Defined as a wrapper around 'Attribute' where equality is based+--   solely upon the constructor, not the contents.+newtype SameAttr = SA { getAttr :: Attribute }+                 deriving (Show, Read)++instance Eq SameAttr where+  (==) = sameAttribute `on` getAttr++instance Ord SameAttr where+  compare sa1 sa2+    | sa1 == sa2 = EQ+    | otherwise  = (compare `on` getAttr) sa1 sa2+++type SAttrs = Set SameAttr++toSAttr :: Attributes -> SAttrs+toSAttr = Set.fromList . map SA++unSame :: SAttrs -> Attributes+unSame = map getAttr . Set.toList
Data/GraphViz/Commands.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ {- |    Module      : Data.GraphViz.Commands    Description : Functions to run Graphviz commands.@@ -6,9 +8,7 @@    Maintainer  : Ivan.Miljenovic@gmail.com     This module defines functions to call the various Graphviz-   commands.  It is based upon code originally written for version 0.5-   of /Graphalyze/:-     <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Graphalyze-0.5>+   commands.     Whilst various output formats are supported (see 'GraphvizOutput'    for a complete list), it is not yet possible to choose a desired@@ -34,16 +34,12 @@     , GraphvizOutput(..)     , GraphvizCanvas(..)       -- * Running Graphviz.-    , RunResult(..)-    , maybeErr     , runGraphviz     , runGraphvizCommand     , addExtension     , runGraphvizCanvas     , runGraphvizCanvas'     , graphvizWithHandle-      -- * Helper utilities.-    , hGetContents'     ) where  -- Want to use the extensible-exception version@@ -51,16 +47,12 @@  import Data.GraphViz.Types -- This is here just for Haddock linking purposes.-import Data.GraphViz.Attributes(Attribute(Z))+import Data.GraphViz.Attributes.Complete(Attribute(Z))+import Data.GraphViz.Commands.IO(runCommand)+import Data.GraphViz.Exception -import qualified Data.ByteString as B-import System.IO( Handle, hClose, hPutStr-                , hGetContents, hSetBinaryMode)-import System.Exit(ExitCode(ExitSuccess))-import System.Process(runInteractiveProcess, waitForProcess)-import Control.Concurrent(MVar, forkIO, newEmptyMVar, putMVar, takeMVar)-import Control.Exception.Extensible( IOException, catch-                                   , bracket, evaluate, handle)+import qualified Data.ByteString as SB+import System.IO(Handle, hSetBinaryMode) import Control.Monad(liftM) import System.FilePath((<.>)) @@ -78,7 +70,7 @@                      | TwoPi -- ^ For radial layout of graphs.                      | Circo -- ^ For circular layout of graphs.                      | Fdp   -- ^ For symmetric layout of graphs.-                       deriving (Eq, Ord, Show, Read)+                     deriving (Eq, Ord, Show, Read)  showCmd        :: GraphvizCommand -> String showCmd Dot    = "dot"@@ -121,8 +113,7 @@ -- | This class is for those data types that are valid options for the --   Graphviz tools to use with the @-T@ argument. class GraphvizResult o where-    outputCall :: o -> String-    isBinary :: o -> Bool+  outputCall :: o -> String  -- | The possible Graphviz output formats (that is, those that --   actually produce a file).@@ -170,55 +161,37 @@                     | WBmp      -- ^ Wireless BitMap format;                                 --   monochrome format usually used                                 --   for mobile computing devices.-                      deriving (Eq, Ord, Bounded, Enum, Show, Read)+                    deriving (Eq, Ord, Bounded, Enum, Show, Read)  instance GraphvizResult GraphvizOutput where-    outputCall Bmp       = "bmp"-    outputCall Canon     = "canon"-    outputCall DotOutput = "dot"-    outputCall XDot      = "xdot"-    outputCall Eps       = "eps"-    outputCall Fig       = "fig"-    outputCall Gd        = "gd"-    outputCall Gd2       = "gd2"-    outputCall Gif       = "gif"-    outputCall Ico       = "ico"-    outputCall Imap      = "imap"-    outputCall Cmapx     = "cmapx"-    outputCall ImapNP    = "imap_np"-    outputCall CmapxNP   = "cmapx_np"-    outputCall Jpeg      = "jpeg"-    outputCall Pdf       = "pdf"-    outputCall Plain     = "plain"-    outputCall PlainExt  = "plain-ext"-    outputCall Png       = "png"-    outputCall Ps        = "ps"-    outputCall Ps2       = "ps2"-    outputCall Svg       = "svg"-    outputCall SvgZ      = "svgz"-    outputCall Tiff      = "tiff"-    outputCall Vml       = "vml"-    outputCall VmlZ      = "vmlz"-    outputCall Vrml      = "vrml"-    outputCall WBmp      = "wbmp"--    -- These are the known text-based outputs.-    isBinary Canon     = False-    isBinary DotOutput = False-    isBinary XDot      = False-    isBinary Eps       = False-    isBinary Fig       = False-    isBinary Imap      = False-    isBinary Cmapx     = False-    isBinary ImapNP    = False-    isBinary CmapxNP   = False-    isBinary Plain     = False-    isBinary PlainExt  = False-    isBinary Ps        = False-    isBinary Svg       = False-    isBinary Vml       = False-    isBinary Vrml      = False-    isBinary _         = True+  outputCall Bmp       = "bmp"+  outputCall Canon     = "canon"+  outputCall DotOutput = "dot"+  outputCall XDot      = "xdot"+  outputCall Eps       = "eps"+  outputCall Fig       = "fig"+  outputCall Gd        = "gd"+  outputCall Gd2       = "gd2"+  outputCall Gif       = "gif"+  outputCall Ico       = "ico"+  outputCall Imap      = "imap"+  outputCall Cmapx     = "cmapx"+  outputCall ImapNP    = "imap_np"+  outputCall CmapxNP   = "cmapx_np"+  outputCall Jpeg      = "jpeg"+  outputCall Pdf       = "pdf"+  outputCall Plain     = "plain"+  outputCall PlainExt  = "plain-ext"+  outputCall Png       = "png"+  outputCall Ps        = "ps"+  outputCall Ps2       = "ps2"+  outputCall Svg       = "svg"+  outputCall SvgZ      = "svgz"+  outputCall Tiff      = "tiff"+  outputCall Vml       = "vml"+  outputCall VmlZ      = "vmlz"+  outputCall Vrml      = "vrml"+  outputCall WBmp      = "wbmp"  -- | A default file extension for each 'GraphvizOutput'. defaultExtension           :: GraphvizOutput -> String@@ -255,155 +228,81 @@ --   file; instead, they directly draw a canvas (i.e. a window) with --   the resulting image. data GraphvizCanvas = Gtk | Xlib-                      deriving (Eq, Ord, Bounded, Enum, Read, Show)+                    deriving (Eq, Ord, Bounded, Enum, Read, Show)  instance GraphvizResult GraphvizCanvas where-    outputCall Gtk       = "gtk"-    outputCall Xlib      = "xlib"--    -- Since there's no output, we arbitrarily choose binary mode.-    isBinary _ = True+  outputCall Gtk       = "gtk"+  outputCall Xlib      = "xlib"  -- ----------------------------------------------------------------------------- --- | Represents the result of running a command.-data RunResult = Error String-               | Success-               deriving (Eq, Ord, Read, Show)---- | Return the error if there is one, otherwise return Success.-maybeErr :: Either String a -> RunResult-maybeErr = either Error (const Success)- -- | Run the recommended Graphviz command on this graph, saving the result --   to the file provided (note: file extensions are /not/ checked).-runGraphviz    :: (DotRepr dg n) => dg n -> GraphvizOutput -> FilePath-                  -> IO (Either String FilePath)+runGraphviz    :: (PrintDotRepr dg n) => dg n -> GraphvizOutput -> FilePath+                  -> IO FilePath runGraphviz gr = runGraphvizCommand (commandFor gr) gr  -- | Run the chosen Graphviz command on this graph, saving the result --   to the file provided (note: file extensions are /not/ checked).-runGraphvizCommand :: (DotRepr dg n) => GraphvizCommand -> dg n+runGraphvizCommand :: (PrintDotRepr dg n) => GraphvizCommand -> dg n                       -> GraphvizOutput -> FilePath-                      -> IO (Either String FilePath)+                      -> IO FilePath runGraphvizCommand cmd gr t fp-  = liftM (either (Left . addFl) (const $ Right fp))-    $ graphvizWithHandle cmd gr t toFile-      where-        addFl = (++) ("Unable to create " ++ fp ++ "\n")-        toFile h = B.hGetContents h >>= B.writeFile fp+  = mapException addExc $ graphvizWithHandle cmd gr t toFile+  where+    addFl = (++) ("Unable to create " ++ fp ++ "\n")+    toFile h = SB.hGetContents h >>= SB.writeFile fp >> return fp +    addExc (GVProgramExc e) = GVProgramExc $ addFl e+    addExc e                = e+ -- | Append the default extension for the provided 'GraphvizOutput' to --   the provided 'FilePath' for the output file. addExtension          :: (GraphvizOutput -> FilePath -> a)                          -> GraphvizOutput -> FilePath -> a addExtension cmd t fp = cmd t fp'-    where-      fp' = fp <.> defaultExtension t+  where+    fp' = fp <.> defaultExtension t  -- | Run the chosen Graphviz command on this graph, but send the --   result to the given handle rather than to a file. -- --   Note that the @'Handle' -> 'IO' a@ function /must/ fully consume---   the input from the 'Handle'; 'hGetContents'' is a version of---   'hGetContents' that will ensure this happens.+--   the input from the 'Handle'; e.g. use strict @ByteStrings@ rather+--   than lazy ones. -----   If the command was unsuccessful, then @'Left' error@ is returned.-graphvizWithHandle :: (DotRepr dg n)-                      => GraphvizCommand      -- ^ Which command to run-                      -> dg n                 -- ^ The 'DotRepr' to use-                      -> GraphvizOutput       -- ^ The 'GraphvizOutput' type-                      -> (Handle -> IO a)     -- ^ Extract the output-                      -> IO (Either String a) -- ^ The error or the result.+--   If the command was unsuccessful, then a 'GraphvizException' is+--   thrown.+graphvizWithHandle :: (PrintDotRepr dg n)+                      => GraphvizCommand  -- ^ Which command to run+                      -> dg n             -- ^ The 'DotRepr' to use+                      -> GraphvizOutput   -- ^ The 'GraphvizOutput' type+                      -> (Handle -> IO a) -- ^ Extract the output+                      -> IO a             -- ^ The error or the result. graphvizWithHandle = graphvizWithHandle'  -- This version is not exported as we don't want to let arbitrary -- @Handle -> IO a@ functions to be used for GraphvizCanvas outputs.-graphvizWithHandle' :: (DotRepr dg n, GraphvizResult o)+graphvizWithHandle' :: (PrintDotRepr dg n, GraphvizResult o)                        => GraphvizCommand -> dg n -> o-                       -> (Handle -> IO a) -> IO (Either String a)-graphvizWithHandle' cmd gr t f-  = handle notRunnable-    $ bracket-        (runInteractiveProcess cmd' args Nothing Nothing)-        (\(inh,outh,errh,_) -> hClose inh >> hClose outh >> hClose errh)-        $ \(inp,outp,errp,prc) -> do--          -- The input and error are text, not binary-          hSetBinaryMode inp False-          hSetBinaryMode errp False-          hSetBinaryMode outp $ isBinary t -- Depends on output type--          -- Make sure we close the input or it will hang!!!!!!!-          forkIO $ hPutStr inp (printDotGraph gr) >> hClose inp--          -- Need to make sure both the output and error handles are-          -- really fully consumed.-          mvOutput <- newEmptyMVar-          mvErr    <- newEmptyMVar--          forkIO $ signalWhenDone hGetContents' errp mvErr-          forkIO $ signalWhenDone f' outp mvOutput--          -- When these are both able to be taken, then the forks are finished-          err <- takeMVar mvErr-          output <- takeMVar mvOutput--          exitCode <- waitForProcess prc--          case exitCode of-            ExitSuccess -> return output-            _           -> return $ Left $ othErr ++ err-    where-      notRunnable :: IOException -> IO (Either String a)-      notRunnable e = return . Left $ unwords-                      [ "Unable to call the Graphviz command "-                      , cmd'-                      , " with the arguments: "-                      , unwords args-                      , " because of: "-                      , show e-                      ]-      cmd' = showCmd cmd-      args = ["-T" ++ outputCall t]--      -- Augmenting the f function to let it work within the forkIO:-      f' h = liftM Right (f h)-             `catch`-             fErr-      fErr :: IOException -> IO (Either String a)-      fErr e = return . Left $ "Error re-directing the output from "-               ++ cmd' ++ ": " ++ show e--      othErr = "Error messages from " ++ cmd' ++ ":\n"---- | Store the result of the 'Handle' consumption into the 'MVar'.-signalWhenDone        :: (Handle -> IO a) -> Handle -> MVar a -> IO ()-signalWhenDone f h mv = f h >>= putMVar mv >> return ()+                       -> (Handle -> IO a) -> IO a+graphvizWithHandle' cmd dg t f = runCommand (showCmd cmd)+                                            ["-T" ++ outputCall t]+                                            f'+                                            dg+  where+    f' h = hSetBinaryMode h True >> f h  -- | Run the chosen Graphviz command on this graph and render it using --   the given canvas type.-runGraphvizCanvas          :: (DotRepr dg n) => GraphvizCommand -> dg n-                              -> GraphvizCanvas -> IO RunResult-runGraphvizCanvas cmd gr c = liftM maybeErr-                             $ graphvizWithHandle' cmd gr c nullHandle-    where-      nullHandle :: Handle -> IO ()-      nullHandle = liftM (const ()) . hGetContents'+runGraphvizCanvas          :: (PrintDotRepr dg n) => GraphvizCommand -> dg n+                              -> GraphvizCanvas -> IO ()+runGraphvizCanvas cmd gr c = graphvizWithHandle' cmd gr c nullHandle+  where+    nullHandle :: Handle -> IO ()+    nullHandle = liftM (const ()) . SB.hGetContents  -- | Run the recommended Graphviz command on this graph and render it --   using the given canvas type.-runGraphvizCanvas'   :: (DotRepr dg n) => dg n -> GraphvizCanvas-                        -> IO RunResult+runGraphvizCanvas'   :: (PrintDotRepr dg n) => dg n -> GraphvizCanvas -> IO () runGraphvizCanvas' d = runGraphvizCanvas (commandFor d) d---- -------------------------------------------------------------------------------- Utility functions---- | A version of 'hGetContents' that fully evaluates the contents of---   the 'Handle' (that is, until EOF is reached).  The 'Handle' is---   not closed.-hGetContents'   :: Handle -> IO String-hGetContents' h = do r <- hGetContents h-                     evaluate $ length r-                     return r
+ Data/GraphViz/Commands/IO.hs view
@@ -0,0 +1,204 @@+{- |+   Module      : Data.GraphViz.Commands.IO+   Description : IO-related functions for graphviz.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   Various utility functions to help with custom I\/O of Dot code.+-}+module Data.GraphViz.Commands.IO+       ( -- * Encoding+         -- $encoding+         toUTF8+         -- * Operations on files+       , writeDotFile+       , readDotFile+         -- * Operations on handles+       , hPutDot+       , hPutCompactDot+       , hGetDot+       , hGetStrict+         -- * Special cases for standard input and output+       , putDot+       , readDot+         -- * Running external commands+       , runCommand+       ) where++import Data.GraphViz.State(initialState)+import Data.GraphViz.Types(PrintDotRepr, ParseDotRepr, printDotGraph, parseDotGraph)+import Data.GraphViz.Printing(toDot)+import Data.GraphViz.Exception+import Text.PrettyPrint.Leijen.Text(displayT, renderCompact)++import qualified Data.Text.Lazy.Encoding as T+import Data.Text.Encoding.Error(UnicodeException)+import Data.Text.Lazy(Text)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as B+import Data.ByteString.Lazy(ByteString)+import Control.Monad(liftM)+import Control.Monad.Trans.State+import System.IO(Handle, IOMode(ReadMode,WriteMode)+                , withFile, stdout, stdin, hPutChar+                , hClose, hGetContents, hSetBinaryMode)+import System.Exit(ExitCode(ExitSuccess))+import System.Process(runInteractiveProcess, waitForProcess)+import Control.Exception.Extensible(IOException, evaluate)+import Control.Concurrent(MVar, forkIO, newEmptyMVar, putMVar, takeMVar)++-- -----------------------------------------------------------------------------++-- | Correctly render Graphviz output in a more machine-oriented form+--   (i.e. more compact than the output of 'renderDot').+renderCompactDot :: (PrintDotRepr dg n) => dg n -> Text+renderCompactDot = displayT . renderCompact+                   . flip evalState initialState+                   . toDot++-- -----------------------------------------------------------------------------+-- Encoding++{- $encoding+  By default, Dot code should be in UTF-8.  However, by usage of the+  /charset/ attribute, users are able to specify that the ISO-8859-1+  (aka Latin1) encoding should be used instead:+  <http://www.graphviz.org/doc/info/attrs.html#d:charset>++  To simplify matters, graphviz does /not/ work with ISO-8859-1.  If+  you wish to deal with existing Dot code that uses this encoding, you+  will need to manually read that file in to a 'Text' value.++  If a non-UTF-8 encoding is used, then a 'GraphvizException' will+  be thrown.+-}++-- | Explicitly convert a (lazy) 'ByteString' to a 'Text' value using+--   UTF-8 encoding, throwing a 'GraphvizException' if there is a+--   decoding error.+toUTF8 :: ByteString -> Text+toUTF8 = mapException fE . T.decodeUtf8+  where+    fE   :: UnicodeException -> GraphvizException+    fE e = NotUTF8Dot $ show e++-- -----------------------------------------------------------------------------+-- Low-level Input/Output++-- | Output the @DotRepr@ to the specified 'Handle'.+hPutDot :: (PrintDotRepr dg n) => Handle -> dg n -> IO ()+hPutDot = toHandle printDotGraph++-- | Output the @DotRepr@ to the spcified 'Handle' in a more compact,+--   machine-oriented form.+hPutCompactDot :: (PrintDotRepr dg n) => Handle -> dg n -> IO ()+hPutCompactDot = toHandle renderCompactDot++toHandle        :: (PrintDotRepr dg n) => (dg n -> Text) -> Handle -> dg n+                   -> IO ()+toHandle f h dg = do B.hPutStr h . T.encodeUtf8 $ f dg+                     hPutChar h '\n'++-- | Strictly read in a 'Text' value using an appropriate encoding.+hGetStrict :: Handle -> IO Text+hGetStrict = liftM (toUTF8 . B.fromChunks . (:[]))+             . SB.hGetContents++-- | Read in and parse a @DotRepr@ value from the specified 'Handle'.+hGetDot :: (ParseDotRepr dg n) => Handle -> IO (dg n)+hGetDot = liftM parseDotGraph . hGetStrict++-- | Write the specified @DotRepr@ to file.+writeDotFile   :: (PrintDotRepr dg n) => FilePath -> dg n -> IO ()+writeDotFile f = withFile f WriteMode . flip hPutDot++-- | Read in and parse a @DotRepr@ value from a file.+readDotFile   :: (ParseDotRepr dg n) => FilePath -> IO (dg n)+readDotFile f = withFile f ReadMode hGetDot++-- | Print the specified @DotRepr@ to 'stdout'.+putDot :: (PrintDotRepr dg n) => dg n -> IO ()+putDot = hPutDot stdout++-- | Read in and parse a @DotRepr@ value from 'stdin'.+readDot :: (ParseDotRepr dg n) => IO (dg n)+readDot = hGetDot stdin++-- -----------------------------------------------------------------------------++-- | Run an external command on the specified @DotRepr@.  Remember to+--   use 'hSetBinaryMode' on the 'Handle' for the output function if+--   necessary.+--+--   If the command was unsuccessful, then a 'GraphvizException' is+--   thrown.+runCommand :: (PrintDotRepr dg n)+              => String           -- ^ Command to run+              -> [String]         -- ^ Command-line arguments+              -> (Handle -> IO a) -- ^ Obtaining the output+              -> dg n+              -> IO a+runCommand cmd args hf dg+  = mapException notRunnable+    $ bracket+        (runInteractiveProcess cmd args Nothing Nothing)+        (\(inh,outh,errh,_) -> hClose inh >> hClose outh >> hClose errh)+        $ \(inp,outp,errp,prc) -> do++          hSetBinaryMode inp True+          hSetBinaryMode errp False++          -- Make sure we close the input or it will hang!!!!!!!+          forkIO $ hPutCompactDot inp dg >> hClose inp++          -- Need to make sure both the output and error handles are+          -- really fully consumed.+          mvOutput <- newEmptyMVar+          mvErr    <- newEmptyMVar++          forkIO $ signalWhenDone hGetContents' errp mvErr+          forkIO $ signalWhenDone hf' outp mvOutput++          -- When these are both able to be taken, then the forks are finished+          err <- takeMVar mvErr+          output <- takeMVar mvOutput++          exitCode <- waitForProcess prc++          case exitCode of+            ExitSuccess -> return output+            _           -> throw . GVProgramExc $ othErr ++ err+  where+    notRunnable   :: IOException -> GraphvizException+    notRunnable e = GVProgramExc $ unwords+                    [ "Unable to call the command "+                    , cmd+                    , " with the arguments: \""+                    , unwords args+                    , "\" because of: "+                    , show e+                    ]++    -- Augmenting the hf function to let it work within the forkIO:+    hf' = mapException fErr . hf+    fErr :: IOException -> GraphvizException+    fErr e = GVProgramExc $ "Error re-directing the output from "+             ++ cmd ++ ": " ++ show e++    othErr = "Error messages from " ++ cmd ++ ":\n"++-- -----------------------------------------------------------------------------+-- Utility functions++-- | A version of 'hGetContents' that fully evaluates the contents of+--   the 'Handle' (that is, until EOF is reached).  The 'Handle' is+--   not closed.+hGetContents'   :: Handle -> IO String+hGetContents' h = do r <- hGetContents h+                     evaluate $ length r+                     return r++-- | Store the result of the 'Handle' consumption into the 'MVar'.+signalWhenDone        :: (Handle -> IO a) -> Handle -> MVar a -> IO ()+signalWhenDone f h mv = f h >>= putMVar mv >> return ()
+ Data/GraphViz/Exception.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{- |+   Module      : Data.GraphViz.Exception+   Description : Graphviz-specific exceptions+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com+-}+module Data.GraphViz.Exception+       ( GraphvizException(..)+         -- * Re-exported for convenience.+       , mapException+       , throw+       , handle+       , bracket+       ) where++import Control.Exception.Extensible+import Data.Typeable++-- -----------------------------------------------------------------------------++-- | Exceptions that arise from using this library fall into three+--   categories:+--+--   * Unable to parse provided Dot code.+--+--   * Dot code is not valid UTF-8.+--+--   * An error when trying to run an external program (e.g. @dot@).+--+--   * Treating a non-custom Attribute as a custom one.+--+data GraphvizException = NotDotCode String+                       | NotUTF8Dot String+                       | GVProgramExc String+                       | NotCustomAttr String+                       deriving (Eq, Ord, Typeable)++instance Show GraphvizException where+  showsPrec _ (NotDotCode str)    = showString $ "Error when parsing Dot code: " ++ str+  showsPrec _ (NotUTF8Dot str)    = showString $ "Invalid UTF-8 Dot code: " ++ str+  showsPrec _ (GVProgramExc str)  = showString $ "Error running utility program: " ++ str+  showsPrec _ (NotCustomAttr str) = showString $ "Not a custom Attribute: " ++ str++instance Exception GraphvizException
Data/GraphViz/Parsing.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}+ {- |    Module      : Data.GraphViz.Parsing    Description : Helper functions for Parsing.@@ -20,16 +22,17 @@ -} module Data.GraphViz.Parsing     ( -- * Re-exporting pertinent parts of Polyparse.-      module Text.ParserCombinators.Poly.Lazy+      module Text.ParserCombinators.Poly.StateText       -- * The ParseDot class.     , Parse     , ParseDot(..)     , parseIt     , parseIt'+    , runParser     , runParser'+    , checkValidParse       -- * Convenience parsing combinators.     , bracket-    , discard     , onlyBool     , quotelessString     , stringBlock@@ -72,93 +75,118 @@     , commaSep'     , stringRep     , stringReps+    , stringParse+    , stringValue     , parseAngled     , parseBraced     ) where  import Data.GraphViz.Util+import Data.GraphViz.State+-- To avoid orphan instances and cyclic imports+import Data.GraphViz.Attributes.ColorScheme+import Data.GraphViz.Exception(GraphvizException(NotDotCode), throw) -import Text.ParserCombinators.Poly.Lazy hiding (bracket, discard)-import Data.Char( digitToInt-                , isDigit+import Text.ParserCombinators.Poly.StateText hiding (bracket, empty, indent, runParser)+import qualified Text.ParserCombinators.Poly.StateText as P+import Data.Char( isDigit                 , isSpace                 , isLower                 , toLower                 , toUpper                 )-import Data.Maybe(fromMaybe, isNothing)+import Data.List(groupBy, sortBy)+import Data.Function(on)+import Data.Maybe(fromMaybe, isNothing, listToMaybe) import Data.Ratio((%)) import qualified Data.Set as Set+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Read as T+import Data.Text.Lazy(Text) import Data.Word(Word8, Word16)-import Control.Monad(liftM, when)+import Control.Arrow(first, second)+import Control.Monad(liftM, liftM2, when)  -- ----------------------------------------------------------------------------- -- Based off code from Text.Parse in the polyparse library  -- | A @ReadS@-like type alias.-type Parse a = Parser Char a+type Parse a = Parser GraphvizState a +runParser     :: Parse a -> Text -> (Either String a, Text)+runParser p t = let (r,_,t') = P.runParser p initialState t+                in (r,t')+ -- | A variant of 'runParser' where it is assumed that the provided---   parsing function consumes all of the 'String' input (with the+--   parsing function consumes all of the 'Text' input (with the --   exception of whitespace at the end).-runParser'   :: Parse a -> String -> a-runParser' p = fst . runParser p'+runParser'   :: Parse a -> Text -> a+runParser' p = checkValidParse . fst . runParser p'   where     p' = p `discard` (allWhitespace' >> eof)  class ParseDot a where-    parseUnqt :: Parse a+  parseUnqt :: Parse a -    parse :: Parse a-    parse = optionalQuoted parseUnqt+  parse :: Parse a+  parse = optionalQuoted parseUnqt -    parseUnqtList :: Parse [a]-    parseUnqtList = bracketSep (parseAndSpace $ character '[')-                               ( wrapWhitespace parseComma-                                 `onFail`-                                 allWhitespace-                               )-                               (allWhitespace' >> character ']')-                               parseUnqt+  parseUnqtList :: Parse [a]+  parseUnqtList = bracketSep (parseAndSpace $ character '[')+                             ( wrapWhitespace parseComma+                               `onFail`+                               allWhitespace+                             )+                             (allWhitespace' >> character ']')+                             parseUnqt -    parseList :: Parse [a]-    parseList = quotedParse parseUnqtList+  parseList :: Parse [a]+  parseList = quotedParse parseUnqtList  -- | Parse the required value, returning also the rest of the input --   'String' that hasn't been parsed (for debugging purposes).-parseIt :: (ParseDot a) => String -> (a, String)-parseIt = runParser parse+parseIt :: (ParseDot a) => Text -> (a, Text)+parseIt = first checkValidParse . runParser parse +-- | If unable to parse /Dot/ code properly, 'throw' a+--   'GraphvizException'.+checkValidParse :: Either String a -> a+checkValidParse (Left err) = throw (NotDotCode err)+checkValidParse (Right a)  = a+ -- | Parse the required value with the assumption that it will parse --   all of the input 'String'.-parseIt' :: (ParseDot a) => String -> a+parseIt' :: (ParseDot a) => Text -> a parseIt' = runParser' parse  instance ParseDot Int where-    parseUnqt = parseInt'+  parseUnqt = parseInt' +instance ParseDot Integer where+  parseUnqt = parseSigned parseInt+ instance ParseDot Word8 where-    parseUnqt = parseInt+  parseUnqt = parseInt  instance ParseDot Word16 where-    parseUnqt = parseInt+  parseUnqt = parseInt  instance ParseDot Double where-    parseUnqt = parseFloat'+  parseUnqt = parseFloat' -    parseUnqtList = sepBy1 parseUnqt (character ':')+  parseUnqtList = sepBy1 parseUnqt (character ':') -    parseList = quotedParse parseUnqtList-                `onFail`-                liftM return parse+  parseList = quotedParse parseUnqtList+              `onFail`+              liftM return parse  instance ParseDot Bool where-    parseUnqt = onlyBool-                `onFail`-                liftM (zero /=) parseInt'-        where-          zero :: Int-          zero = 0+  parseUnqt = onlyBool+              `onFail`+              liftM (zero /=) parseInt'+    where+      zero :: Int+      zero = 0  -- | Use this when you do not want numbers to be treated as 'Bool' values. onlyBool :: Parse Bool@@ -167,59 +195,67 @@                  ]  instance ParseDot Char where-    -- Can't be a quote character.-    parseUnqt = satisfy (quoteChar /=)+  -- Can't be a quote character.+  parseUnqt = satisfy (quoteChar /=) -    parse = satisfy restIDString-            `onFail`-            quotedParse parseUnqt+  parse = satisfy restIDString+          `onFail`+          quotedParse parseUnqt -    -- Too many problems with using this within other parsers where-    -- using numString or stringBlock will cause a parse failure.  As-    -- such, this will successfully parse all un-quoted Strings.-    parseUnqtList = quotedString+  parseUnqtList = liftM T.unpack parseUnqt -    parseList = quotelessString-                `onFail`-                -- This will also take care of quoted versions of-                -- above.-                quotedParse quotedString+  parseList = liftM T.unpack parse +instance ParseDot Text where+  -- Too many problems with using this within other parsers where+  -- using numString or stringBlock will cause a parse failure.  As+  -- such, this will successfully parse all un-quoted Texts.+  parseUnqt = quotedString++  parse = quotelessString+          `onFail`+          -- This will also take care of quoted versions of+          -- above.+          quotedParse quotedString+ instance (ParseDot a) => ParseDot [a] where-    parseUnqt = parseUnqtList+  parseUnqt = parseUnqtList -    parse = parseList+  parse = parseList  -- | Parse a 'String' that doesn't need to be quoted.-quotelessString :: Parse String+quotelessString :: Parse Text quotelessString = numString `onFail` stringBlock -numString :: Parse String-numString = liftM show parseStrictFloat+numString :: Parse Text+numString = liftM tShow parseStrictFloat             `onFail`-            liftM show parseInt'+            liftM tShow parseInt'+  where+    tShow :: (Show a) => a -> Text+    tShow = T.pack . show -stringBlock :: Parse String+stringBlock :: Parse Text stringBlock = do frst <- satisfy frstIDString-                 rest <- many (satisfy restIDString)-                 return $ frst : rest+                 rest <- manySatisfy restIDString+                 return $ frst `T.cons` rest  -- | Used when quotes are explicitly required;-quotedString :: Parse String+quotedString :: Parse Text quotedString = parseEscaped True [] [] -parseSigned :: Real a => Parse a -> Parse a+parseSigned :: (Num a) => Parse a -> Parse a parseSigned p = (character '-' >> liftM 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))+parseInt = do cs <- many1Satisfy isDigit+              case T.decimal cs of+                Right (n,"")  -> return n+                Right (_,txt) -> fail $ "Trailing digits not parsed as Integral: " ++ T.unpack txt+                Left err      -> fail $ "Could not read Integral: " ++ err            `adjustErr` (++ "\nexpected one or more digits")-    where-      radix = 10  parseInt' :: Parse Int parseInt' = parseSigned parseInt@@ -229,36 +265,36 @@ parseStrictFloat = parseSigned parseFloat  parseFloat :: (RealFrac a) => Parse a-parseFloat = do ds   <- many (satisfy isDigit)+parseFloat = do ds   <- manySatisfy isDigit                 frac <- optional                         $ do character '.'-                             many (satisfy isDigit)-                when (null ds && noDec frac)+                             manySatisfy isDigit+                when (T.null ds && noDec frac)                   (fail "No actual digits in floating point number!")                 expn  <- optional parseExp                 when (isNothing frac && isNothing expn)                   (fail "This is an integer, not a floating point number!")                 let frac' = fromMaybe "" frac                     expn' = fromMaybe 0 expn-                ( return . fromRational . (* (10^^(expn' - length frac')))-                  . (%1) . runParser' parseInt) (ds++frac')+                ( return . fromRational . (* (10^^(expn' - fromIntegral (T.length frac'))))+                  . (%1) . runParser' parseInt) (ds `T.append` frac')              `onFail`              fail "Expected a floating point number"-    where-      parseExp = do character 'e'-                    ((character '+' >> parseInt)-                     `onFail`-                     parseInt')-      noDec = maybe True null+  where+    parseExp = do character 'e'+                  ((character '+' >> parseInt)+                   `onFail`+                   parseInt')+    noDec = maybe True T.null  parseFloat' :: Parse Double parseFloat' = parseSigned ( parseFloat                             `onFail`                             liftM fI parseInt                           )-    where-      fI :: Integer -> Double-      fI = fromIntegral+  where+    fI :: Integer -> Double+    fI = fromIntegral  -- ----------------------------------------------------------------------------- @@ -273,23 +309,11 @@                              (close                               `adjustErr` ("Missing closing bracket:\n\t"++)) -infixl 3 `discard`---- | @x `discard` y@ parses both x and y, but discards the result of y.------   The definition of @discard@ defined in Polyparse is too strict---   and prevents backtracking.  This should be fixed in the next---   release after 1.4.-discard :: Parse a -> Parse b -> Parse a-pa `discard` pb = do a <- pa-                     pb-                     return a- parseAndSpace   :: Parse a -> Parse a parseAndSpace p = p `discard` allWhitespace' -string :: String -> Parse String-string = mapM character+string :: String -> Parse ()+string = mapM_ character  stringRep   :: a -> String -> Parse a stringRep v = stringReps v . return@@ -297,7 +321,19 @@ stringReps      :: a -> [String] -> Parse a stringReps v ss = oneOf (map string ss) >> return v -strings :: [String] -> Parse String+stringParse :: [(String, Parse a)] -> Parse a+stringParse = toPM . sortBy (flip compare `on` fst)+  where+    toPM = oneOf . map mkPM . groupBy ((==) `on` (listToMaybe . fst))++    mkPM [("",p)] = p+    mkPM [(str,p)] = string str >> p+    mkPM kv = character (head . fst $ head kv) >> toPM (map (first tail) kv)++stringValue :: [(String, a)] -> Parse a+stringValue = stringParse . map (second return)++strings :: [String] -> Parse () strings = oneOf . map string  character   :: Char -> Parse Char@@ -310,26 +346,26 @@                   then toUpper c'                   else toLower c' -noneOf :: (Eq a) => [a] -> Parser a a+noneOf   :: [Char] -> Parse Char noneOf t = satisfy (\x -> all (/= x) t) -whitespace :: Parse String-whitespace = many1 (satisfy isSpace)+whitespace :: Parse ()+whitespace = many1Satisfy isSpace >> return () -whitespace' :: Parse String-whitespace' = many (satisfy isSpace)+whitespace' :: Parse ()+whitespace' = manySatisfy isSpace >> return ()  allWhitespace :: Parse () allWhitespace = (whitespace `onFail` newline) >> allWhitespace'  allWhitespace' :: Parse ()-allWhitespace' = newline' `discard` whitespace'+allWhitespace' = newline' >> whitespace'  -- | Parse and discard optional whitespace. wrapWhitespace :: Parse a -> Parse a wrapWhitespace = bracket allWhitespace' allWhitespace' -optionalQuotedString :: String -> Parse String+optionalQuotedString :: String -> Parse () optionalQuotedString = optionalQuoted . string  optionalQuoted   :: Parse a -> Parse a@@ -356,8 +392,8 @@ --   are not permitted.  Note: does not parse surrounding quotes.  The --   'Bool' value indicates whether empty 'String's are allowed or --   not.-parseEscaped             :: Bool -> [Char] -> [Char] -> Parse String-parseEscaped empt cs bnd = lots $ qPrs `onFail` oth+parseEscaped             :: Bool -> [Char] -> [Char] -> Parse Text+parseEscaped empt cs bnd = liftM T.pack . lots $ qPrs `onFail` oth   where     lots = if empt then many else many1     cs' = quoteChar : slash : cs@@ -370,8 +406,8 @@               return $ fromMaybe slash mE     oth = satisfy (`Set.notMember` bndSet) -newline :: Parse String-newline = oneOf $ map string ["\r\n", "\n", "\r"]+newline :: Parse ()+newline = strings ["\r\n", "\n", "\r"]  -- | Consume all whitespace and newlines until a line with --   non-whitespace is reached.  The whitespace on that line is@@ -381,42 +417,38 @@  -- | Parses and returns all characters up till the end of the line, --   but does not touch the newline characters.-consumeLine :: Parse String-consumeLine = many (noneOf ['\n','\r'])+consumeLine :: Parse Text+consumeLine = manySatisfy (`notElem` ['\n','\r'])  parseEq :: Parse () parseEq = wrapWhitespace (character '=') >> return () -parseField       :: (ParseDot a) => (a -> b) -> String -> Parse b-parseField c fld = do string fld-                      parseEq-                      liftM c parse+parseField       :: (ParseDot a) => (a -> b) -> String -> [(String, Parse b)]+parseField c fld = [(fld, parseEq >> liftM c parse)] -parseFields   :: (ParseDot a) => (a -> b) -> [String] -> Parse b-parseFields c = oneOf . map (parseField c)+parseFields   :: (ParseDot a) => (a -> b) -> [String] -> [(String, Parse b)]+parseFields c = concatMap (parseField c) -parseFieldBool :: (Bool -> b) -> String -> Parse b+parseFieldBool :: (Bool -> b) -> String -> [(String, Parse b)] parseFieldBool = flip parseFieldDef True -parseFieldsBool   :: (Bool -> b) -> [String] -> Parse b-parseFieldsBool c = oneOf . map (parseFieldBool c)+parseFieldsBool   :: (Bool -> b) -> [String] -> [(String, Parse b)]+parseFieldsBool c = concatMap (parseFieldBool c)  -- | For 'Bool'-like data structures where the presence of the field --   name without a value implies a default value.-parseFieldDef         :: (ParseDot a) => (a -> b) -> a -> String -> Parse b-parseFieldDef c d fld = parseField c fld-                        `onFail`-                        -- Have to make sure it isn't too greedy-                        -- guessing something is a global attribute-                        -- when its actually a node/edge/etc.-                        do string fld-                           nxt <- optional $ satisfy restIDString-                           bool (fail "Not actually the field you were after")-                                (return $ c d)-                                (isNothing nxt)+parseFieldDef         :: (ParseDot a) => (a -> b) -> a -> String -> [(String, Parse b)]+parseFieldDef c d fld = [(fld, p)]+  where+    p = (parseEq >> liftM c parse)+        `onFail`+        do nxt <- optional $ satisfy restIDString+           bool (fail "Not actually the field you were after")+                (return $ c d)+                (isNothing nxt) -parseFieldsDef     :: (ParseDot a) => (a -> b) -> a -> [String] -> Parse b-parseFieldsDef c d = oneOf . map (parseFieldDef c d)+parseFieldsDef     :: (ParseDot a) => (a -> b) -> a -> [String] -> [(String, Parse b)]+parseFieldsDef c d = concatMap (parseFieldDef c d)  commaSep :: (ParseDot a, ParseDot b) => Parse (a, b) commaSep = commaSep' parse parse@@ -446,3 +478,56 @@  parseBraced :: Parse a -> Parse a parseBraced = bracket (character '{') (character '}')++-- -----------------------------------------------------------------------------+-- These instances are defined here to avoid cyclic imports and orphan instances++instance ParseDot ColorScheme where+    parseUnqt = do cs <- stringRep X11 "X11"+                          `onFail`+                          liftM Brewer parseUnqt+                   setColorScheme cs+                   return cs++instance ParseDot BrewerScheme where+  parseUnqt = liftM2 BScheme parseUnqt parseUnqt++instance ParseDot BrewerName where+  -- The order is different from above to make sure longer names are+  -- parsed first.+  parseUnqt = stringValue [ ("accent", Accent)+                          , ("blues", Blues)+                          , ("brbg", Brbg)+                          , ("bugn", Bugn)+                          , ("bupu", Bupu)+                          , ("dark2", Dark2)+                          , ("gnbu", Gnbu)+                          , ("greens", Greens)+                          , ("greys", Greys)+                          , ("oranges", Oranges)+                          , ("orrd", Orrd)+                          , ("paired", Paired)+                          , ("pastel1", Pastel1)+                          , ("pastel2", Pastel2)+                          , ("piyg", Piyg)+                          , ("prgn", Prgn)+                          , ("pubugn", Pubugn)+                          , ("pubu", Pubu)+                          , ("puor", Puor)+                          , ("purd", Purd)+                          , ("purples", Purples)+                          , ("rdbu", Rdbu)+                          , ("rdgy", Rdgy)+                          , ("rdpu", Rdpu)+                          , ("rdylbu", Rdylbu)+                          , ("rdylgn", Rdylgn)+                          , ("reds", Reds)+                          , ("set1", Set1)+                          , ("set2", Set2)+                          , ("set3", Set3)+                          , ("spectral", Spectral)+                          , ("ylgnbu", Ylgnbu)+                          , ("ylgn", Ylgn)+                          , ("ylorbr", Ylorbr)+                          , ("ylorrd", Ylorrd)+                          ]
Data/GraphViz/PreProcessing.hs view
@@ -22,7 +22,13 @@ module Data.GraphViz.PreProcessing(preProcess) where  import Data.GraphViz.Parsing+import Data.GraphViz.Exception(GraphvizException(NotDotCode), throw) +import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)+import qualified Data.Text.Lazy.Builder as B+import Data.Text.Lazy.Builder(Builder)+import Data.Monoid(Monoid(..), mconcat) import Control.Monad(liftM)  -- -----------------------------------------------------------------------------@@ -30,89 +36,103 @@  -- | Remove unparseable features of Dot, such as comments and --   multi-line strings (which are converted to single-line strings).-preProcess :: String -> String-preProcess = runParser' parseOutUnwanted-             -- snd should be null+preProcess :: Text -> Text+preProcess t = case fst $ runParser parseOutUnwanted t of+                 (Right r) -> B.toLazyText r+                 (Left l)  -> throw (NotDotCode l)+               -- snd should be null  -- | Parse out comments and make quoted strings spread over multiple --   lines only over a single line.  Should parse the /entire/ input---   'String'.-parseOutUnwanted :: Parse String-parseOutUnwanted = liftM concat (many getNext)-    where-      getNext = parseConcatStrings-                `onFail`-                parseHTML-                `onFail`-                (parseUnwanted >> return [])-                `onFail`-                liftM return next+--   'Text'.+parseOutUnwanted :: Parse Builder+parseOutUnwanted = liftM mconcat (many getNext)+  where+    getNext = parseOK+              `onFail`+              parseConcatStrings+              `onFail`+              parseHTML+              `onFail`+              parseUnwanted+              `onFail`+              liftM B.singleton next+    parseOK = liftM B.fromLazyText+              $ many1Satisfy (`notElem` ['\n', '\r', '\\', '/', '"', '<'])  -- | Parses an unwanted part of the Dot code (comments and --   pre-processor lines; also un-splits lines).-parseUnwanted :: Parse ()+parseUnwanted :: (Monoid m) => Parse m parseUnwanted = oneOf [ parseLineComment                       , parseMultiLineComment                       , parsePreProcessor                       , parseSplitLine                       ]-                >> return ()  -- | Remove pre-processor lines (that is, those that start with a --   @#@).  Will consume the newline from the beginning of the --   previous line, but will leave the one from the pre-processor line --   there (so in the end it just removes the line).-parsePreProcessor :: Parse String+parsePreProcessor :: (Monoid m) => Parse m parsePreProcessor = do newline                        character '#'                        consumeLine+                       return mempty  -- | Parse @//@-style comments.-parseLineComment :: Parse String-parseLineComment = string "//"-                   -- Note: do /not/ consume the newlines, as they're-                   -- needed in case the next line is a pre-processor-                   -- line.-                   >> consumeLine+parseLineComment :: (Monoid m) => Parse m+parseLineComment = do string "//"+                      -- Note: do /not/ consume the newlines, as they're+                      -- needed in case the next line is a pre-processor+                      -- line.+                      consumeLine+                      return mempty  -- | Parse @/* ... */@-style comments.-parseMultiLineComment :: Parse String-parseMultiLineComment = bracket start end (liftM concat $ many inner)-    where-      start = string "/*"-      end = string "*/"-      inner = many1 (satisfy ('*' /=))-              `onFail`-              do ast <- character '*'-                 n <- satisfy ('/' /=)-                 liftM ((:) ast . (:) n) inner+parseMultiLineComment :: (Monoid m) => Parse m+parseMultiLineComment = bracket start end (many inner)+                        >> return mempty+  where+    start = string "/*"+    end = string "*/"+    inner = (many1Satisfy ('*' /=) >> return ())+            `onFail`+            do character '*'+               satisfy ('/' /=)+               inner -parseConcatStrings :: Parse String-parseConcatStrings = liftM (wrapQuotes . concat)+parseConcatStrings :: Parse Builder+parseConcatStrings = liftM (wrapQuotes . mconcat)                      $ sepBy1 parseString parseConcat   where-    parseString = quotedParse (liftM concat $ many parseInner)-    parseInner = string "\\\""+    qParse = bracket (character '"') (commit $ character '"')+    parseString = qParse (liftM mconcat $ many parseInner)+    parseInner = (string "\\\"" >> return (B.fromLazyText $ T.pack "\\\""))                  `onFail`+                 -- Need to parse an explicit `\', in case it ends the+                 -- string (and thus the next step would get parsed by the+                 -- previous option).+                 (string "\\\\" >> return (B.fromLazyText $ T.pack "\\\\"))+                 `onFail`                  parseSplitLine -- in case there's a split mid-quote                  `onFail`-                 liftM return (satisfy (quoteChar /=))+                 liftM B.singleton (satisfy (quoteChar /=))     parseConcat = parseSep >> character '+' >> parseSep     parseSep = many $ allWhitespace `onFail` parseUnwanted-    wrapQuotes str = quoteChar : str ++ [quoteChar]-+    wrapQuotes str = qc `mappend` str `mappend` qc+    qc = B.singleton '"'  -- | Lines can be split with a @\\@ at the end of the line.-parseSplitLine :: Parse String-parseSplitLine = character '\\' >> newline >> return ""+parseSplitLine :: (Monoid m) => Parse m+parseSplitLine = character '\\' >> newline >> return mempty -parseHTML :: Parse String-parseHTML = liftM (addQuotes . concat)+parseHTML :: Parse Builder+parseHTML = liftM (addAngled . mconcat)             . parseAngled $ many inner   where     inner = parseHTML             `onFail`-            many1 (satisfy (\c -> c /= open && c /= close))-    addQuotes str = open : str ++ [close]+            (liftM B.fromLazyText $ many1Satisfy (\c -> c /= open && c /= close))+    addAngled str = B.singleton open `mappend` str `mappend` B.singleton close     open = '<'     close = '>'
Data/GraphViz/Printing.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}+ {- |    Module      : Data.GraphViz.Printing    Description : Helper functions for converting to Dot format.@@ -15,7 +17,7 @@    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).+   'Text' value).     The Dot language specification specifies that any identifier is in    one of four forms:@@ -33,17 +35,19 @@    all characters @c@ where @ord c >= 128@.)     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'+   sure that the 'Text' in question is static and quotes are+   definitely needed/unneeded; it is better to use the 'Text'    instance for 'PrintDot'.  For more information, see the    specification page:       <http://graphviz.org/doc/info/lang.html> -} module Data.GraphViz.Printing-    ( module Text.PrettyPrint+    ( module Text.PrettyPrint.Leijen.Text.Monadic     , DotCode     , renderDot -- Exported for Data.GraphViz.Types.printSGID     , PrintDot(..)+    , unqtText+    , dotText     , printIt     , addQuotes     , unqtEscaped@@ -52,145 +56,166 @@     , commaDel     , printField     , angled-    , rang-    , lang     , fslash     ) where  import Data.GraphViz.Util+import Data.GraphViz.State+-- To avoid orphan instances and cyclic imports+import Data.GraphViz.Attributes.ColorScheme  -- Only implicitly import and re-export combinators.-import Text.PrettyPrint hiding ( Style(..)-                               , Mode(..)-                               , TextDetails(..)-                               , render-                               , style-                               , renderStyle-                               , fullRender-                               )--import qualified Text.PrettyPrint as PP+import Text.PrettyPrint.Leijen.Text.Monadic hiding ( SimpleDoc(..)+                                                   , renderPretty+                                                   , renderCompact+                                                   , displayT+                                                   , displayIO+                                                   , putDoc+                                                   , hPutDoc+                                                   , Pretty(..)+                                                   , bool+                                                   , string)+import qualified Text.PrettyPrint.Leijen.Text.Monadic as PP+import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)  import Data.Char(toLower) import qualified Data.Set as Set import Data.Word(Word8, Word16) import Control.Monad(ap)+import Control.Monad.Trans.State  -- -----------------------------------------------------------------------------  -- | A type alias to indicate what is being produced.-type DotCode = Doc+type DotCode = State GraphvizState Doc +instance Show DotCode where+  showsPrec d = showsPrec d . renderDot+ -- | Correctly render Graphviz output.-renderDot :: DotCode -> String-renderDot = PP.renderStyle style'-    where-      style' = PP.style { PP.mode = PP.LeftMode }+renderDot :: DotCode -> Text+renderDot = PP.displayT . PP.renderPretty 0.4 80+            . flip evalState initialState  -- | 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 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 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 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 = list . mapM 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+  -- | 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 = dquotes . unqtListToDot  -- | Convert to DotCode; note that this has no indentation, as we can --   only have one of indentation and (possibly) infinite line lengths.-printIt :: (PrintDot a) => a -> String+printIt :: (PrintDot a) => a -> Text printIt = renderDot . toDot  instance PrintDot Int where-    unqtDot = int+  unqtDot = int +instance PrintDot Integer where+  unqtDot = text . T.pack . show+ instance PrintDot Word8 where-    unqtDot = int . fromIntegral+  unqtDot = int . fromIntegral  instance PrintDot Word16 where-    unqtDot = int . fromIntegral+  unqtDot = int . fromIntegral  instance PrintDot Double where-    -- If it's an "integral" double, then print as an integer.-    -- This seems to match how Graphviz apps use Dot.-    unqtDot d = if d == fromIntegral di-                then int di-                else double d-        where-          di = round d--    toDot d = if any ((==) 'e' . toLower) $ show d-              then doubleQuotes ud-              else ud+  -- If it's an "integral" double, then print as an integer.  This+  -- seems to match how Graphviz apps use Dot.+  unqtDot d = if d == fromIntegral di+              then int di+              else double d       where-        ud = unqtDot d+        di = round d -    unqtListToDot = hcat . punctuate colon . map unqtDot+  toDot d = if any ((==) 'e' . toLower) $ show d+            then dquotes ud+            else ud+    where+      ud = unqtDot d -    listToDot [d] = toDot d-    listToDot ds  = doubleQuotes $ unqtListToDot ds+  unqtListToDot = hcat . punctuate colon . mapM unqtDot +  listToDot [d] = toDot d+  listToDot ds  = dquotes $ unqtListToDot ds+ instance PrintDot Bool where-    unqtDot True  = text "true"-    unqtDot False = text "false"+  unqtDot True  = text "true"+  unqtDot False = text "false"  instance PrintDot Char where-    unqtDot = char+  unqtDot = char -    toDot = qtChar+  toDot = qtChar -    unqtListToDot = unqtString+  unqtListToDot = unqtDot . T.pack -    listToDot = qtString+  listToDot = toDot . T.pack +instance PrintDot Text where+  unqtDot = unqtString++  toDot = qtString++-- | For use with @OverloadedStrings@ to avoid ambiguous type variable errors.+unqtText :: Text -> DotCode+unqtText = unqtDot++-- | For use with @OverloadedStrings@ to avoid ambiguous type variable errors.+dotText :: Text -> DotCode+dotText = toDot+ -- | 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+  | restIDString c = char c -- Could be a number as well.+  | otherwise      = dquotes $ char c -needsQuotes :: String -> Bool+needsQuotes :: Text -> Bool needsQuotes str-  | null str        = True+  | T.null str      = True   | isKeyword str   = True   | isIDString str  = False   | isNumString str = False   | otherwise       = True -addQuotes :: String -> DotCode -> DotCode-addQuotes = bool id doubleQuotes . needsQuotes+addQuotes :: Text -> DotCode -> DotCode+addQuotes = bool id dquotes . needsQuotes  -- | Escape quotes in Strings that need them.-unqtString     :: String -> DotCode+unqtString     :: Text -> DotCode unqtString ""  = empty unqtString str = unqtEscaped [] str -- no quotes? no worries! --- | Escape quotes and quote Strings that need them (including keywords).-qtString :: String -> DotCode+-- | Escape quotes and quote Texts that need them (including keywords).+qtString :: Text -> DotCode qtString = printEscaped []  instance (PrintDot a) => PrintDot [a] where-    unqtDot = unqtListToDot+  unqtDot = unqtListToDot -    toDot = listToDot+  toDot = listToDot  wrap       :: DotCode -> DotCode -> DotCode -> DotCode wrap b a d = b <> d <> a@@ -198,16 +223,16 @@ commaDel     :: (PrintDot a, PrintDot b) => a -> b -> DotCode commaDel a b = unqtDot a <> comma <> unqtDot b -printField     :: (PrintDot a) => String -> a -> DotCode+printField     :: (PrintDot a) => Text -> a -> DotCode printField f v = text f <> equals <> toDot v  -- | Escape the specified chars as well as @\"@.-unqtEscaped    :: [Char] -> String -> DotCode+unqtEscaped    :: [Char] -> Text -> DotCode unqtEscaped cs = text . addEscapes cs  -- | Escape the specified chars as well as @\"@ and then wrap the --   result in quotes.-printEscaped        :: [Char] -> String -> DotCode+printEscaped        :: [Char] -> Text -> DotCode printEscaped cs str = addQuotes str' $ text str'   where     str' = addEscapes cs str@@ -216,33 +241,78 @@ --   cannot convert to 'DotCode' immediately because 'printEscaped' --   needs to pass the result from this to 'addQuotes' to determine if --   it needs to be quoted or not.-addEscapes   :: [Char] -> String ->  String-addEscapes cs = foldr escape "" . withNext+addEscapes    :: [Char] -> Text -> Text+addEscapes cs = foldr escape T.empty . withNext   where     cs' = Set.fromList $ quote : slash : cs     slash = '\\'     quote = '"'     escape (c,c') str-      | c == slash && c' `Set.member` escLetters = c : str-      | c `Set.member` cs'                       = slash : c : str-      | c == '\n'                                = slash : 'n' : str-      | otherwise                                = c : str+      | c == slash && c' `Set.member` escLetters = c `T.cons` str+      | c `Set.member` cs'                       = slash `T.cons` (c `T.cons` str)+      | c == '\n'                                = slash `T.cons` ('n' `T.cons` str)+      | otherwise                                = c `T.cons` str      -- When a slash precedes one of these characters, don't escape the slash.     escLetters = Set.fromList ['N', 'G', 'E', 'T', 'H', 'L', 'n', 'l', 'r']      -- Need to check subsequent characters when escaping slashes, but     -- don't want to lose the last character when zipping, so append a space.-    withNext = zip `ap` ((++" ") . tail)+    withNext ""  = []+    withNext str = T.zip `ap` ((`T.snoc` ' ') . T.tail) $ str  angled :: DotCode -> DotCode-angled = wrap lang rang--lang :: DotCode-lang = char '<'--rang :: DotCode-rang = char '>'+angled = wrap langle rangle  fslash :: DotCode fslash = char '/'++-- -----------------------------------------------------------------------------+-- These instances are defined here to avoid cyclic imports and orphan instances++instance PrintDot ColorScheme where+  unqtDot cs = do setColorScheme cs+                  case cs of+                    X11       -> unqtText "X11"+                    Brewer bs -> unqtDot bs++instance PrintDot BrewerScheme where+  unqtDot (BScheme n l) = unqtDot n <> unqtDot l++instance PrintDot BrewerName where+  unqtDot Accent   = unqtText "accent"+  unqtDot Blues    = unqtText "blues"+  unqtDot Brbg     = unqtText "brbg"+  unqtDot Bugn     = unqtText "bugn"+  unqtDot Bupu     = unqtText "bupu"+  unqtDot Dark2    = unqtText "dark2"+  unqtDot Gnbu     = unqtText "gnbu"+  unqtDot Greens   = unqtText "greens"+  unqtDot Greys    = unqtText "greys"+  unqtDot Oranges  = unqtText "oranges"+  unqtDot Orrd     = unqtText "orrd"+  unqtDot Paired   = unqtText "paired"+  unqtDot Pastel1  = unqtText "pastel1"+  unqtDot Pastel2  = unqtText "pastel2"+  unqtDot Piyg     = unqtText "piyg"+  unqtDot Prgn     = unqtText "prgn"+  unqtDot Pubu     = unqtText "pubu"+  unqtDot Pubugn   = unqtText "pubugn"+  unqtDot Puor     = unqtText "puor"+  unqtDot Purd     = unqtText "purd"+  unqtDot Purples  = unqtText "purples"+  unqtDot Rdbu     = unqtText "rdbu"+  unqtDot Rdgy     = unqtText "rdgy"+  unqtDot Rdpu     = unqtText "rdpu"+  unqtDot Rdylbu   = unqtText "rdylbu"+  unqtDot Rdylgn   = unqtText "rdylgn"+  unqtDot Reds     = unqtText "reds"+  unqtDot Set1     = unqtText "set1"+  unqtDot Set2     = unqtText "set2"+  unqtDot Set3     = unqtText "set3"+  unqtDot Spectral = unqtText "spectral"+  unqtDot Ylgn     = unqtText "ylgn"+  unqtDot Ylgnbu   = unqtText "ylgnbu"+  unqtDot Ylorbr   = unqtText "ylorbr"+  unqtDot Ylorrd   = unqtText "ylorrd"+
+ Data/GraphViz/State.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++{- |+   Module      : Data.GraphViz.State+   Description : Printing and parsing state.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   When printing and parsing Dot code, some items depend on values+   that are set earlier.+-}+module Data.GraphViz.State+       ( GraphvizStateM(..)+       , GraphvizState(..)+       , initialState+       , setDirectedness+       , getDirectedness+       , setLayerSep+       , getLayerSep+       , setColorScheme+       , getColorScheme+       ) where++import Data.GraphViz.Attributes.ColorScheme++import Control.Monad.Trans.State(State, modify, gets)+import Text.ParserCombinators.Poly.StateText(Parser, stUpdate, stQuery)++-- -----------------------------------------------------------------------------++class (Monad m) => GraphvizStateM m where+  modifyGS :: (GraphvizState -> GraphvizState) -> m ()++  getsGS :: (GraphvizState -> a) -> m a++instance GraphvizStateM (State GraphvizState) where+  modifyGS = modify++  getsGS = gets++instance GraphvizStateM (Parser GraphvizState) where+  modifyGS = stUpdate++  getsGS = stQuery++-- | Several aspects of Dot code are either global or mutable state.+data GraphvizState = GS { directedEdges :: Bool+                        , layerSep      :: [Char]+                        , colorScheme   :: ColorScheme+                        }+                   deriving (Eq, Ord, Show, Read)++initialState :: GraphvizState+initialState = GS { directedEdges = True+                  , layerSep      = defLayerSep+                  , colorScheme   = X11+                  }++setDirectedness   :: (GraphvizStateM m) => Bool -> m ()+setDirectedness d = modifyGS (\ gs -> gs { directedEdges = d } )++getDirectedness :: (GraphvizStateM m) => m Bool+getDirectedness = getsGS directedEdges++setLayerSep     :: (GraphvizStateM m) => [Char] -> m ()+setLayerSep sep = modifyGS (\ gs -> gs { layerSep = sep } )++getLayerSep :: (GraphvizStateM m) => m [Char]+getLayerSep = getsGS layerSep++setColorScheme    :: (GraphvizStateM m) => ColorScheme -> m ()+setColorScheme cs = modifyGS (\ gs -> gs { colorScheme = cs } )++getColorScheme :: (GraphvizStateM m) => m ColorScheme+getColorScheme = getsGS colorScheme++-- | The default separators for 'LayerSep'.+defLayerSep :: [Char]+defLayerSep = [' ', ':', '\t']+++
Data/GraphViz/Testing.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Rank2Types, FlexibleContexts #-}+ {- |    Module      : Data.GraphViz.Testing    Description : Test-suite for graphviz.@@ -28,12 +30,10 @@      ways of capitalising that String isn't generated as a random      'LRName'. -   * The generated 'DotGraph's are not guaranteed to be valid; as-     such, the 'prop_parsePrettyID' property is not able to be tested-     as dot, etc. choke on invalid Dot code.+   * The generated 'DotRepr's are not guaranteed to be valid. -   * To avoid needless endless recursion, 'DotSubGraph's do not have-     sub-'DotSubGraph's (same with 'GDotSubGraph's).+   * To avoid needless endless recursion, sub-graphs do not have their+     own internal sub-graphs.     * This test suite isn't perfect: if you deliberately try to stuff      something up, you probably can.@@ -50,12 +50,12 @@        , test_generalisedSameDot        , test_printParseID        , test_preProcessingID-       , test_parsePrettyID        , test_dotizeAugment        , test_dotizeAugmentUniq+       , test_canonicalise+       , test_transitive         -- * Re-exporting modules for manual testing.        , module Data.GraphViz-       , module Data.GraphViz.Types.Generalised        , module Data.GraphViz.Testing.Properties          -- * Debugging printing        , PrintDot(..)@@ -71,19 +71,14 @@ import Test.QuickCheck  import Data.GraphViz.Testing.Instances()--- This module cannot be re-exported from Instances, as it causes--- Overlapping Instances.-import Data.GraphViz.Testing.Instances.FGL() import Data.GraphViz.Testing.Properties -import Data.GraphViz hiding (RunResult(..))+import Data.GraphViz import Data.GraphViz.Parsing(ParseDot(..), parseIt, runParser) import Data.GraphViz.PreProcessing(preProcess) import Data.GraphViz.Printing(PrintDot(..), printIt, renderDot)-import Data.GraphViz.Types.Generalised hiding ( GraphID(..)-                                              , GlobalAttributes(..)-                                              , DotNode(..)-                                              , DotEdge(..))+import qualified Data.GraphViz.Types.Generalised as G+import qualified Data.GraphViz.Types.Graph as Gr -- Can't use PatriciaTree because a Show instance is needed. import Data.Graph.Inductive.Tree(Gr) @@ -93,11 +88,11 @@ -- -----------------------------------------------------------------------------  runChosenTests       :: [Test] -> IO ()-runChosenTests tests = do putStrLn msg-                          blankLn-                          runTests tests-                          spacerLn-                          putStrLn successMsg+runChosenTests tsts = do putStrLn msg+                         blankLn+                         runTests tsts+                         spacerLn+                         putStrLn successMsg   where     msg = "This is the test suite for the graphviz library.\n\            \If any of these tests fail, please inform the maintainer,\n\@@ -111,9 +106,9 @@  -- | Defines the test structure being used. data Test = Test { name       :: String-                 , lookupName :: String    -- ^ Should be lowercase+                 , lookupName :: String      -- ^ Should be lowercase                  , desc       :: String-                 , test       :: IO Result -- ^ QuickCheck test.+                 , tests      :: [IO Result] -- ^ QuickCheck test.                  }  -- | Run all of the provided tests.@@ -126,12 +121,7 @@                  blankLn                  putStrLn $ desc tst                  blankLn-                 r <- test tst-                 blankLn-                 case r of-                   Success{} -> putStrLn successMsg-                   GaveUp{}  -> putStrLn gaveUpMsg-                   _         -> die failMsg+                 run $ tests tst                  blankLn   where     nm = '"' : name tst ++ "\""@@ -142,6 +132,13 @@     failMsg = "The tests for " ++ nm ++ " failed!\n\                \Not attempting any further tests." +    run [] = putStrLn successMsg+    run (t:ts) = do r <- t+                    case r of+                       Success{} -> run ts+                       GaveUp{}  -> putStrLn gaveUpMsg >> run ts+                       _         -> die failMsg+ spacerLn :: IO () spacerLn = putStrLn (replicate 70 '=') >> blankLn @@ -152,6 +149,9 @@ die msg = do hPutStrLn stderr msg              exitWith (ExitFailure 1) +qCheck :: (Testable prop) => prop -> IO Result+qCheck = quickCheckWithResult (stdArgs { maxSize = 50, maxSuccess = 200 })+ -- ----------------------------------------------------------------------------- -- Defining the tests to use. @@ -160,21 +160,15 @@ defaultTests = [ test_printParseID_Attributes                , test_generalisedSameDot                , test_printParseID-               , test_printParseGID                , test_preProcessingID-                 -- Can't run this test, since we don't generate valid-                 -- DotGraphs to pass to Graphviz!-                 -- , test_parsePrettyID                , test_dotizeAugment                , test_dotizeAugmentUniq                , test_findAllNodes-               , test_findAllNodesG                , test_findAllNodesE-               , test_findAllNodesEG                , test_findAllEdges-               , test_findAllEdgesG                , test_noGraphInfo-               , test_noGraphInfoG+               , test_canonicalise+               , test_transitive                ]  -- | Test that 'Attributes' can be printed and then parsed back.@@ -183,249 +177,190 @@   = Test { name       = "Printing and parsing of Attributes"          , lookupName = "attributes"          , desc       = dsc-         , test       = quickCheckWithResult args prop+         , tests      = [qCheck prop]          }-    where-      prop :: Attributes -> Property-      prop = prop_printParseListID--      args = stdArgs { maxSuccess = numGen }-      numGen = 10000-      defGen = maxSuccess stdArgs+  where+    prop :: Attributes -> Property+    prop = prop_printParseListID -      dsc = "The most common source of errors in printing and parsing are for\n\-            \Attributes.  As such, these are stress-tested before we run the\n\-            \rest of the tests, generating " ++ show numGen ++ " lists of\n\-            \Attributes rather than the default " ++ show defGen ++ " tests."+    dsc = "The most common source of errors in printing and parsing are for\n\+          \Attributes."  test_generalisedSameDot :: Test test_generalisedSameDot   = Test { name       = "Printing generalised Dot code"          , lookupName = "makegeneralised"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = [qCheck prop]          }     where       prop :: DotGraph Int -> Bool       prop = prop_generalisedSameDot -      dsc = "When generalising \"DotGraph\" values to \"GDotGraph\" values,\n\+      dsc = "When generalising \"DotGraph\" values to other \"DotRepr\" values,\n\              \the generated Dot code should be identical."  test_printParseID :: Test test_printParseID-  = Test { name       = "Printing and Parsing DotGraphs"+  = Test { name       = "Printing and Parsing DotReprs"          , lookupName = "printparseid"          , desc       = dsc-         , test       = quickCheckResult prop-         }-    where-      prop :: DotGraph Int -> Bool-      prop = prop_printParseID--      dsc = "The graphviz library should be able to parse back in its own\n\-             \generated Dot code.  This test aims to determine the validity\n\-             \of this for the overall \"DotGraph Int\" values."--test_printParseGID :: Test-test_printParseGID-  = Test { name       = "Printing and Parsing Generalised DotGraphs"-         , lookupName = "printparseidg"-         , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = tsts          }-    where-      prop :: GDotGraph Int -> Bool-      prop = prop_printParseID+  where+    tsts :: [IO Result]+    tsts = [ qCheck (prop_printParseID :: DotGraph    Int -> Bool)+           , qCheck (prop_printParseID :: G.DotGraph  Int -> Bool)+           , qCheck (prop_printParseID :: Gr.DotGraph Int -> Bool)+           ] -      dsc = "The graphviz library should be able to parse back in its own\n\-             \generated Dot code.  This test aims to determine the validity\n\-             \of this for the overall \"GDotGraph Int\" values."+    dsc = "The graphviz library should be able to parse back in its own\n\+           \generated Dot code for any \"DotRepr\" instance"  test_preProcessingID :: Test test_preProcessingID   = Test { name       = "Pre-processing Dot code"          , lookupName = "preprocessing"          , desc       = dsc-         , test       = quickCheckResult prop-         }-    where-      prop :: DotGraph Int -> Bool-      prop = prop_preProcessingID--      dsc = "When parsing Dot code, some pre-processing is done to remove items\n\-             \such as comments and to join together multi-line strings.  This\n\-             \test verifies that this pre-processing doesn't affect actual\n\-             \Dot code by running the pre-processor on generated Dot code.\n\n\-             \This test is not run on generalised Dot graphs as if it works for\n\-             \normal dot graphs then it should also work for generalised ones."---- | This test is not valid for use until valid DotGraphs can be generated.-test_parsePrettyID :: Test-test_parsePrettyID-  = Test { name       = "Parsing pretty-printed code"-         , lookupName = "parsepretty"-         , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = [qCheck prop]          }-    where-      prop :: DotGraph Int -> Bool-      prop = prop_parsePrettyID+  where+    prop :: DotGraph Int -> Bool+    prop = prop_preProcessingID -      dsc = "By default, the graphviz library doesn't produce readable Dot\n\-             \code to ensure that lines aren't truncated, etc.  This test\n\-             \ensures that the pretty-printing functions produce Dot code\n\-             \that is still parseable (which should also help ensure that\n\-             \ \"Real-World\" Dot code is also parseable)."+    dsc = "When parsing Dot code, some pre-processing is done to remove items\n\+           \such as comments and to join together multi-line strings.  This\n\+           \test verifies that this pre-processing doesn't affect actual\n\+           \Dot code by running the pre-processor on generated Dot code.\n\n\+           \This test is not run on generalised Dot graphs as if it works for\n\+           \normal dot graphs then it should also work for generalised ones."  test_dotizeAugment :: Test test_dotizeAugment   = Test { name       = "Augmenting FGL Graphs"          , lookupName = "augment"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = [qCheck prop]          }-    where-      prop :: Gr Char Double -> Bool-      prop = prop_dotizeAugment+  where+    prop :: Gr Char Double -> Bool+    prop = prop_dotizeAugment -      dsc = "The various Graph to Graph functions in Data.GraphViz should\n\-             \only _augment_ the graph labels and not change the graphs\n\-             \themselves.  This test compares the original graphs to these\n\-             \augmented graphs and verifies that they are the same."+    dsc = "The various Graph to Graph functions in Data.GraphViz should\n\+           \only _augment_ the graph labels and not change the graphs\n\+           \themselves.  This test compares the original graphs to these\n\+           \augmented graphs and verifies that they are the same."  test_dotizeAugmentUniq :: Test test_dotizeAugmentUniq   = Test { name       = "Unique edges in augmented FGL Graphs"          , lookupName = "augmentuniq"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = [qCheck prop]          }-    where-      prop :: Gr Char Double -> Bool-      prop = prop_dotizeAugmentUniq+  where+    prop :: Gr Char Double -> Bool+    prop = prop_dotizeAugmentUniq -      dsc = "When augmenting a graph with multiple edges, as long as no\n\-             \Attributes are provided that override the default settings,\n\-             \then each edge between two nodes should have a unique position\n\-             \Attribute, etc."+    dsc = "When augmenting a graph with multiple edges, as long as no\n\+           \Attributes are provided that override the default settings,\n\+           \then each edge between two nodes should have a unique position\n\+           \Attribute, etc."  test_findAllNodes :: Test test_findAllNodes-  = Test { name       = "Ensure all nodes are found in a DotGraph"+  = Test { name       = "Ensure all nodes are found in a DotRepr"          , lookupName = "findnodes"          , desc       = dsc-         , test       = quickCheckResult prop-         }-    where-      prop :: Gr () () -> Bool-      prop = prop_findAllNodes--      dsc = "nodeInformation should find all nodes in a DotGraph;\n\-             \this is tested by converting an FGL graph and comparing\n\-             \the nodes it should have to those that are found."--test_findAllNodesG :: Test-test_findAllNodesG-  = Test { name       = "Ensure all nodes are found in a GDotGraph"-         , lookupName = "findnodesg"-         , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = map qCheck props          }-    where-      prop :: Gr () () -> Bool-      prop = prop_findAllNodesG+  where+    props :: [Gr () () -> Bool]+    props = testAllGraphTypes prop_findAllNodes -      dsc = "nodeInformation should find all nodes in a GDotGraph;\n\-             \this is tested by converting an FGL graph and comparing\n\-             \the nodes it should have to those that are found."+    dsc = "nodeInformation should find all nodes in a DotRepr;\n\+           \this is tested by converting an FGL graph and comparing\n\+           \the nodes it should have to those that are found."  test_findAllNodesE :: Test test_findAllNodesE-  = Test { name       = "Ensure all nodes are found in a node-less DotGraph"+  = Test { name       = "Ensure all nodes are found in a node-less DotRepr"          , lookupName = "findedgelessnodes"          , desc       = dsc-         , test       = quickCheckResult prop-         }-    where-      prop :: Gr () () -> Bool-      prop = prop_findAllNodesE--      dsc = "nodeInformation should find all nodes in a DotGraph,\n\-             \even if there are no explicit nodes in that graph.\n\-             \This is tested by converting an FGL graph and comparing\n\-             \the nodes it should have to those that are found."--test_findAllNodesEG :: Test-test_findAllNodesEG-  = Test { name       = "Ensure all nodes are found in a node-less GDotGraph"-         , lookupName = "findedgelessnodesg"-         , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = map qCheck props          }-    where-      prop :: Gr () () -> Bool-      prop = prop_findAllNodesEG+  where+    props :: [Gr () () -> Bool]+    props = testAllGraphTypes prop_findAllNodesE -      dsc = "nodeInformation should find all nodes in a GDotGraph,\n\-             \even if there are no explicit nodes in that graph.\n\-             \This is tested by converting an FGL graph and comparing\n\-             \the nodes it should have to those that are found."+    dsc = "nodeInformation should find all nodes in a DotRepr,\n\+           \even if there are no explicit nodes in that graph.\n\+           \This is tested by converting an FGL graph and comparing\n\+           \the nodes it should have to those that are found."  test_findAllEdges :: Test test_findAllEdges-  = Test { name       = "Ensure all edges are found in a DotGraph"+  = Test { name       = "Ensure all edges are found in a DotRepr"          , lookupName = "findedges"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = map qCheck props          }-    where-      prop :: Gr () () -> Bool-      prop = prop_findAllEdges+  where+    props :: [Gr () () -> Bool]+    props = testAllGraphTypes prop_findAllEdges -      dsc = "nodeInformation should find all edges in a DotGraph;\n\-             \this is tested by converting an FGL graph and comparing\n\-             \the edges it should have to those that are found."+    dsc = "nodeInformation should find all edges in a DotRepr;\n\+           \this is tested by converting an FGL graph and comparing\n\+           \the edges it should have to those that are found." -test_findAllEdgesG :: Test-test_findAllEdgesG-  = Test { name       = "Ensure all edges are found in a GDotGraph"-         , lookupName = "findedgesg"+test_noGraphInfo :: Test+test_noGraphInfo+  = Test { name       = "Plain DotReprs should have no structural information"+         , lookupName = "nographinfo"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = map qCheck props          }-    where-      prop :: Gr () () -> Bool-      prop = prop_findAllEdgesG+  where+    props :: [Gr () () -> Bool]+    props = testAllGraphTypes prop_noGraphInfo -      dsc = "nodeInformation should find all edges in a GDotGraph;\n\-             \this is tested by converting an FGL graph and comparing\n\-             \the edges it should have to those that are found."+    dsc = "When converting a Graph to a DotRepr, there should be no\n\+           \clusters or global attributes." -test_noGraphInfo :: Test-test_noGraphInfo-  = Test { name       = "Plain DotGraphs should have no structural information"-         , lookupName = "nographinfo"+test_canonicalise :: Test+test_canonicalise+  = Test { name       = "Canonicalisation should be idempotent"+         , lookupName = "canonicalise"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = [qCheck prop]          }-    where-      prop :: Gr () () -> Bool-      prop = prop_noGraphInfo+  where+    prop :: DotGraph Int -> Bool+    prop = prop_canonicalise -      dsc = "When converting a Graph to a DotGraph, there should be no\n\-             \clusters or global attributes."+    dsc = "Repeated application of canonicalise shouldn't have any further affect." -test_noGraphInfoG :: Test-test_noGraphInfoG-  = Test { name       = "Plain GDotGraphs should have no structural information"-         , lookupName = "nographinfog"+test_transitive :: Test+test_transitive+  = Test { name       = "Transitive reduction should be idempotent"+         , lookupName = "transitive"          , desc       = dsc-         , test       = quickCheckResult prop+         , tests      = [qCheck prop]          }-    where-      prop :: Gr () () -> Bool-      prop = prop_noGraphInfoG+  where+    prop :: DotGraph Int -> Bool+    prop = prop_transitive -      dsc = "When converting a Graph to a GDotGraph, there should be no\n\-             \clusters or global attributes."+    dsc = "Repeated application of transitiveReduction shouldn't have any further affect."++-- -----------------------------------------------------------------------------++-- | Used when a property takes in a DotRepr as the first argument to+--   indicate which instance it should test via 'fromCanonical'.+testAllGraphTypes      :: (Testable prop)+                          => (forall dg. (Eq (dg Int), DotRepr dg Int) => dg Int -> prop)+                          -> [prop]+testAllGraphTypes prop = [ prop (undefined :: DotGraph Int)+                         , prop (undefined :: G.DotGraph Int)+                         , prop (undefined :: Gr.DotGraph Int)+                         ]
Data/GraphViz/Testing/Instances.hs view
@@ -1,1244 +1,27 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}--{- |-   Module      : Data.GraphViz.Testing.Instances-   Description : 'Arbitrary' instances for graphviz.-   Copyright   : (c) Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines the 'Arbitrary' instances for the various types-   used to represent Graphviz Dot code.--   Note that they do not generally generate /sensible/ values for the-   various types; in particular, there's no guarantee that the-   'Attributes' chosen for a particular value type are indeed legal-   for that type.--}-module Data.GraphViz.Testing.Instances() where--import Data.GraphViz.Parsing(isNumString)--import Data.GraphViz.Attributes-import Data.GraphViz.Attributes.Internal(compassLookup)-import Data.GraphViz.Types-import Data.GraphViz.Types.Generalised-import Data.GraphViz.Util(bool)--import Test.QuickCheck--import Data.List(nub, delete, groupBy)-import qualified Data.Sequence as Seq-import qualified Data.Map as Map-import Control.Monad(liftM, liftM2, liftM3, liftM4)---- -------------------------------------------------------------------------------- Defining Arbitrary instances for the overall types--instance (Eq a, Arbitrary a) => Arbitrary (DotGraph a) where-  arbitrary = liftM4 DotGraph arbitrary arbitrary arbitrary arbitrary--  shrink (DotGraph str dir gid stmts) = map (DotGraph str dir gid)-                                        $ shrink stmts--instance Arbitrary GraphID where-  arbitrary = oneof [ liftM Str arbString-                    , liftM Int arbitrary-                    , liftM Dbl $ suchThat arbitrary notInt-                    ]--  shrink (Str s) = map Str $ shrinkString s-  shrink (Int i) = map Int $ shrink i-  shrink (Dbl d) = map Dbl $ filter notInt $ shrink d--instance (Eq a, Arbitrary a) => Arbitrary (DotStatements a) where-  arbitrary = sized (arbDS True)--  shrink ds@(DotStmts gas sgs ns es) = do gas' <- shrinkL gas-                                          sgs' <- shrinkL sgs-                                          ns' <- shrinkL ns-                                          es' <- shrinkL es-                                          returnCheck ds-                                            $ DotStmts gas' sgs' ns' es'---- | If 'True', generate 'DotSubGraph's; otherwise don't.-arbDS           :: (Arbitrary a, Eq a) => Bool -> Int -> Gen (DotStatements a)-arbDS haveSGs s = liftM4 DotStmts arbitrary genSGs arbitrary arbitrary-  where-    s' = min s 2-    genSGs = if haveSGs-             then resize s' arbitrary-             else return []--instance Arbitrary GlobalAttributes where-  arbitrary = oneof [ liftM GraphAttrs arbList-                    , liftM NodeAttrs  arbList-                    , liftM EdgeAttrs  arbList-                    ]--  shrink (GraphAttrs atts) = map GraphAttrs $ nonEmptyShrinks atts-  shrink (NodeAttrs  atts) = map NodeAttrs  $ nonEmptyShrinks atts-  shrink (EdgeAttrs  atts) = map EdgeAttrs  $ nonEmptyShrinks atts--instance (Eq a, Arbitrary a) => Arbitrary (DotSubGraph a) where-  arbitrary = liftM3 DotSG arbitrary arbitrary (sized $ arbDS False)--  shrink (DotSG isCl mid stmts) = map (DotSG isCl mid) $ shrink stmts--instance (Arbitrary a) => Arbitrary (DotNode a) where-  arbitrary = liftM2 DotNode arbitrary arbitrary--  shrink (DotNode n as) = map (DotNode n) $ shrinkList as--instance (Arbitrary a) => Arbitrary (DotEdge a) where-  arbitrary = liftM4 DotEdge arbitrary arbitrary arbitrary arbitrary--  shrink (DotEdge f t isDir as) = map (DotEdge f t isDir) $ shrinkList as---- -------------------------------------------------------------------------------- Defining Arbitrary instances for the generalised types--instance (Eq a, Arbitrary a) => Arbitrary (GDotGraph a) where-  arbitrary = liftM4 GDotGraph arbitrary arbitrary arbitrary genGDStmts--  shrink (GDotGraph str dir gid stmts) = map (GDotGraph str dir gid)-                                         $ shrinkGDStmts stmts--genGDStmts :: (Eq a, Arbitrary a) => Gen (GDotStatements a)-genGDStmts = sized (arbGDS True)--shrinkGDStmts :: (Eq a, Arbitrary a) => GDotStatements a -> [GDotStatements a]-shrinkGDStmts gds-  | len == 1  = map Seq.singleton . shrink $ Seq.index gds 0-  | otherwise = [gds1, gds2]-    where-      len = Seq.length gds-      -- Halve the sequence-      (gds1, gds2) = (len `div` 2) `Seq.splitAt` gds--instance (Eq a, Arbitrary a) => Arbitrary (GDotStatement a) where-  -- Don't want as many sub-graphs as nodes, etc.-  arbitrary = frequency [ (3, liftM GA arbitrary)-                        , (1, liftM SG arbitrary)-                        , (5, liftM DN arbitrary)-                        , (7, liftM DE arbitrary)-                        ]--  shrink (GA ga) = map GA $ shrink ga-  shrink (SG sg) = map SG $ shrink sg-  shrink (DN dn) = map DN $ shrink dn-  shrink (DE de) = map DE $ shrink de---- | If 'True', generate 'GDotSubGraph's; otherwise don't.-arbGDS           :: (Arbitrary a, Eq a) => Bool -> Int -> Gen (GDotStatements a)-arbGDS haveSGs s = liftM (Seq.fromList . checkSGs) (resize s' arbList)-  where-    checkSGs = if haveSGs-               then id-               else filter notSG-    notSG SG{} = False-    notSG _    = True--    s' = min s 10---instance (Eq a, Arbitrary a) => Arbitrary (GDotSubGraph a) where-  arbitrary = liftM3 GDotSG arbitrary arbitrary (sized $ arbGDS False)--  shrink (GDotSG isCl mid stmts) = map (GDotSG isCl mid) $ shrinkGDStmts stmts---- -------------------------------------------------------------------------------- Defining Arbitrary instances for Attributes--instance Arbitrary Attribute where-    arbitrary = oneof [ liftM Damping arbitrary-                      , liftM K arbitrary-                      , liftM URL arbString-                      , liftM ArrowHead arbitrary-                      , liftM ArrowSize arbitrary-                      , liftM ArrowTail arbitrary-                      , liftM Aspect arbitrary-                      , liftM Bb arbitrary-                      , liftM BgColor arbitrary-                      , liftM Center arbitrary-                      , liftM Charset arbString-                      , liftM ClusterRank arbitrary-                      , liftM ColorScheme arbitrary-                      , liftM Color arbList-                      , liftM Comment arbString-                      , liftM Compound arbitrary-                      , liftM Concentrate arbitrary-                      , liftM Constraint arbitrary-                      , liftM Decorate arbitrary-                      , liftM DefaultDist arbitrary-                      , liftM Dimen arbitrary-                      , liftM Dim arbitrary-                      , liftM Dir arbitrary-                      , liftM DirEdgeConstraints arbitrary-                      , liftM Distortion arbitrary-                      , liftM DPI arbitrary-                      , liftM EdgeURL arbString-                      , liftM EdgeTarget arbString-                      , liftM EdgeTooltip arbString-                      , liftM Epsilon arbitrary-                      , liftM ESep arbitrary-                      , liftM FillColor arbitrary-                      , liftM FixedSize arbitrary-                      , liftM FontColor arbitrary-                      , liftM FontName arbString-                      , liftM FontNames arbString-                      , liftM FontPath arbString-                      , liftM FontSize arbitrary-                      , liftM Group arbString-                      , liftM HeadURL arbString-                      , liftM HeadClip arbitrary-                      , liftM HeadLabel arbitrary-                      , liftM HeadPort arbitrary-                      , liftM HeadTarget arbString-                      , liftM HeadTooltip arbString-                      , liftM Height arbitrary-                      , liftM ID arbitrary-                      , liftM Image arbString-                      , liftM ImageScale arbitrary-                      , liftM LabelURL arbString-                      , liftM LabelAngle arbitrary-                      , liftM LabelDistance arbitrary-                      , liftM LabelFloat arbitrary-                      , liftM LabelFontColor arbitrary-                      , liftM LabelFontName arbString-                      , liftM LabelFontSize arbitrary-                      , liftM LabelJust arbitrary-                      , liftM LabelLoc arbitrary-                      , liftM LabelTarget arbString-                      , liftM LabelTooltip arbString-                      , liftM Label arbitrary-                      , liftM Landscape arbitrary-                      , liftM LayerSep arbString-                      , liftM Layers arbitrary-                      , liftM Layer arbitrary-                      , liftM Layout arbString-                      , liftM Len arbitrary-                      , liftM LevelsGap arbitrary-                      , liftM Levels arbitrary-                      , liftM LHead arbString-                      , liftM LPos arbitrary-                      , liftM LTail arbString-                      , liftM Margin arbitrary-                      , liftM MaxIter arbitrary-                      , liftM MCLimit arbitrary-                      , liftM MinDist arbitrary-                      , liftM MinLen arbitrary-                      , liftM Model arbitrary-                      , liftM Mode arbitrary-                      , liftM Mosek arbitrary-                      , liftM NodeSep arbitrary-                      , liftM NoJustify arbitrary-                      , liftM Normalize arbitrary-                      , liftM Nslimit1 arbitrary-                      , liftM Nslimit arbitrary-                      , liftM Ordering arbString-                      , liftM Orientation arbitrary-                      , liftM OutputOrder arbitrary-                      , liftM OverlapScaling arbitrary-                      , liftM Overlap arbitrary-                      , liftM PackMode arbitrary-                      , liftM Pack arbitrary-                      , liftM Pad arbitrary-                      , liftM PageDir arbitrary-                      , liftM Page arbitrary-                      , liftM PenColor arbitrary-                      , liftM PenWidth arbitrary-                      , liftM Peripheries arbitrary-                      , liftM Pin arbitrary-                      , liftM Pos arbitrary-                      , liftM QuadTree arbitrary-                      , liftM Quantum arbitrary-                      , liftM RankDir arbitrary-                      , liftM RankSep arbList-                      , liftM Rank arbitrary-                      , liftM Ratio arbitrary-                      , liftM Rects arbitrary-                      , liftM Regular arbitrary-                      , liftM ReMinCross arbitrary-                      , liftM RepulsiveForce arbitrary-                      , liftM Root arbitrary-                      , liftM Rotate arbitrary-                      , liftM SameHead arbString-                      , liftM SameTail arbString-                      , liftM SamplePoints arbitrary-                      , liftM SearchSize arbitrary-                      , liftM Sep arbitrary-                      , liftM ShapeFile arbString-                      , liftM Shape arbitrary-                      , liftM ShowBoxes arbitrary-                      , liftM Sides arbitrary-                      , liftM Size arbitrary-                      , liftM Skew arbitrary-                      , liftM Smoothing arbitrary-                      , liftM SortV arbitrary-                      , liftM Splines arbitrary-                      , liftM Start arbitrary-                      , liftM StyleSheet arbString-                      , liftM Style arbList-                      , liftM TailURL arbString-                      , liftM TailClip arbitrary-                      , liftM TailLabel arbitrary-                      , liftM TailPort arbitrary-                      , liftM TailTarget arbString-                      , liftM TailTooltip arbString-                      , liftM Target arbString-                      , liftM Tooltip arbString-                      , liftM TrueColor arbitrary-                      , liftM Vertices arbList-                      , liftM ViewPort arbitrary-                      , liftM VoroMargin arbitrary-                      , liftM Weight arbitrary-                      , liftM Width arbitrary-                      , liftM Z arbitrary-                      , liftM2 UnknownAttribute (suchThat arbIDString validUnknown) arbString-                      ]--    shrink (Damping v)            = map Damping             $ shrink v-    shrink (K v)                  = map K                   $ shrink v-    shrink (URL v)                = map URL                 $ shrinkString v-    shrink (ArrowHead v)          = map ArrowHead           $ shrink v-    shrink (ArrowSize v)          = map ArrowSize           $ shrink v-    shrink (ArrowTail v)          = map ArrowTail           $ shrink v-    shrink (Aspect v)             = map Aspect              $ shrink v-    shrink (Bb v)                 = map Bb                  $ shrink v-    shrink (BgColor v)            = map BgColor             $ shrink v-    shrink (Center v)             = map Center              $ shrink v-    shrink (Charset v)            = map Charset             $ shrinkString v-    shrink (ClusterRank v)        = map ClusterRank         $ shrink v-    shrink (ColorScheme v)        = map ColorScheme         $ shrink v-    shrink (Color v)              = map Color               $ nonEmptyShrinks v-    shrink (Comment v)            = map Comment             $ shrinkString v-    shrink (Compound v)           = map Compound            $ shrink v-    shrink (Concentrate v)        = map Concentrate         $ shrink v-    shrink (Constraint v)         = map Constraint          $ shrink v-    shrink (Decorate v)           = map Decorate            $ shrink v-    shrink (DefaultDist v)        = map DefaultDist         $ shrink v-    shrink (Dimen v)              = map Dimen               $ shrink v-    shrink (Dim v)                = map Dim                 $ shrink v-    shrink (Dir v)                = map Dir                 $ shrink v-    shrink (DirEdgeConstraints v) = map DirEdgeConstraints  $ shrink v-    shrink (Distortion v)         = map Distortion          $ shrink v-    shrink (DPI v)                = map DPI                 $ shrink v-    shrink (EdgeURL v)            = map EdgeURL             $ shrinkString v-    shrink (EdgeTarget v)         = map EdgeTarget          $ shrinkString v-    shrink (EdgeTooltip v)        = map EdgeTooltip         $ shrinkString v-    shrink (Epsilon v)            = map Epsilon             $ shrink v-    shrink (ESep v)               = map ESep                $ shrink v-    shrink (FillColor v)          = map FillColor           $ shrink v-    shrink (FixedSize v)          = map FixedSize           $ shrink v-    shrink (FontColor v)          = map FontColor           $ shrink v-    shrink (FontName v)           = map FontName            $ shrinkString v-    shrink (FontNames v)          = map FontNames           $ shrinkString v-    shrink (FontPath v)           = map FontPath            $ shrinkString v-    shrink (FontSize v)           = map FontSize            $ shrink v-    shrink (Group v)              = map Group               $ shrinkString v-    shrink (HeadURL v)            = map HeadURL             $ shrinkString v-    shrink (HeadClip v)           = map HeadClip            $ shrink v-    shrink (HeadLabel v)          = map HeadLabel           $ shrink v-    shrink (HeadPort v)           = map HeadPort            $ shrink v-    shrink (HeadTarget v)         = map HeadTarget          $ shrinkString v-    shrink (HeadTooltip v)        = map HeadTooltip         $ shrinkString v-    shrink (Height v)             = map Height              $ shrink v-    shrink (ID v)                 = map ID                  $ shrink v-    shrink (Image v)              = map Image               $ shrinkString v-    shrink (ImageScale v)         = map ImageScale          $ shrink v-    shrink (LabelURL v)           = map LabelURL            $ shrinkString v-    shrink (LabelAngle v)         = map LabelAngle          $ shrink v-    shrink (LabelDistance v)      = map LabelDistance       $ shrink v-    shrink (LabelFloat v)         = map LabelFloat          $ shrink v-    shrink (LabelFontColor v)     = map LabelFontColor      $ shrink v-    shrink (LabelFontName v)      = map LabelFontName       $ shrinkString v-    shrink (LabelFontSize v)      = map LabelFontSize       $ shrink v-    shrink (LabelJust v)          = map LabelJust           $ shrink v-    shrink (LabelLoc v)           = map LabelLoc            $ shrink v-    shrink (LabelTarget v)        = map LabelTarget         $ shrinkString v-    shrink (LabelTooltip v)       = map LabelTooltip        $ shrinkString v-    shrink (Label v)              = map Label               $ shrink v-    shrink (Landscape v)          = map Landscape           $ shrink v-    shrink (LayerSep v)           = map LayerSep            $ shrinkString v-    shrink (Layers v)             = map Layers              $ shrink v-    shrink (Layer v)              = map Layer               $ shrink v-    shrink (Layout v)             = map Layout              $ shrinkString v-    shrink (Len v)                = map Len                 $ shrink v-    shrink (LevelsGap v)          = map LevelsGap           $ shrink v-    shrink (Levels v)             = map Levels              $ shrink v-    shrink (LHead v)              = map LHead               $ shrinkString v-    shrink (LPos v)               = map LPos                $ shrink v-    shrink (LTail v)              = map LTail               $ shrinkString v-    shrink (Margin v)             = map Margin              $ shrink v-    shrink (MaxIter v)            = map MaxIter             $ shrink v-    shrink (MCLimit v)            = map MCLimit             $ shrink v-    shrink (MinDist v)            = map MinDist             $ shrink v-    shrink (MinLen v)             = map MinLen              $ shrink v-    shrink (Model v)              = map Model               $ shrink v-    shrink (Mode v)               = map Mode                $ shrink v-    shrink (Mosek v)              = map Mosek               $ shrink v-    shrink (NodeSep v)            = map NodeSep             $ shrink v-    shrink (NoJustify v)          = map NoJustify           $ shrink v-    shrink (Normalize v)          = map Normalize           $ shrink v-    shrink (Nslimit1 v)           = map Nslimit1            $ shrink v-    shrink (Nslimit v)            = map Nslimit             $ shrink v-    shrink (Ordering v)           = map Ordering            $ shrinkString v-    shrink (Orientation v)        = map Orientation         $ shrink v-    shrink (OutputOrder v)        = map OutputOrder         $ shrink v-    shrink (OverlapScaling v)     = map OverlapScaling      $ shrink v-    shrink (Overlap v)            = map Overlap             $ shrink v-    shrink (PackMode v)           = map PackMode            $ shrink v-    shrink (Pack v)               = map Pack                $ shrink v-    shrink (Pad v)                = map Pad                 $ shrink v-    shrink (PageDir v)            = map PageDir             $ shrink v-    shrink (Page v)               = map Page                $ shrink v-    shrink (PenColor v)           = map PenColor            $ shrink v-    shrink (PenWidth v)           = map PenWidth            $ shrink v-    shrink (Peripheries v)        = map Peripheries         $ shrink v-    shrink (Pin v)                = map Pin                 $ shrink v-    shrink (Pos v)                = map Pos                 $ shrink v-    shrink (QuadTree v)           = map QuadTree            $ shrink v-    shrink (Quantum v)            = map Quantum             $ shrink v-    shrink (RankDir v)            = map RankDir             $ shrink v-    shrink (RankSep v)            = map RankSep             $ nonEmptyShrinks v-    shrink (Rank v)               = map Rank                $ shrink v-    shrink (Ratio v)              = map Ratio               $ shrink v-    shrink (Rects v)              = map Rects               $ shrink v-    shrink (Regular v)            = map Regular             $ shrink v-    shrink (ReMinCross v)         = map ReMinCross          $ shrink v-    shrink (RepulsiveForce v)     = map RepulsiveForce      $ shrink v-    shrink (Root v)               = map Root                $ shrink v-    shrink (Rotate v)             = map Rotate              $ shrink v-    shrink (SameHead v)           = map SameHead            $ shrinkString v-    shrink (SameTail v)           = map SameTail            $ shrinkString v-    shrink (SamplePoints v)       = map SamplePoints        $ shrink v-    shrink (SearchSize v)         = map SearchSize          $ shrink v-    shrink (Sep v)                = map Sep                 $ shrink v-    shrink (ShapeFile v)          = map ShapeFile           $ shrinkString v-    shrink (Shape v)              = map Shape               $ shrink v-    shrink (ShowBoxes v)          = map ShowBoxes           $ shrink v-    shrink (Sides v)              = map Sides               $ shrink v-    shrink (Size v)               = map Size                $ shrink v-    shrink (Skew v)               = map Skew                $ shrink v-    shrink (Smoothing v)          = map Smoothing           $ shrink v-    shrink (SortV v)              = map SortV               $ shrink v-    shrink (Splines v)            = map Splines             $ shrink v-    shrink (Start v)              = map Start               $ shrink v-    shrink (StyleSheet v)         = map StyleSheet          $ shrinkString v-    shrink (Style v)              = map Style               $ nonEmptyShrinks v-    shrink (TailURL v)            = map TailURL             $ shrinkString v-    shrink (TailClip v)           = map TailClip            $ shrink v-    shrink (TailLabel v)          = map TailLabel           $ shrink v-    shrink (TailPort v)           = map TailPort            $ shrink v-    shrink (TailTarget v)         = map TailTarget          $ shrinkString v-    shrink (TailTooltip v)        = map TailTooltip         $ shrinkString v-    shrink (Target v)             = map Target              $ shrinkString v-    shrink (Tooltip v)            = map Tooltip             $ shrinkString v-    shrink (TrueColor v)          = map TrueColor           $ shrink v-    shrink (Vertices v)           = map Vertices            $ nonEmptyShrinks v-    shrink (ViewPort v)           = map ViewPort            $ shrink v-    shrink (VoroMargin v)         = map VoroMargin          $ shrink v-    shrink (Weight v)             = map Weight              $ shrink v-    shrink (Width v)              = map Width               $ shrink v-    shrink (Z v)                  = map Z                   $ shrink v-    shrink (UnknownAttribute a v) = liftM2 UnknownAttribute (liftM (filter validUnknown) shrinkString a) (shrinkString v)--validUnknown                      :: String -> Bool-validUnknown "Damping"            = False-validUnknown "K"                  = False-validUnknown "URL"                = False-validUnknown "href"               = False-validUnknown "arrowhead"          = False-validUnknown "arrowsize"          = False-validUnknown "arrowtail"          = False-validUnknown "aspect"             = False-validUnknown "bb"                 = False-validUnknown "bgcolor"            = False-validUnknown "center"             = False-validUnknown "charset"            = False-validUnknown "clusterrank"        = False-validUnknown "colorscheme"        = False-validUnknown "color"              = False-validUnknown "comment"            = False-validUnknown "compound"           = False-validUnknown "concentrate"        = False-validUnknown "constraint"         = False-validUnknown "decorate"           = False-validUnknown "defaultdist"        = False-validUnknown "dimen"              = False-validUnknown "dim"                = False-validUnknown "dir"                = False-validUnknown "diredgeconstraints" = False-validUnknown "distortion"         = False-validUnknown "dpi"                = False-validUnknown "resolution"         = False-validUnknown "edgeURL"            = False-validUnknown "edgehref"           = False-validUnknown "edgetarget"         = False-validUnknown "edgetooltip"        = False-validUnknown "epsilon"            = False-validUnknown "esep"               = False-validUnknown "fillcolor"          = False-validUnknown "fixedsize"          = False-validUnknown "fontcolor"          = False-validUnknown "fontname"           = False-validUnknown "fontnames"          = False-validUnknown "fontpath"           = False-validUnknown "fontsize"           = False-validUnknown "group"              = False-validUnknown "headURL"            = False-validUnknown "headhref"           = False-validUnknown "headclip"           = False-validUnknown "headlabel"          = False-validUnknown "headport"           = False-validUnknown "headtarget"         = False-validUnknown "headtooltip"        = False-validUnknown "height"             = False-validUnknown "id"                 = False-validUnknown "image"              = False-validUnknown "imagescale"         = False-validUnknown "labelURL"           = False-validUnknown "labelhref"          = False-validUnknown "labelangle"         = False-validUnknown "labeldistance"      = False-validUnknown "labelfloat"         = False-validUnknown "labelfontcolor"     = False-validUnknown "labelfontname"      = False-validUnknown "labelfontsize"      = False-validUnknown "labeljust"          = False-validUnknown "labelloc"           = False-validUnknown "labeltarget"        = False-validUnknown "labeltooltip"       = False-validUnknown "label"              = False-validUnknown "landscape"          = False-validUnknown "layersep"           = False-validUnknown "layers"             = False-validUnknown "layer"              = False-validUnknown "layout"             = False-validUnknown "len"                = False-validUnknown "levelsgap"          = False-validUnknown "levels"             = False-validUnknown "lhead"              = False-validUnknown "lp"                 = False-validUnknown "ltail"              = False-validUnknown "margin"             = False-validUnknown "maxiter"            = False-validUnknown "mclimit"            = False-validUnknown "mindist"            = False-validUnknown "minlen"             = False-validUnknown "model"              = False-validUnknown "mode"               = False-validUnknown "mosek"              = False-validUnknown "nodesep"            = False-validUnknown "nojustify"          = False-validUnknown "normalize"          = False-validUnknown "nslimit1"           = False-validUnknown "nslimit"            = False-validUnknown "ordering"           = False-validUnknown "orientation"        = False-validUnknown "outputorder"        = False-validUnknown "overlap_scaling"    = False-validUnknown "overlap"            = False-validUnknown "packmode"           = False-validUnknown "pack"               = False-validUnknown "pad"                = False-validUnknown "pagedir"            = False-validUnknown "page"               = False-validUnknown "pencolor"           = False-validUnknown "penwidth"           = False-validUnknown "peripheries"        = False-validUnknown "pin"                = False-validUnknown "pos"                = False-validUnknown "quadtree"           = False-validUnknown "quantum"            = False-validUnknown "rankdir"            = False-validUnknown "ranksep"            = False-validUnknown "rank"               = False-validUnknown "ratio"              = False-validUnknown "rects"              = False-validUnknown "regular"            = False-validUnknown "remincross"         = False-validUnknown "repulsiveforce"     = False-validUnknown "root"               = False-validUnknown "rotate"             = False-validUnknown "samehead"           = False-validUnknown "sametail"           = False-validUnknown "samplepoints"       = False-validUnknown "searchsize"         = False-validUnknown "sep"                = False-validUnknown "shapefile"          = False-validUnknown "shape"              = False-validUnknown "showboxes"          = False-validUnknown "sides"              = False-validUnknown "size"               = False-validUnknown "skew"               = False-validUnknown "smoothing"          = False-validUnknown "sortv"              = False-validUnknown "splines"            = False-validUnknown "start"              = False-validUnknown "stylesheet"         = False-validUnknown "style"              = False-validUnknown "tailURL"            = False-validUnknown "tailhref"           = False-validUnknown "tailclip"           = False-validUnknown "taillabel"          = False-validUnknown "tailport"           = False-validUnknown "tailtarget"         = False-validUnknown "tailtooltip"        = False-validUnknown "target"             = False-validUnknown "tooltip"            = False-validUnknown "truecolor"          = False-validUnknown "vertices"           = False-validUnknown "viewport"           = False-validUnknown "voro_margin"        = False-validUnknown "weight"             = False-validUnknown "width"              = False-validUnknown "z"                  = False-validUnknown _                    = True-{- delete to here -}--instance Arbitrary ArrowType where-  arbitrary = liftM AType-              -- Arrow specifications have between 1 and 4 elements.-              $ sized (\ s -> resize (min s 4) arbList)--  shrink (AType as) = map AType $ nonEmptyShrinks as--instance Arbitrary ArrowShape where-  arbitrary = arbBounded--instance Arbitrary ArrowModifier where-  arbitrary = liftM2 ArrMod arbitrary arbitrary--instance Arbitrary ArrowFill where-  arbitrary = arbBounded--instance Arbitrary ArrowSide where-  arbitrary = arbBounded--instance Arbitrary AspectType where-  arbitrary = oneof [ liftM  RatioOnly arbitrary-                    , liftM2 RatioPassCount arbitrary posArbitrary-                    ]--  shrink (RatioOnly d) = map RatioOnly $ shrink d-  shrink (RatioPassCount d i) = do ds <- shrink d-                                   is <- shrink i-                                   return $ RatioPassCount ds is--instance Arbitrary Rect where-  arbitrary = liftM2 Rect point2D point2D--  shrink (Rect p1 p2) = do p1s <- shrink p1-                           p2s <- shrink p2-                           return $ Rect p1s p2s--instance Arbitrary Point where-  -- Pretty sure points have to be positive...-  arbitrary = liftM4 Point posArbitrary posArbitrary posZ arbitrary-    where-      posZ = frequency [(1, return Nothing), (3, liftM Just posArbitrary)]--  shrink p = do x' <- shrink $ xCoord p-                y' <- shrink $ yCoord p-                z' <- shrinkM $ zCoord p-                return $ Point x' y' z' False--point2D :: Gen Point-point2D = liftM2 createPoint posArbitrary posArbitrary--instance Arbitrary ClusterMode where-  arbitrary = arbBounded--instance Arbitrary DirType where-  arbitrary = arbBounded--instance Arbitrary DEConstraints where-  arbitrary = arbBounded--instance Arbitrary DPoint where-  arbitrary = oneof [ liftM DVal arbitrary-                    , liftM PVal point2D-                    ]--  shrink (DVal d) = map DVal $ shrink d-  shrink (PVal p) = map PVal $ shrink p--instance Arbitrary ModeType where-  arbitrary = arbBounded--instance Arbitrary Model where-  arbitrary = arbBounded--instance Arbitrary Label where-  arbitrary = oneof [ liftM StrLabel arbString-                    , liftM HtmlLabel arbitrary-                    , liftM RecordLabel $ suchThat arbList notStr-                    ]--  shrink (StrLabel str)   = map StrLabel $ shrinkString str-  shrink (HtmlLabel html) = map HtmlLabel $ shrink html-  shrink (RecordLabel fs) = map RecordLabel . filter notStr $ shrinkList fs--notStr                :: RecordFields -> Bool-notStr [FieldLabel{}] = False -- Just in case-notStr _              = True--arbField     :: Bool -> Int -> Gen RecordField-arbField b s = resize s'-               . oneof-               . bool id ((:) genFlipped) b-               $ [ liftM2 LabelledTarget arbitrary arbString-                 , liftM PortName arbitrary-                 , liftM FieldLabel arbString-                 ]-  where-    genFlipped = liftM FlipFields-                 $ listOf1 (sized $ arbField False)-    s' = min 3 s--instance Arbitrary RecordField where-  arbitrary = sized (arbField True)--  shrink (LabelledTarget f l) = [PortName f, FieldLabel l]-  shrink (PortName f)         = map PortName $ shrink f-  shrink (FieldLabel l)       = map FieldLabel $ shrinkString l-  shrink (FlipFields fs)      = map FlipFields $ shrinkList fs--instance Arbitrary Overlap where-  arbitrary = oneof [ simpleOverlap-                    , liftM PrismOverlap arbitrary-                    ]-    where-      -- Have to do this by hand since Overlap can't have Bounded and-      -- Enum instances-      simpleOverlap = elements [ KeepOverlaps-                               , RemoveOverlaps-                               , ScaleOverlaps-                               , ScaleXYOverlaps-                               , CompressOverlap-                               , VpscOverlap-                               , IpsepOverlap-                               ]--  shrink (PrismOverlap mi) = map PrismOverlap $ shrink mi-  shrink _                 = []--instance Arbitrary LayerList where-  arbitrary = liftM LL $ listOf1 arbName-    where-      arbName = suchThat arbitrary isLayerName--      isLayerName LRName{} = True-      isLayerName _        = False--  shrink (LL ll) = map LL $ nonEmptyShrinks ll--instance Arbitrary LayerRange where-  arbitrary = oneof [ liftM LRID arbitrary-                    , liftM2 LRS arbitrary arbitrary-                    ]--  shrink (LRID nm)   = map LRID $ shrink nm-  shrink (LRS l1 l2) = [LRID l1, LRID l2]--instance Arbitrary LayerID where-  arbitrary = oneof [ return AllLayers-                    , liftM LRInt arbitrary-                    , liftM LRName $ suchThat arbLayerName lrnameCheck-                    ]--  shrink AllLayers   = []-  shrink (LRInt i)   = map LRInt $ shrink i-  shrink (LRName nm) = map LRName-                       . filter lrnameCheck-                       $ shrinkString nm--lrnameCheck :: String -> Bool-lrnameCheck = (/=) "all"--instance Arbitrary OutputMode where-  arbitrary = arbBounded--instance Arbitrary Pack where-  arbitrary = oneof [ return DoPack-                    , return DontPack-                    , liftM PackMargin arbitrary-                    ]--  shrink (PackMargin m) = map PackMargin $ shrink m-  shrink _              = []--instance Arbitrary PackMode where-  arbitrary = oneof [ return PackNode-                    , return PackClust-                    , return PackGraph-                    , liftM3 PackArray arbitrary arbitrary arbitrary-                    ]--  shrink (PackArray c u mi) = map (PackArray c u) $ shrink mi-  shrink _                  = []--instance Arbitrary Pos where-  arbitrary = oneof [ liftM PointPos arbitrary-                      -- A single spline with only one point overall-                      -- is just a point...-                    , liftM SplinePos $ suchThat arbList validSplineList-                    ]--  shrink (PointPos p)   = map PointPos $ shrink p-  shrink (SplinePos ss) = map SplinePos . filter validSplineList-                          $ nonEmptyShrinks ss--validSplineList                              :: [Spline] -> Bool-validSplineList [Spline Nothing Nothing [_]] = False-validSplineList _                            = True--instance Arbitrary Spline where-  arbitrary = liftM3 Spline arbitrary arbitrary-              -- list of points must have length of 1 mod 3-              $ suchThat arbitrary ((==) 1 . flip mod 3 . length)--  shrink (Spline Nothing Nothing [p]) = map (Spline Nothing Nothing . return)-                                        $ shrink p-  -- We're not going to be shrinking the points in the list; just-  -- making sure that its length is === 1 mod 3-  shrink (Spline ms me ps) = do mss <- shrinkM ms-                                mes <- shrinkM me-                                pss <- rem2 ps-                                return $ Spline mss mes pss-    where--      rem1 []     = []-      rem1 (a:as) = as : map (a:) (rem1 as)--      rem2 = nub . concatMap rem1 . rem1--instance Arbitrary EdgeType where-  arbitrary = arbBounded--instance Arbitrary PageDir where-  arbitrary = arbBounded--instance Arbitrary QuadType where-  arbitrary = arbBounded--instance Arbitrary Root where-  arbitrary = oneof [ return IsCentral-                    , return NotCentral-                    , liftM NodeName arbString-                    ]--  shrink (NodeName nm) = map NodeName $ shrinkString nm-  shrink _             = []--instance Arbitrary RankType where-  arbitrary = arbBounded--instance Arbitrary RankDir where-  arbitrary = arbBounded--instance Arbitrary Shape where-  arbitrary = arbBounded--instance Arbitrary SmoothType where-  arbitrary = arbBounded--instance Arbitrary StartType where-  arbitrary = oneof [ liftM  StartStyle arbitrary-                    , liftM  StartSeed arbitrary-                    , liftM2 StartStyleSeed arbitrary arbitrary-                    ]--  shrink StartStyle{} = [] -- No shrinks for STStyle-  shrink (StartSeed ss) = map StartSeed $ shrink ss-  shrink (StartStyleSeed st ss) = map (StartStyleSeed st) $ shrink ss--instance Arbitrary STStyle where-  arbitrary = arbBounded--instance Arbitrary StyleItem where-  arbitrary = liftM2 SItem arbitrary (listOf arbStyleName)--  -- Can't use this because of what shrink on the individual strings-  -- might do.-  -- shrink (SItem sn opts) = map (SItem sn) $ shrink opts--instance Arbitrary StyleName where-  arbitrary = oneof [ defaultStyles-                    , liftM DD $ suchThat arbStyleName notDefault-                    ]-    where-      defaultStyles = elements [ Dashed-                               , Dotted-                               , Bold-                               , Invisible-                               , Filled-                               , Diagonals-                               , Rounded-                               ]-      notDefault = flip notElem [ "dashed"-                                , "dotted"-                                , "solid"-                                , "bold"-                                , "invis"-                                , "filled"-                                , "diagonals"-                                , "rounded"-                                ]--instance Arbitrary PortPos where-  arbitrary = oneof [ liftM2 LabelledPort arbitrary arbitrary-                    , liftM CompassPoint arbitrary-                    ]--  shrink (LabelledPort pn mc) = map (flip LabelledPort mc) $ shrink pn-  shrink _                    = []--instance Arbitrary CompassPoint where-  arbitrary = arbBounded--instance Arbitrary ViewPort where-  arbitrary = liftM4 VP arbitrary arbitrary arbitrary arbitrary--  shrink (VP w h z f) = case sVPs of-                          [_] -> []-                          _   -> sVPs-    where-      sVPs = do ws <- shrink w-                hs <- shrink h-                zs <- shrink z-                fs <- shrinkM f-                return $ VP ws hs zs fs--instance Arbitrary FocusType where-  arbitrary = oneof [ liftM XY arbitrary-                    , liftM NodeFocus $ suchThat arbString (all ((/=) ','))-                    ]--  shrink (XY p)          = map XY $ shrink p-  shrink (NodeFocus str) = map NodeFocus $ shrinkString str--instance Arbitrary VerticalPlacement where-  arbitrary = arbBounded--instance Arbitrary ScaleType where-  arbitrary = arbBounded--instance Arbitrary Justification where-  arbitrary = arbBounded--instance Arbitrary Ratios where-  arbitrary = oneof [ liftM AspectRatio posArbitrary-                    , namedRats-                    ]-    where-      namedRats = elements [ FillRatio-                           , CompressRatio-                           , ExpandRatio-                           , AutoRatio-                           ]--  shrink (AspectRatio r) = map (AspectRatio . fromPositive)-                           . shrink $ Positive r-  shrink _               = []--instance Arbitrary ColorScheme where-  arbitrary = oneof [ return X11-                    , liftM2 BrewerScheme arbitrary arbitrary-                    ]--  shrink (BrewerScheme nm v) = map (BrewerScheme nm) $ shrink v-  shrink _                   = []--instance Arbitrary BrewerName where-  arbitrary = arbBounded--instance Arbitrary Color where-  arbitrary = oneof [ liftM3 RGB  arbitrary arbitrary arbitrary-                    , liftM4 RGBA arbitrary arbitrary arbitrary arbitrary-                    , liftM3 HSV  zeroOne zeroOne zeroOne-                    , liftM X11Color arbitrary-                      -- Not quite right as the values can get too-                      -- high/low, but should suffice for-                      -- printing/parsing purposes.-                    , liftM BrewerColor arbitrary-                    ]-    where-      zeroOne = choose (0,1)--  shrink (RGB r g b)     = do rs <- shrink r-                              gs <- shrink g-                              bs <- shrink b-                              return $ RGB rs gs bs-  shrink (RGBA r g b a)  = RGB r g b-                           : do rs <- shrink r-                                gs <- shrink g-                                bs <- shrink b-                                as <- shrink a-                                return $ RGBA rs gs bs as-  shrink (BrewerColor c) = map BrewerColor $ shrink c-  shrink _               = [] -- Shrinking 0<=h,s,v<=1 does nothing--instance Arbitrary X11Color where-  arbitrary = arbBounded--instance Arbitrary HtmlLabel where-  arbitrary = sized $ arbHtml True--  shrink ht@(HtmlText txts) = delete ht . map HtmlText $ shrinkL txts-  shrink (HtmlTable tbl)    = map HtmlTable $ shrink tbl---- Note: for the most part, HtmlLabel values are very repetitive (and--- furthermore, they end up chewing a large amount of memory).  As--- such, use resize to limit how large the actual HtmlLabel values--- become.-arbHtml         :: Bool -> Int -> Gen HtmlLabel-arbHtml table s = resize' $ frequency options-  where-    s' = min 2 s-    resize' = if not table-              then resize s'-              else id-    allowTable = if table-                 then (:) (1, arbTbl)-                 else id-    arbTbl = liftM HtmlTable arbitrary-    options = allowTable [ (20, liftM HtmlText . sized $ arbHtmlTexts table) ]--arbHtmlTexts       :: Bool -> Int -> Gen HtmlText-arbHtmlTexts fnt s = liftM simplifyHtmlText-                     . resize s'-                     . listOf1-                     . sized-                     $ arbHtmlText fnt-  where-    s' = min s 10---- When parsing, all textual characters are parsed together; thus,--- make sure we generate them like that.-simplifyHtmlText :: HtmlText -> HtmlText-simplifyHtmlText = map head . groupBy sameType-  where-    sameType HtmlStr{}     HtmlStr{}     = True-    sameType HtmlNewline{} HtmlNewline{} = True-    sameType HtmlFont{}    HtmlFont{}    = True-    sameType _             _             = False--instance Arbitrary HtmlTextItem where-  arbitrary = sized $ arbHtmlText True--  shrink (HtmlStr str) = map HtmlStr $ shrinkString str-  shrink (HtmlNewline as) = map HtmlNewline $ shrink as-  shrink hf@(HtmlFont as txt) = do as' <- shrink as-                                   txt' <- shrinkL txt-                                   returnCheck hf $ HtmlFont as' txt'--arbHtmlText        :: Bool -> Int -> Gen HtmlTextItem-arbHtmlText font s = frequency options-  where-    allowFonts = if font-                 then (:) (1, arbFont)-                 else id-    s' = min 2 s-    arbFont = liftM2 HtmlFont arbitrary . resize s' . sized $ arbHtmlTexts False-    options = allowFonts [ (10, liftM HtmlStr arbString)-                         , (10, liftM HtmlNewline arbitrary)-                         ]--instance Arbitrary HtmlTable where-  arbitrary = liftM3 HTable arbitrary arbitrary (sized arbRows)-    where-      arbRows s = resize (min s 10) arbList--  shrink (HTable fas as rs) = map (HTable fas as) $ shrinkL rs--instance Arbitrary HtmlRow where-  arbitrary = liftM HtmlRow arbList--  shrink hr@(HtmlRow cs) = delete hr . map HtmlRow $ shrinkL cs--instance Arbitrary HtmlCell where-  arbitrary = oneof [ liftM2 HtmlLabelCell arbitrary . sized $ arbHtml False-                    , liftM2 HtmlImgCell arbitrary arbitrary-                    ]--  shrink lc@(HtmlLabelCell as h) = do as' <- shrink as-                                      h' <- shrink h-                                      returnCheck lc $ HtmlLabelCell as' h'-  shrink (HtmlImgCell as ic) = map (HtmlImgCell as) $ shrink ic--instance Arbitrary HtmlImg where-  arbitrary = liftM HtmlImg arbitrary--instance Arbitrary HtmlAttribute where-  arbitrary = oneof [ liftM HtmlAlign arbitrary-                    , liftM HtmlBAlign arbitrary-                    , liftM HtmlBGColor arbitrary-                    , liftM HtmlBorder arbitrary-                    , liftM HtmlCellBorder arbitrary-                    , liftM HtmlCellPadding arbitrary-                    , liftM HtmlCellSpacing arbitrary-                    , liftM HtmlColor arbitrary-                    , liftM HtmlColSpan arbitrary-                    , liftM HtmlFace arbString-                    , liftM HtmlFixedSize arbitrary-                    , liftM HtmlHeight arbitrary-                    , liftM HtmlHRef arbString-                    , liftM HtmlPointSize arbitrary-                    , liftM HtmlPort arbitrary-                    , liftM HtmlRowSpan arbitrary-                    , liftM HtmlScale arbitrary-                    , liftM HtmlSrc arbString-                    , liftM HtmlTarget arbString-                    , liftM HtmlTitle arbString-                    , liftM HtmlVAlign arbitrary-                    , liftM HtmlWidth arbitrary-                    ]--  shrink (HtmlAlign v)       = map HtmlAlign       $ shrink v-  shrink (HtmlBAlign v)      = map HtmlBAlign      $ shrink v-  shrink (HtmlBGColor v)     = map HtmlBGColor     $ shrink v-  shrink (HtmlBorder v)      = map HtmlBorder      $ shrink v-  shrink (HtmlCellBorder v)  = map HtmlCellBorder  $ shrink v-  shrink (HtmlCellPadding v) = map HtmlCellPadding $ shrink v-  shrink (HtmlCellSpacing v) = map HtmlCellSpacing $ shrink v-  shrink (HtmlColor v)       = map HtmlColor       $ shrink v-  shrink (HtmlColSpan v)     = map HtmlColSpan     $ shrink v-  shrink (HtmlFace v)        = map HtmlFace        $ shrink v-  shrink (HtmlFixedSize v)   = map HtmlFixedSize   $ shrink v-  shrink (HtmlHeight v)      = map HtmlHeight      $ shrink v-  shrink (HtmlHRef v)        = map HtmlHRef        $ shrink v-  shrink (HtmlPointSize v)   = map HtmlPointSize   $ shrink v-  shrink (HtmlPort v)        = map HtmlPort        $ shrink v-  shrink (HtmlRowSpan v)     = map HtmlRowSpan     $ shrink v-  shrink (HtmlScale v)       = map HtmlScale       $ shrink v-  shrink (HtmlSrc v)         = map HtmlSrc         $ shrink v-  shrink (HtmlTarget v)      = map HtmlTarget      $ shrink v-  shrink (HtmlTitle v)       = map HtmlTitle       $ shrink v-  shrink (HtmlVAlign v)      = map HtmlVAlign      $ shrink v-  shrink (HtmlWidth v)       = map HtmlWidth       $ shrink v--instance Arbitrary HtmlScale where-  arbitrary = arbBounded--instance Arbitrary HtmlAlign where-  arbitrary = arbBounded--instance Arbitrary HtmlVAlign where-  arbitrary = arbBounded--instance Arbitrary PortName where-  arbitrary = liftM PN-              $ suchThat arbString (liftM2 (&&) (notElem ':') notCP)--  shrink = map PN . filter notCP . shrinkString . portName--notCP :: String -> Bool-notCP = flip Map.notMember compassLookup---- -------------------------------------------------------------------------------- Helper Functions--fromPositive              :: Positive a -> a-fromPositive (Positive a) = a--posArbitrary :: (Arbitrary a, Num a, Ord a) => Gen a-posArbitrary = liftM fromPositive arbitrary--arbString :: Gen String-arbString = suchThat genStr notBool-  where-    genStr = liftM2 (:) (elements notDigits) (listOf $ elements strChr)-    notDigits = ['a'..'z'] ++ ['\'', '"', ' ', '(', ')', ',', ':', '\\']-    strChr = notDigits ++ '.' : ['0'..'9']--{-# INLINE arbString #-}--arbIDString :: Gen String-arbIDString = suchThat genStr notBool-  where-    genStr = liftM2 (:) (elements frst) $ listOf (elements rest)-    frst = ['a'..'z'] ++ ['_']-    rest = frst ++ ['0'.. '9']--validString :: String -> Bool-validString = liftM2 (&&) notBool notNumStr--notBool         :: String -> Bool-notBool "true"  = False-notBool "false" = False-notBool _       = True--shrinkString :: String -> [String]-shrinkString = filter validString . nonEmptyShrinks'--notNumStr :: String -> Bool-notNumStr = not . isNumString--arbBounded :: (Bounded a, Enum a) => Gen a-arbBounded = elements [minBound .. maxBound]--arbLayerName :: Gen String-arbLayerName = suchThat arbString (all notLayerSep)--arbStyleName :: Gen String-arbStyleName = suchThat arbString (all notBrackCom)-  where-    notBrackCom = flip notElem ['(', ')', ',', ' ']--arbList :: (Arbitrary a) => Gen [a]-arbList = listOf1 arbitrary--nonEmptyShrinks :: (Arbitrary a) => [a] -> [[a]]-nonEmptyShrinks = filter (not . null) . shrinkList--nonEmptyShrinks' :: [a] -> [[a]]-nonEmptyShrinks' = filter (not . null) . shrinkList'---- Shrink lists with more than one value only by removing values, not--- by shrinking individual items.-shrinkList     :: (Arbitrary a) => [a] -> [[a]]-shrinkList [a] = map return $ shrink a-shrinkList as  = shrinkList' as---- Just shrink the size.-shrinkList'     :: [a] -> [[a]]-shrinkList' as  = rm (length as) as-  where-    rm 0 _  = []-    rm 1 _  = [[]]-    rm n xs = xs1-            : xs2-            : ( [ xs1' ++ xs2 | xs1' <- rm n1 xs1, not (null xs1') ]-                `ilv` [ xs1 ++ xs2' | xs2' <- rm n2 xs2, not (null xs2') ]-              )-     where-      n1  = n `div` 2-      xs1 = take n1 xs-      n2  = n - n1-      xs2 = drop n1 xs--    []     `ilv` ys     = ys-    xs     `ilv` []     = xs-    (x:xs) `ilv` (y:ys) = x : y : (xs `ilv` ys)---- When a Maybe value is a sub-component, and we need shrink to return--- a value.-shrinkM         :: (Arbitrary a) => Maybe a -> [Maybe a]-shrinkM Nothing = [Nothing]-shrinkM j       = shrink j--shrinkL    :: (Arbitrary a) => [a] -> [[a]]-shrinkL xs = case shrinkList xs of-               []  -> [xs]-               xs' -> xs'--notInt   :: Double -> Bool-notInt d = fromIntegral (round d :: Int) /= d--returnCheck     :: (Eq a) => a -> a -> [a]-returnCheck o n = if o == n-                  then []-                  else [n]+{-# LANGUAGE OverloadedStrings #-}++{- |+   Module      : Data.GraphViz.Testing.Instances+   Description : 'Arbitrary' instances for graphviz.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module exports the 'Arbitrary' instances for the various types+   used to represent Graphviz Dot code.++   Note that they do not generally generate /sensible/ values for the+   various types; in particular, there's no guarantee that the+   'Attributes' chosen for a particular value type are indeed legal+   for that type.+ -}+module Data.GraphViz.Testing.Instances() where++import Data.GraphViz.Testing.Instances.FGL()+import Data.GraphViz.Testing.Instances.Canonical()+import Data.GraphViz.Testing.Instances.Generalised()+import Data.GraphViz.Testing.Instances.Graph()++-- -----------------------------------------------------------------------------+
+ Data/GraphViz/Testing/Instances/Attributes.hs view
@@ -0,0 +1,897 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+   Module      : Data.GraphViz.Testing.Instances.Attributes+   Description : Attribute instances for Arbitrary.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com+ -}+module Data.GraphViz.Testing.Instances.Attributes+       ( arbGraphAttrs+       , arbSubGraphAttrs+       , arbClusterAttrs+       , arbNodeAttrs+       , arbEdgeAttrs+       ) where++import Data.GraphViz.Testing.Instances.Helpers++import Data.GraphViz.Attributes.Complete+import Data.GraphViz.Attributes.Internal(compassLookup)+import Data.GraphViz.State(initialState, layerSep)+import Data.GraphViz.Util(bool)++import Test.QuickCheck++import Data.List(nub, delete, groupBy)+import qualified Data.Map as Map+import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)+import Control.Monad(liftM, liftM2, liftM3, liftM4)++-- -----------------------------------------------------------------------------+-- Defining Arbitrary instances for Attributes++arbGraphAttrs :: Gen Attributes+arbGraphAttrs = arbAttrs usedByGraphs++arbSubGraphAttrs :: Gen Attributes+arbSubGraphAttrs = arbAttrs usedBySubGraphs++arbClusterAttrs :: Gen Attributes+arbClusterAttrs = arbAttrs usedByClusters++arbNodeAttrs :: Gen Attributes+arbNodeAttrs = arbAttrs usedByNodes++arbEdgeAttrs :: Gen Attributes+arbEdgeAttrs = arbAttrs usedByEdges++arbAttrs   :: (Attribute -> Bool) -> Gen Attributes+arbAttrs p = liftM (filter p) arbList++instance Arbitrary Attribute where+  arbitrary = oneof [ liftM Damping arbitrary+                    , liftM K arbitrary+                    , liftM URL arbitrary+                    , liftM ArrowHead arbitrary+                    , liftM ArrowSize arbitrary+                    , liftM ArrowTail arbitrary+                    , liftM Aspect arbitrary+                    , liftM Bb arbitrary+                    , liftM BgColor arbitrary+                    , liftM Center arbitrary+                    , liftM ClusterRank arbitrary+                    , liftM ColorScheme arbitrary+                    , liftM Color arbList+                    , liftM Comment arbitrary+                    , liftM Compound arbitrary+                    , liftM Concentrate arbitrary+                    , liftM Constraint arbitrary+                    , liftM Decorate arbitrary+                    , liftM DefaultDist arbitrary+                    , liftM Dimen arbitrary+                    , liftM Dim arbitrary+                    , liftM Dir arbitrary+                    , liftM DirEdgeConstraints arbitrary+                    , liftM Distortion arbitrary+                    , liftM DPI arbitrary+                    , liftM EdgeURL arbitrary+                    , liftM EdgeTarget arbitrary+                    , liftM EdgeTooltip arbitrary+                    , liftM Epsilon arbitrary+                    , liftM ESep arbitrary+                    , liftM FillColor arbitrary+                    , liftM FixedSize arbitrary+                    , liftM FontColor arbitrary+                    , liftM FontName arbitrary+                    , liftM FontNames arbitrary+                    , liftM FontPath arbitrary+                    , liftM FontSize arbitrary+                    , liftM Group arbitrary+                    , liftM HeadURL arbitrary+                    , liftM HeadClip arbitrary+                    , liftM HeadLabel arbitrary+                    , liftM HeadPort arbitrary+                    , liftM HeadTarget arbitrary+                    , liftM HeadTooltip arbitrary+                    , liftM Height arbitrary+                    , liftM ID arbitrary+                    , liftM Image arbitrary+                    , liftM ImageScale arbitrary+                    , liftM LabelURL arbitrary+                    , liftM LabelAngle arbitrary+                    , liftM LabelDistance arbitrary+                    , liftM LabelFloat arbitrary+                    , liftM LabelFontColor arbitrary+                    , liftM LabelFontName arbitrary+                    , liftM LabelFontSize arbitrary+                    , liftM LabelJust arbitrary+                    , liftM LabelLoc arbitrary+                    , liftM LabelTarget arbitrary+                    , liftM LabelTooltip arbitrary+                    , liftM Label arbitrary+                    , liftM Landscape arbitrary+                    , liftM LayerSep arbitrary+                    , liftM Layers arbitrary+                    , liftM Layer arbitrary+                    , liftM Layout arbitrary+                    , liftM Len arbitrary+                    , liftM LevelsGap arbitrary+                    , liftM Levels arbitrary+                    , liftM LHead arbitrary+                    , liftM LPos arbitrary+                    , liftM LTail arbitrary+                    , liftM Margin arbitrary+                    , liftM MaxIter arbitrary+                    , liftM MCLimit arbitrary+                    , liftM MinDist arbitrary+                    , liftM MinLen arbitrary+                    , liftM Model arbitrary+                    , liftM Mode arbitrary+                    , liftM Mosek arbitrary+                    , liftM NodeSep arbitrary+                    , liftM NoJustify arbitrary+                    , liftM Normalize arbitrary+                    , liftM Nslimit1 arbitrary+                    , liftM Nslimit arbitrary+                    , liftM Ordering arbitrary+                    , liftM Orientation arbitrary+                    , liftM OutputOrder arbitrary+                    , liftM OverlapScaling arbitrary+                    , liftM Overlap arbitrary+                    , liftM PackMode arbitrary+                    , liftM Pack arbitrary+                    , liftM Pad arbitrary+                    , liftM PageDir arbitrary+                    , liftM Page arbitrary+                    , liftM PenColor arbitrary+                    , liftM PenWidth arbitrary+                    , liftM Peripheries arbitrary+                    , liftM Pin arbitrary+                    , liftM Pos arbitrary+                    , liftM QuadTree arbitrary+                    , liftM Quantum arbitrary+                    , liftM RankDir arbitrary+                    , liftM RankSep arbList+                    , liftM Rank arbitrary+                    , liftM Ratio arbitrary+                    , liftM Rects arbList+                    , liftM Regular arbitrary+                    , liftM ReMinCross arbitrary+                    , liftM RepulsiveForce arbitrary+                    , liftM Root arbitrary+                    , liftM Rotate arbitrary+                    , liftM SameHead arbitrary+                    , liftM SameTail arbitrary+                    , liftM SamplePoints arbitrary+                    , liftM SearchSize arbitrary+                    , liftM Sep arbitrary+                    , liftM ShapeFile arbitrary+                    , liftM Shape arbitrary+                    , liftM ShowBoxes arbitrary+                    , liftM Sides arbitrary+                    , liftM Size arbitrary+                    , liftM Skew arbitrary+                    , liftM Smoothing arbitrary+                    , liftM SortV arbitrary+                    , liftM Splines arbitrary+                    , liftM Start arbitrary+                    , liftM StyleSheet arbitrary+                    , liftM Style arbList+                    , liftM TailURL arbitrary+                    , liftM TailClip arbitrary+                    , liftM TailLabel arbitrary+                    , liftM TailPort arbitrary+                    , liftM TailTarget arbitrary+                    , liftM TailTooltip arbitrary+                    , liftM Target arbitrary+                    , liftM Tooltip arbitrary+                    , liftM TrueColor arbitrary+                    , liftM Vertices arbList+                    , liftM ViewPort arbitrary+                    , liftM VoroMargin arbitrary+                    , liftM Weight arbitrary+                    , liftM Width arbitrary+                    , liftM Z arbitrary+                    , liftM2 UnknownAttribute (suchThat arbIDString validUnknown) arbitrary+                    ]++  shrink (Damping v)            = map Damping             $ shrink v+  shrink (K v)                  = map K                   $ shrink v+  shrink (URL v)                = map URL                 $ shrink v+  shrink (ArrowHead v)          = map ArrowHead           $ shrink v+  shrink (ArrowSize v)          = map ArrowSize           $ shrink v+  shrink (ArrowTail v)          = map ArrowTail           $ shrink v+  shrink (Aspect v)             = map Aspect              $ shrink v+  shrink (Bb v)                 = map Bb                  $ shrink v+  shrink (BgColor v)            = map BgColor             $ shrink v+  shrink (Center v)             = map Center              $ shrink v+  shrink (ClusterRank v)        = map ClusterRank         $ shrink v+  shrink (ColorScheme v)        = map ColorScheme         $ shrink v+  shrink (Color v)              = map Color               $ nonEmptyShrinks v+  shrink (Comment v)            = map Comment             $ shrink v+  shrink (Compound v)           = map Compound            $ shrink v+  shrink (Concentrate v)        = map Concentrate         $ shrink v+  shrink (Constraint v)         = map Constraint          $ shrink v+  shrink (Decorate v)           = map Decorate            $ shrink v+  shrink (DefaultDist v)        = map DefaultDist         $ shrink v+  shrink (Dimen v)              = map Dimen               $ shrink v+  shrink (Dim v)                = map Dim                 $ shrink v+  shrink (Dir v)                = map Dir                 $ shrink v+  shrink (DirEdgeConstraints v) = map DirEdgeConstraints  $ shrink v+  shrink (Distortion v)         = map Distortion          $ shrink v+  shrink (DPI v)                = map DPI                 $ shrink v+  shrink (EdgeURL v)            = map EdgeURL             $ shrink v+  shrink (EdgeTarget v)         = map EdgeTarget          $ shrink v+  shrink (EdgeTooltip v)        = map EdgeTooltip         $ shrink v+  shrink (Epsilon v)            = map Epsilon             $ shrink v+  shrink (ESep v)               = map ESep                $ shrink v+  shrink (FillColor v)          = map FillColor           $ shrink v+  shrink (FixedSize v)          = map FixedSize           $ shrink v+  shrink (FontColor v)          = map FontColor           $ shrink v+  shrink (FontName v)           = map FontName            $ shrink v+  shrink (FontNames v)          = map FontNames           $ shrink v+  shrink (FontPath v)           = map FontPath            $ shrink v+  shrink (FontSize v)           = map FontSize            $ shrink v+  shrink (Group v)              = map Group               $ shrink v+  shrink (HeadURL v)            = map HeadURL             $ shrink v+  shrink (HeadClip v)           = map HeadClip            $ shrink v+  shrink (HeadLabel v)          = map HeadLabel           $ shrink v+  shrink (HeadPort v)           = map HeadPort            $ shrink v+  shrink (HeadTarget v)         = map HeadTarget          $ shrink v+  shrink (HeadTooltip v)        = map HeadTooltip         $ shrink v+  shrink (Height v)             = map Height              $ shrink v+  shrink (ID v)                 = map ID                  $ shrink v+  shrink (Image v)              = map Image               $ shrink v+  shrink (ImageScale v)         = map ImageScale          $ shrink v+  shrink (LabelURL v)           = map LabelURL            $ shrink v+  shrink (LabelAngle v)         = map LabelAngle          $ shrink v+  shrink (LabelDistance v)      = map LabelDistance       $ shrink v+  shrink (LabelFloat v)         = map LabelFloat          $ shrink v+  shrink (LabelFontColor v)     = map LabelFontColor      $ shrink v+  shrink (LabelFontName v)      = map LabelFontName       $ shrink v+  shrink (LabelFontSize v)      = map LabelFontSize       $ shrink v+  shrink (LabelJust v)          = map LabelJust           $ shrink v+  shrink (LabelLoc v)           = map LabelLoc            $ shrink v+  shrink (LabelTarget v)        = map LabelTarget         $ shrink v+  shrink (LabelTooltip v)       = map LabelTooltip        $ shrink v+  shrink (Label v)              = map Label               $ shrink v+  shrink (Landscape v)          = map Landscape           $ shrink v+  shrink (LayerSep v)           = map LayerSep            $ shrink v+  shrink (Layers v)             = map Layers              $ shrink v+  shrink (Layer v)              = map Layer               $ shrink v+  shrink (Layout v)             = map Layout              $ shrink v+  shrink (Len v)                = map Len                 $ shrink v+  shrink (LevelsGap v)          = map LevelsGap           $ shrink v+  shrink (Levels v)             = map Levels              $ shrink v+  shrink (LHead v)              = map LHead               $ shrink v+  shrink (LPos v)               = map LPos                $ shrink v+  shrink (LTail v)              = map LTail               $ shrink v+  shrink (Margin v)             = map Margin              $ shrink v+  shrink (MaxIter v)            = map MaxIter             $ shrink v+  shrink (MCLimit v)            = map MCLimit             $ shrink v+  shrink (MinDist v)            = map MinDist             $ shrink v+  shrink (MinLen v)             = map MinLen              $ shrink v+  shrink (Model v)              = map Model               $ shrink v+  shrink (Mode v)               = map Mode                $ shrink v+  shrink (Mosek v)              = map Mosek               $ shrink v+  shrink (NodeSep v)            = map NodeSep             $ shrink v+  shrink (NoJustify v)          = map NoJustify           $ shrink v+  shrink (Normalize v)          = map Normalize           $ shrink v+  shrink (Nslimit1 v)           = map Nslimit1            $ shrink v+  shrink (Nslimit v)            = map Nslimit             $ shrink v+  shrink (Ordering v)           = map Ordering            $ shrink v+  shrink (Orientation v)        = map Orientation         $ shrink v+  shrink (OutputOrder v)        = map OutputOrder         $ shrink v+  shrink (OverlapScaling v)     = map OverlapScaling      $ shrink v+  shrink (Overlap v)            = map Overlap             $ shrink v+  shrink (PackMode v)           = map PackMode            $ shrink v+  shrink (Pack v)               = map Pack                $ shrink v+  shrink (Pad v)                = map Pad                 $ shrink v+  shrink (PageDir v)            = map PageDir             $ shrink v+  shrink (Page v)               = map Page                $ shrink v+  shrink (PenColor v)           = map PenColor            $ shrink v+  shrink (PenWidth v)           = map PenWidth            $ shrink v+  shrink (Peripheries v)        = map Peripheries         $ shrink v+  shrink (Pin v)                = map Pin                 $ shrink v+  shrink (Pos v)                = map Pos                 $ shrink v+  shrink (QuadTree v)           = map QuadTree            $ shrink v+  shrink (Quantum v)            = map Quantum             $ shrink v+  shrink (RankDir v)            = map RankDir             $ shrink v+  shrink (RankSep v)            = map RankSep             $ nonEmptyShrinks v+  shrink (Rank v)               = map Rank                $ shrink v+  shrink (Ratio v)              = map Ratio               $ shrink v+  shrink (Rects v)              = map Rects               $ nonEmptyShrinks v+  shrink (Regular v)            = map Regular             $ shrink v+  shrink (ReMinCross v)         = map ReMinCross          $ shrink v+  shrink (RepulsiveForce v)     = map RepulsiveForce      $ shrink v+  shrink (Root v)               = map Root                $ shrink v+  shrink (Rotate v)             = map Rotate              $ shrink v+  shrink (SameHead v)           = map SameHead            $ shrink v+  shrink (SameTail v)           = map SameTail            $ shrink v+  shrink (SamplePoints v)       = map SamplePoints        $ shrink v+  shrink (SearchSize v)         = map SearchSize          $ shrink v+  shrink (Sep v)                = map Sep                 $ shrink v+  shrink (ShapeFile v)          = map ShapeFile           $ shrink v+  shrink (Shape v)              = map Shape               $ shrink v+  shrink (ShowBoxes v)          = map ShowBoxes           $ shrink v+  shrink (Sides v)              = map Sides               $ shrink v+  shrink (Size v)               = map Size                $ shrink v+  shrink (Skew v)               = map Skew                $ shrink v+  shrink (Smoothing v)          = map Smoothing           $ shrink v+  shrink (SortV v)              = map SortV               $ shrink v+  shrink (Splines v)            = map Splines             $ shrink v+  shrink (Start v)              = map Start               $ shrink v+  shrink (StyleSheet v)         = map StyleSheet          $ shrink v+  shrink (Style v)              = map Style               $ nonEmptyShrinks v+  shrink (TailURL v)            = map TailURL             $ shrink v+  shrink (TailClip v)           = map TailClip            $ shrink v+  shrink (TailLabel v)          = map TailLabel           $ shrink v+  shrink (TailPort v)           = map TailPort            $ shrink v+  shrink (TailTarget v)         = map TailTarget          $ shrink v+  shrink (TailTooltip v)        = map TailTooltip         $ shrink v+  shrink (Target v)             = map Target              $ shrink v+  shrink (Tooltip v)            = map Tooltip             $ shrink v+  shrink (TrueColor v)          = map TrueColor           $ shrink v+  shrink (Vertices v)           = map Vertices            $ nonEmptyShrinks v+  shrink (ViewPort v)           = map ViewPort            $ shrink v+  shrink (VoroMargin v)         = map VoroMargin          $ shrink v+  shrink (Weight v)             = map Weight              $ shrink v+  shrink (Width v)              = map Width               $ shrink v+  shrink (Z v)                  = map Z                   $ shrink v+  shrink (UnknownAttribute a v) = liftM2 UnknownAttribute (liftM (filter validUnknown) shrink a) (shrink v)+{- delete to here -}++instance Arbitrary ArrowType where+  arbitrary = liftM AType+              -- Arrow specifications have between 1 and 4 elements.+              $ sized (\ s -> resize (min s 4) arbList)++  shrink (AType as) = map AType $ nonEmptyShrinks as++instance Arbitrary ArrowShape where+  arbitrary = arbBounded++instance Arbitrary ArrowModifier where+  arbitrary = liftM2 ArrMod arbitrary arbitrary++instance Arbitrary ArrowFill where+  arbitrary = arbBounded++instance Arbitrary ArrowSide where+  arbitrary = arbBounded++instance Arbitrary AspectType where+  arbitrary = oneof [ liftM  RatioOnly arbitrary+                    , liftM2 RatioPassCount arbitrary posArbitrary+                    ]++  shrink (RatioOnly d) = map RatioOnly $ shrink d+  shrink (RatioPassCount d i) = do ds <- shrink d+                                   is <- shrink i+                                   return $ RatioPassCount ds is++instance Arbitrary Rect where+  arbitrary = liftM2 Rect point2D point2D++  shrink (Rect p1 p2) = do p1s <- shrink p1+                           p2s <- shrink p2+                           return $ Rect p1s p2s++instance Arbitrary Point where+  -- Pretty sure points have to be positive...+  arbitrary = liftM4 Point posArbitrary posArbitrary posZ arbitrary+    where+      posZ = frequency [(1, return Nothing), (3, liftM Just posArbitrary)]++  shrink p = do x' <- shrink $ xCoord p+                y' <- shrink $ yCoord p+                z' <- shrinkM $ zCoord p+                return $ Point x' y' z' False++point2D :: Gen Point+point2D = liftM2 createPoint posArbitrary posArbitrary++instance Arbitrary ClusterMode where+  arbitrary = arbBounded++instance Arbitrary DirType where+  arbitrary = arbBounded++instance Arbitrary DEConstraints where+  arbitrary = arbBounded++instance Arbitrary DPoint where+  arbitrary = oneof [ liftM DVal arbitrary+                    , liftM PVal point2D+                    ]++  shrink (DVal d) = map DVal $ shrink d+  shrink (PVal p) = map PVal $ shrink p++instance Arbitrary ModeType where+  arbitrary = arbBounded++instance Arbitrary Model where+  arbitrary = arbBounded++instance Arbitrary Label where+  arbitrary = oneof [ liftM StrLabel arbitrary+                    , liftM HtmlLabel arbitrary+                    , liftM RecordLabel $ suchThat arbList notStr+                    ]++  shrink (StrLabel str)   = map StrLabel $ shrink str+  shrink (HtmlLabel html) = map HtmlLabel $ shrink html+  shrink (RecordLabel fs) = map RecordLabel . filter notStr $ shrinkList fs++notStr                :: RecordFields -> Bool+notStr [FieldLabel{}] = False -- Just in case+notStr _              = True++arbField     :: Bool -> Int -> Gen RecordField+arbField b s = resize s'+               . oneof+               . bool id ((:) genFlipped) b+               $ [ liftM2 LabelledTarget arbitrary arbitrary+                 , liftM PortName arbitrary+                 , liftM FieldLabel arbitrary+                 ]+  where+    genFlipped = liftM FlipFields+                 $ listOf1 (sized $ arbField False)+    s' = min 3 s++instance Arbitrary RecordField where+  arbitrary = sized (arbField True)++  shrink (LabelledTarget f l) = [PortName f, FieldLabel l]+  shrink (PortName f)         = map PortName $ shrink f+  shrink (FieldLabel l)       = map FieldLabel $ shrink l+  shrink (FlipFields fs)      = map FlipFields $ shrinkList fs++instance Arbitrary Overlap where+  arbitrary = oneof [ simpleOverlap+                    , liftM PrismOverlap arbitrary+                    ]+    where+      -- Have to do this by hand since Overlap can't have Bounded and+      -- Enum instances+      simpleOverlap = elements [ KeepOverlaps+                               , RemoveOverlaps+                               , ScaleOverlaps+                               , ScaleXYOverlaps+                               , CompressOverlap+                               , VpscOverlap+                               , IpsepOverlap+                               ]++  shrink (PrismOverlap mi) = map PrismOverlap $ shrink mi+  shrink _                 = []++instance Arbitrary LayerSep where+  -- Since Arbitrary isn't stateful, we can't generate an arbitrary+  -- one because of arbLayerName+  arbitrary = return . LSep . T.pack $ layerSep initialState++instance Arbitrary LayerList where+  arbitrary = liftM LL $ listOf1 arbName+    where+      arbName = suchThat arbitrary isLayerName++      isLayerName LRName{} = True+      isLayerName _        = False++  shrink (LL ll) = map LL $ nonEmptyShrinks ll++instance Arbitrary LayerRange where+  arbitrary = oneof [ liftM LRID arbitrary+                    , liftM2 LRS arbitrary arbitrary+                    ]++  shrink (LRID nm)   = map LRID $ shrink nm+  shrink (LRS l1 l2) = [LRID l1, LRID l2]++instance Arbitrary LayerID where+  arbitrary = oneof [ return AllLayers+                    , liftM LRInt arbitrary+                    , liftM LRName $ suchThat arbLayerName lrnameCheck+                    ]++  shrink AllLayers   = []+  shrink (LRInt i)   = map LRInt $ shrink i+  shrink (LRName nm) = map LRName+                       . filter lrnameCheck+                       $ shrink nm++lrnameCheck :: Text -> Bool+lrnameCheck = (/=) "all"++instance Arbitrary OutputMode where+  arbitrary = arbBounded++instance Arbitrary Pack where+  arbitrary = oneof [ return DoPack+                    , return DontPack+                    , liftM PackMargin arbitrary+                    ]++  shrink (PackMargin m) = map PackMargin $ shrink m+  shrink _              = []++instance Arbitrary PackMode where+  arbitrary = oneof [ return PackNode+                    , return PackClust+                    , return PackGraph+                    , liftM3 PackArray arbitrary arbitrary arbitrary+                    ]++  shrink (PackArray c u mi) = map (PackArray c u) $ shrink mi+  shrink _                  = []++instance Arbitrary Pos where+  arbitrary = oneof [ liftM PointPos arbitrary+                      -- A single spline with only one point overall+                      -- is just a point...+                    , liftM SplinePos $ suchThat arbList validSplineList+                    ]++  shrink (PointPos p)   = map PointPos $ shrink p+  shrink (SplinePos ss) = map SplinePos . filter validSplineList+                          $ nonEmptyShrinks ss++validSplineList                              :: [Spline] -> Bool+validSplineList [Spline Nothing Nothing [_]] = False+validSplineList _                            = True++instance Arbitrary Spline where+  arbitrary = liftM3 Spline arbitrary arbitrary+              -- list of points must have length of 1 mod 3+              $ suchThat arbitrary ((==) 1 . flip mod 3 . length)++  shrink (Spline Nothing Nothing [p]) = map (Spline Nothing Nothing . return)+                                        $ shrink p+  -- We're not going to be shrinking the points in the list; just+  -- making sure that its length is === 1 mod 3+  shrink (Spline ms me ps) = do mss <- shrinkM ms+                                mes <- shrinkM me+                                pss <- rem2 ps+                                return $ Spline mss mes pss+    where++      rem1 []     = []+      rem1 (a:as) = as : map (a:) (rem1 as)++      rem2 = nub . concatMap rem1 . rem1++instance Arbitrary EdgeType where+  arbitrary = arbBounded++instance Arbitrary PageDir where+  arbitrary = arbBounded++instance Arbitrary QuadType where+  arbitrary = arbBounded++instance Arbitrary Root where+  arbitrary = oneof [ return IsCentral+                    , return NotCentral+                    , liftM NodeName arbitrary+                    ]++  shrink (NodeName nm) = map NodeName $ shrink nm+  shrink _             = []++instance Arbitrary RankType where+  arbitrary = arbBounded++instance Arbitrary RankDir where+  arbitrary = arbBounded++instance Arbitrary Shape where+  arbitrary = arbBounded++instance Arbitrary SmoothType where+  arbitrary = arbBounded++instance Arbitrary StartType where+  arbitrary = oneof [ liftM  StartStyle arbitrary+                    , liftM  StartSeed arbitrary+                    , liftM2 StartStyleSeed arbitrary arbitrary+                    ]++  shrink StartStyle{} = [] -- No shrinks for STStyle+  shrink (StartSeed ss) = map StartSeed $ shrink ss+  shrink (StartStyleSeed st ss) = map (StartStyleSeed st) $ shrink ss++instance Arbitrary STStyle where+  arbitrary = arbBounded++instance Arbitrary StyleItem where+  arbitrary = liftM2 SItem arbitrary (listOf arbStyleName)++  -- Can't use this because of what shrink on the individual strings+  -- might do.+  -- shrink (SItem sn opts) = map (SItem sn) $ shrink opts++instance Arbitrary StyleName where+  arbitrary = oneof [ defaultStyles+                    , liftM DD $ suchThat arbStyleName notDefault+                    ]+    where+      defaultStyles = elements [ Dashed+                               , Dotted+                               , Bold+                               , Invisible+                               , Filled+                               , Diagonals+                               , Rounded+                               ]+      notDefault = flip notElem [ "dashed"+                                , "dotted"+                                , "solid"+                                , "bold"+                                , "invis"+                                , "filled"+                                , "diagonals"+                                , "rounded"+                                ]++instance Arbitrary PortPos where+  arbitrary = oneof [ liftM2 LabelledPort arbitrary arbitrary+                    , liftM CompassPoint arbitrary+                    ]++  shrink (LabelledPort pn mc) = map (flip LabelledPort mc) $ shrink pn+  shrink _                    = []++instance Arbitrary CompassPoint where+  arbitrary = arbBounded++instance Arbitrary ViewPort where+  arbitrary = liftM4 VP arbitrary arbitrary arbitrary arbitrary++  shrink (VP w h z f) = case sVPs of+                          [_] -> []+                          _   -> sVPs+    where+      sVPs = do ws <- shrink w+                hs <- shrink h+                zs <- shrink z+                fs <- shrinkM f+                return $ VP ws hs zs fs++instance Arbitrary FocusType where+  arbitrary = oneof [ liftM XY arbitrary+                    , liftM NodeFocus $ suchThat arbitrary (T.all ((/=) ','))+                    ]++  shrink (XY p)          = map XY $ shrink p+  shrink (NodeFocus str) = map NodeFocus $ shrink str++instance Arbitrary VerticalPlacement where+  arbitrary = arbBounded++instance Arbitrary ScaleType where+  arbitrary = arbBounded++instance Arbitrary Justification where+  arbitrary = arbBounded++instance Arbitrary Ratios where+  arbitrary = oneof [ liftM AspectRatio posArbitrary+                    , namedRats+                    ]+    where+      namedRats = elements [ FillRatio+                           , CompressRatio+                           , ExpandRatio+                           , AutoRatio+                           ]++  shrink (AspectRatio r) = map (AspectRatio . fromPositive)+                           . shrink $ Positive r+  shrink _               = []++instance Arbitrary ColorScheme where+  arbitrary = oneof [ return X11+                    , liftM Brewer arbitrary+                    ]++  shrink (Brewer bs) = map Brewer $ shrink bs+  shrink _           = []++instance Arbitrary BrewerScheme where+  arbitrary = liftM2 BScheme arbitrary arbitrary -- Not /quite/ right, but close enough++  shrink (BScheme nm l) = map (BScheme nm) $ shrink l++instance Arbitrary BrewerName where+  arbitrary = arbBounded++instance Arbitrary Color where+  arbitrary = oneof [ liftM3 RGB  arbitrary arbitrary arbitrary+                    , liftM4 RGBA arbitrary arbitrary arbitrary arbitrary+                    , liftM3 HSV  zeroOne zeroOne zeroOne+                    , liftM X11Color arbitrary+                      -- Not quite right as the values can get too+                      -- high/low, but should suffice for+                      -- printing/parsing purposes.+                    , liftM2 BrewerColor arbitrary arbitrary+                    ]+    where+      zeroOne = choose (0,1)++  shrink (RGB r g b)       = do rs <- shrink r+                                gs <- shrink g+                                bs <- shrink b+                                return $ RGB rs gs bs+  shrink (RGBA r g b a)    = RGB r g b+                             : do rs <- shrink r+                                  gs <- shrink g+                                  bs <- shrink b+                                  as <- shrink a+                                  return $ RGBA rs gs bs as+  shrink (BrewerColor s c) = map (BrewerColor s) $ shrink c+  shrink _                 = [] -- Shrinking 0<=h,s,v<=1 does nothing++instance Arbitrary X11Color where+  arbitrary = arbBounded++instance Arbitrary HtmlLabel where+  arbitrary = sized $ arbHtml True++  shrink ht@(HtmlText txts) = delete ht . map HtmlText $ shrinkL txts+  shrink (HtmlTable tbl)    = map HtmlTable $ shrink tbl++-- Note: for the most part, HtmlLabel values are very repetitive (and+-- furthermore, they end up chewing a large amount of memory).  As+-- such, use resize to limit how large the actual HtmlLabel values+-- become.+arbHtml         :: Bool -> Int -> Gen HtmlLabel+arbHtml table s = resize' $ frequency options+  where+    s' = min 2 s+    resize' = if not table+              then resize s'+              else id+    allowTable = if table+                 then (:) (1, arbTbl)+                 else id+    arbTbl = liftM HtmlTable arbitrary+    options = allowTable [ (20, liftM HtmlText . sized $ arbHtmlTexts table) ]++arbHtmlTexts       :: Bool -> Int -> Gen HtmlText+arbHtmlTexts fnt s = liftM simplifyHtmlText+                     . resize s'+                     . listOf1+                     . sized+                     $ arbHtmlText fnt+  where+    s' = min s 10++-- When parsing, all textual characters are parsed together; thus,+-- make sure we generate them like that.+simplifyHtmlText :: HtmlText -> HtmlText+simplifyHtmlText = map head . groupBy sameType+  where+    sameType HtmlStr{}     HtmlStr{}     = True+    sameType HtmlNewline{} HtmlNewline{} = True+    sameType HtmlFont{}    HtmlFont{}    = True+    sameType _             _             = False++instance Arbitrary HtmlTextItem where+  arbitrary = sized $ arbHtmlText True++  shrink (HtmlStr str) = map HtmlStr $ shrink str+  shrink (HtmlNewline as) = map HtmlNewline $ shrink as+  shrink hf@(HtmlFont as txt) = do as' <- shrink as+                                   txt' <- shrinkL txt+                                   returnCheck hf $ HtmlFont as' txt'++arbHtmlText        :: Bool -> Int -> Gen HtmlTextItem+arbHtmlText font s = frequency options+  where+    allowFonts = if font+                 then (:) (1, arbFont)+                 else id+    s' = min 2 s+    arbFont = liftM2 HtmlFont arbitrary . resize s' . sized $ arbHtmlTexts False+    options = allowFonts [ (10, liftM HtmlStr arbitrary)+                         , (10, liftM HtmlNewline arbitrary)+                         ]++instance Arbitrary HtmlTable where+  arbitrary = liftM3 HTable arbitrary arbitrary (sized arbRows)+    where+      arbRows s = resize (min s 10) arbList++  shrink (HTable fas as rs) = map (HTable fas as) $ shrinkL rs++instance Arbitrary HtmlRow where+  arbitrary = liftM HtmlRow arbList++  shrink hr@(HtmlRow cs) = delete hr . map HtmlRow $ shrinkL cs++instance Arbitrary HtmlCell where+  arbitrary = oneof [ liftM2 HtmlLabelCell arbitrary . sized $ arbHtml False+                    , liftM2 HtmlImgCell arbitrary arbitrary+                    ]++  shrink lc@(HtmlLabelCell as h) = do as' <- shrink as+                                      h' <- shrink h+                                      returnCheck lc $ HtmlLabelCell as' h'+  shrink (HtmlImgCell as ic) = map (HtmlImgCell as) $ shrink ic++instance Arbitrary HtmlImg where+  arbitrary = liftM HtmlImg arbitrary++instance Arbitrary HtmlAttribute where+  arbitrary = oneof [ liftM HtmlAlign arbitrary+                    , liftM HtmlBAlign arbitrary+                    , liftM HtmlBGColor arbitrary+                    , liftM HtmlBorder arbitrary+                    , liftM HtmlCellBorder arbitrary+                    , liftM HtmlCellPadding arbitrary+                    , liftM HtmlCellSpacing arbitrary+                    , liftM HtmlColor arbitrary+                    , liftM HtmlColSpan arbitrary+                    , liftM HtmlFace arbitrary+                    , liftM HtmlFixedSize arbitrary+                    , liftM HtmlHeight arbitrary+                    , liftM HtmlHRef arbitrary+                    , liftM HtmlPointSize arbitrary+                    , liftM HtmlPort arbitrary+                    , liftM HtmlRowSpan arbitrary+                    , liftM HtmlScale arbitrary+                    , liftM HtmlSrc arbString+                    , liftM HtmlTarget arbitrary+                    , liftM HtmlTitle arbitrary+                    , liftM HtmlVAlign arbitrary+                    , liftM HtmlWidth arbitrary+                    ]++  shrink (HtmlAlign v)       = map HtmlAlign       $ shrink v+  shrink (HtmlBAlign v)      = map HtmlBAlign      $ shrink v+  shrink (HtmlBGColor v)     = map HtmlBGColor     $ shrink v+  shrink (HtmlBorder v)      = map HtmlBorder      $ shrink v+  shrink (HtmlCellBorder v)  = map HtmlCellBorder  $ shrink v+  shrink (HtmlCellPadding v) = map HtmlCellPadding $ shrink v+  shrink (HtmlCellSpacing v) = map HtmlCellSpacing $ shrink v+  shrink (HtmlColor v)       = map HtmlColor       $ shrink v+  shrink (HtmlColSpan v)     = map HtmlColSpan     $ shrink v+  shrink (HtmlFace v)        = map HtmlFace        $ shrink v+  shrink (HtmlFixedSize v)   = map HtmlFixedSize   $ shrink v+  shrink (HtmlHeight v)      = map HtmlHeight      $ shrink v+  shrink (HtmlHRef v)        = map HtmlHRef        $ shrink v+  shrink (HtmlPointSize v)   = map HtmlPointSize   $ shrink v+  shrink (HtmlPort v)        = map HtmlPort        $ shrink v+  shrink (HtmlRowSpan v)     = map HtmlRowSpan     $ shrink v+  shrink (HtmlScale v)       = map HtmlScale       $ shrink v+  shrink (HtmlSrc v)         = map HtmlSrc         $ shrinkString v+  shrink (HtmlTarget v)      = map HtmlTarget      $ shrink v+  shrink (HtmlTitle v)       = map HtmlTitle       $ shrink v+  shrink (HtmlVAlign v)      = map HtmlVAlign      $ shrink v+  shrink (HtmlWidth v)       = map HtmlWidth       $ shrink v++instance Arbitrary HtmlScale where+  arbitrary = arbBounded++instance Arbitrary HtmlAlign where+  arbitrary = arbBounded++instance Arbitrary HtmlVAlign where+  arbitrary = arbBounded++instance Arbitrary PortName where+  arbitrary = liftM PN+              $ suchThat arbitrary (liftM2 (&&) (T.all (/=':')) notCP)++  shrink = map PN . filter notCP . shrink . portName++notCP :: Text -> Bool+notCP = flip Map.notMember compassLookup
+ Data/GraphViz/Testing/Instances/Canonical.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Testing.Instances.Canonical+   Description : Canonical dot graph instances for Arbitrary.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com+ -}+module Data.GraphViz.Testing.Instances.Canonical where++import Data.GraphViz.Testing.Instances.Common+import Data.GraphViz.Testing.Instances.Helpers++import Data.GraphViz.Types.Canonical+import Data.GraphViz.Util(bool)++import Test.QuickCheck++import Control.Monad(liftM2, liftM4)++-- -----------------------------------------------------------------------------+-- Defining Arbitrary instances for the overall types++instance (Eq n, Arbitrary n) => Arbitrary (DotGraph n) where+  arbitrary = liftM4 DotGraph arbitrary arbitrary arbitrary arbitrary++  shrink (DotGraph str dir gid stmts) = map (DotGraph str dir gid)+                                        $ shrink stmts++instance (Eq n, Arbitrary n) => Arbitrary (DotStatements n) where+  arbitrary = sized (arbDS gaGraph True)++  shrink ds@(DotStmts gas sgs ns es) = do gas' <- shrinkL gas+                                          sgs' <- shrinkL sgs+                                          ns' <- shrinkL ns+                                          es' <- shrinkL es+                                          returnCheck ds+                                            $ DotStmts gas' sgs' ns' es'++-- | If 'True', generate 'DotSubGraph's; otherwise don't.+arbDS              :: (Arbitrary n, Eq n) => Gen GlobalAttributes -> Bool+                      -> Int -> Gen (DotStatements n)+arbDS ga haveSGs s = liftM4 DotStmts (listOf ga) genSGs arbitrary arbitrary+  where+    s' = min s 2+    genSGs = if haveSGs+             then resize s' arbitrary+             else return []++instance (Eq n, Arbitrary n) => Arbitrary (DotSubGraph n) where+  arbitrary = do isClust <- arbitrary+                 let ga = bool gaSubGraph gaClusters isClust+                 liftM2 (DotSG isClust) arbitrary (sized $ arbDS ga False)++  shrink (DotSG isCl mid stmts) = map (DotSG isCl mid) $ shrink stmts
+ Data/GraphViz/Testing/Instances/Common.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Testing.Instances.Common()+   Description : Attribute instances for Arbitrary.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com+ -}+module Data.GraphViz.Testing.Instances.Common+       ( gaGraph+       , gaSubGraph+       , gaClusters+       ) where++import Data.GraphViz.Testing.Instances.Attributes+import Data.GraphViz.Testing.Instances.Helpers++import Data.GraphViz.Attributes(Attributes)+import Data.GraphViz.Types.Common( DotNode(..), DotEdge(..)+                                 , GlobalAttributes(..), GraphID(..))++import Test.QuickCheck++import Control.Monad(liftM, liftM2, liftM3)++-- -----------------------------------------------------------------------------+-- Common values++instance Arbitrary GraphID where+  arbitrary = oneof [ liftM Str arbitrary+                    , liftM Int arbitrary+                    , liftM Dbl $ suchThat arbitrary notInt+                    ]++  shrink (Str s) = map Str $ shrink s+  shrink (Int i) = map Int $ shrink i+  shrink (Dbl d) = map Dbl $ filter notInt $ shrink d++instance (Arbitrary n) => Arbitrary (DotNode n) where+  arbitrary = liftM2 DotNode arbitrary arbNodeAttrs++  shrink (DotNode n as) = map (DotNode n) $ shrinkList as++instance (Arbitrary n) => Arbitrary (DotEdge n) where+  arbitrary = liftM3 DotEdge arbitrary arbitrary arbEdgeAttrs++  shrink (DotEdge f t as) = map (DotEdge f t) $ shrinkList as++instance Arbitrary GlobalAttributes where+  arbitrary = gaGraph++  shrink (GraphAttrs atts) = map GraphAttrs $ nonEmptyShrinks atts+  shrink (NodeAttrs  atts) = map NodeAttrs  $ nonEmptyShrinks atts+  shrink (EdgeAttrs  atts) = map EdgeAttrs  $ nonEmptyShrinks atts++gaGraph :: Gen GlobalAttributes+gaGraph = gaFor arbGraphAttrs++gaSubGraph :: Gen GlobalAttributes+gaSubGraph = gaFor arbSubGraphAttrs++gaClusters :: Gen GlobalAttributes+gaClusters = gaFor arbClusterAttrs++gaFor   :: Gen Attributes -> Gen GlobalAttributes+gaFor g = oneof [ liftM GraphAttrs g+                , liftM NodeAttrs  arbNodeAttrs+                , liftM EdgeAttrs  arbEdgeAttrs+                ]
+ Data/GraphViz/Testing/Instances/Generalised.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}++{- |+   Module      : Data.GraphViz.Testing.Instances.Generalised+   Description : Generalised dot graph instances for Arbitrary.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com+ -}+module Data.GraphViz.Testing.Instances.Generalised where++import Data.GraphViz.Testing.Instances.Attributes()+import Data.GraphViz.Testing.Instances.Common+import Data.GraphViz.Testing.Instances.Helpers()++import Data.GraphViz.Types.Generalised+import Data.GraphViz.Util(bool)++import Test.QuickCheck++import qualified Data.Sequence as Seq+import Control.Monad(liftM, liftM2, liftM4)++-- -----------------------------------------------------------------------------+-- Defining Arbitrary instances for the generalised types++instance (Arbitrary n) => Arbitrary (DotGraph n) where+  arbitrary = liftM4 DotGraph arbitrary arbitrary arbitrary genDStmts++  shrink (DotGraph str dir gid stmts) = map (DotGraph str dir gid)+                                          $ shrinkDStmts stmts++genDStmts :: (Arbitrary n) => Gen (DotStatements n)+genDStmts = sized (arbDS gaGraph True)++genDStmt :: (Arbitrary n) => Gen GlobalAttributes -> Bool+            -> Gen (DotStatement n)+genDStmt ga haveSGs = frequency+                      . bool id ((1,genSG):) haveSGs+                      $ [ (3, liftM GA ga)+                        , (5, liftM DN arbitrary)+                        , (7, liftM DE arbitrary)+                        ]+  where+    genSG = liftM SG arbitrary++shrinkDStmts :: (Arbitrary n) => DotStatements n -> [DotStatements n]+shrinkDStmts gds+  | len == 1  = map Seq.singleton . shrink $ Seq.index gds 0+  | otherwise = [gds1, gds2]+    where+      len = Seq.length gds+      -- Halve the sequence+      (gds1, gds2) = (len `div` 2) `Seq.splitAt` gds++instance (Arbitrary n) => Arbitrary (DotStatement n) where+  arbitrary = genDStmt gaGraph True++  shrink (GA ga) = map GA $ shrink ga+  shrink (SG sg) = map SG $ shrink sg+  shrink (DN dn) = map DN $ shrink dn+  shrink (DE de) = map DE $ shrink de++-- | If 'True', generate 'GDotSubGraph's; otherwise don't.+arbDS              :: (Arbitrary n) => Gen GlobalAttributes -> Bool -> Int -> Gen (DotStatements n)+arbDS ga haveSGs s = liftM Seq.fromList . resize s' . listOf $ genDStmt ga haveSGs+  where+    s' = min s 10+++instance (Arbitrary n) => Arbitrary (DotSubGraph n) where+  arbitrary = do isClust <- arbitrary+                 let ga = bool gaSubGraph gaClusters isClust+                 liftM2 (DotSG isClust) arbitrary (sized $ arbDS ga False)++  shrink (DotSG isCl mid stmts) = map (DotSG isCl mid) $ shrinkDStmts stmts
+ Data/GraphViz/Testing/Instances/Helpers.hs view
@@ -0,0 +1,138 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+   Module      : Data.GraphViz.Testing.Instances.Helpers+   Description : Helper functions for graphviz Arbitrary instances.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com+ -}+module Data.GraphViz.Testing.Instances.Helpers where++import Data.GraphViz.Parsing(isNumString)+import Data.GraphViz.State(initialState, layerSep)++import Test.QuickCheck++import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)+import Control.Monad(liftM, liftM2)++-- -----------------------------------------------------------------------------+-- Helper Functions++instance Arbitrary Text where+  arbitrary = arbText++  shrink = filter validString+           . map T.pack . nonEmptyShrinks' . T.unpack++arbText :: Gen Text+arbText = suchThat genStr notBool+    where+      genStr = liftM2 T.cons (elements notDigits)+                             (liftM T.concat . listOf $ elements strChr)+      notDigits = ['a'..'z'] ++ ['\'', '"', ' ', '(', ')', ',', ':', '\\']+      strChr = map T.singleton $ notDigits ++ '.' : ['0'..'9']++arbString :: Gen String+arbString = liftM T.unpack arbitrary++fromPositive              :: Positive a -> a+fromPositive (Positive a) = a++posArbitrary :: (Arbitrary a, Num a, Ord a) => Gen a+posArbitrary = liftM fromPositive arbitrary++arbIDString :: Gen Text+arbIDString = suchThat genStr notBool+  where+    genStr = liftM2 T.cons (elements frst)+                           (liftM T.pack . listOf $ elements rest)+    frst = ['a'..'z'] ++ ['_']+    rest = frst ++ ['0'.. '9']++validString :: Text -> Bool+validString = liftM2 (&&) notBool notNumStr++notBool         :: Text -> Bool+notBool "true"  = False+notBool "false" = False+notBool _       = True++shrinkString :: String -> [String]+shrinkString = map T.unpack . shrink . T.pack++notNumStr :: Text -> Bool+notNumStr = not . isNumString++arbBounded :: (Bounded a, Enum a) => Gen a+arbBounded = elements [minBound .. maxBound]++arbLayerName :: Gen Text+arbLayerName = suchThat arbitrary (T.all notLayerSep)+  where+    defLayerSep = layerSep initialState+    notLayerSep = (`notElem` defLayerSep)++arbStyleName :: Gen Text+arbStyleName = suchThat arbitrary (T.all notBrackCom)+  where+    notBrackCom = flip notElem ['(', ')', ',', ' ']++arbList :: (Arbitrary a) => Gen [a]+arbList = listOf1 arbitrary++nonEmptyShrinks :: (Arbitrary a) => [a] -> [[a]]+nonEmptyShrinks = filter (not . null) . shrinkList++nonEmptyShrinks' :: [a] -> [[a]]+nonEmptyShrinks' = filter (not . null) . shrinkList'++-- Shrink lists with more than one value only by removing values, not+-- by shrinking individual items.+shrinkList     :: (Arbitrary a) => [a] -> [[a]]+shrinkList [a] = map return $ shrink a+shrinkList as  = shrinkList' as++-- Just shrink the size.+shrinkList'     :: [a] -> [[a]]+shrinkList' as  = rm (length as) as+  where+    rm 0 _  = []+    rm 1 _  = [[]]+    rm n xs = xs1+            : xs2+            : ( [ xs1' ++ xs2 | xs1' <- rm n1 xs1, not (null xs1') ]+                `ilv` [ xs1 ++ xs2' | xs2' <- rm n2 xs2, not (null xs2') ]+              )+     where+      n1  = n `div` 2+      xs1 = take n1 xs+      n2  = n - n1+      xs2 = drop n1 xs++    []     `ilv` ys     = ys+    xs     `ilv` []     = xs+    (x:xs) `ilv` (y:ys) = x : y : (xs `ilv` ys)++-- When a Maybe value is a sub-component, and we need shrink to return+-- a value.+shrinkM         :: (Arbitrary a) => Maybe a -> [Maybe a]+shrinkM Nothing = [Nothing]+shrinkM j       = shrink j++shrinkL    :: (Arbitrary a) => [a] -> [[a]]+shrinkL xs = case shrinkList xs of+               []  -> [xs]+               xs' -> xs'++notInt   :: Double -> Bool+notInt d = fromIntegral (round d :: Int) /= d++returnCheck     :: (Eq a) => a -> a -> [a]+returnCheck o n = if o == n+                  then []+                  else [n]
Data/GraphViz/Testing/Properties.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}+ {- |    Module      : Data.GraphViz.Testing.Properties    Description : Properties for testing.@@ -10,16 +12,18 @@ module Data.GraphViz.Testing.Properties where  import Data.GraphViz( dotizeGraph, graphToDot-                    , setDirectedness, nonClusteredParams, prettyPrint')-import Data.GraphViz.Types( DotRepr, DotGraph(..), DotStatements(..)+                    , setDirectedness, nonClusteredParams)+import Data.GraphViz.Types( DotRepr(..), PrintDotRepr                           , DotNode(..), DotEdge(..), GlobalAttributes(..)                           , printDotGraph, graphNodes, graphEdges                           , graphStructureInformation)-import Data.GraphViz.Types.Generalised(generaliseDotGraph)+import Data.GraphViz.Types.Canonical(DotGraph(..), DotStatements(..))+import qualified Data.GraphViz.Types.Generalised as G import Data.GraphViz.Printing(PrintDot(..), printIt) import Data.GraphViz.Parsing(ParseDot(..), parseIt, parseIt') import Data.GraphViz.PreProcessing(preProcess) import Data.GraphViz.Util(groupSortBy, isSingle)+import Data.GraphViz.Algorithms  import Test.QuickCheck @@ -29,6 +33,7 @@ import Data.Function(on) import qualified Data.Map as Map import qualified Data.Set as Set+import Data.Text.Lazy(Text) import Control.Arrow((&&&))  -- -----------------------------------------------------------------------------@@ -45,28 +50,21 @@ prop_printParseListID    :: (ParseDot a, PrintDot a, Eq a) => [a] -> Property prop_printParseListID as =  not (null as) ==> prop_printParseID as --- | When converting a 'DotGraph' value to a 'GDotGraph' one, they---   should generate the same Dot code.-prop_generalisedSameDot    :: (Ord n, ParseDot n, PrintDot n)-                              => DotGraph n -> Bool+-- | When converting a canonical 'DotGraph' value to any other one,+--   they should generate the same Dot code.+prop_generalisedSameDot    :: (Ord n, PrintDot n, ParseDot n) => DotGraph n -> Bool prop_generalisedSameDot dg = printDotGraph dg == printDotGraph gdg   where-    gdg = generaliseDotGraph dg+    gdg = canonicalToType (undefined :: G.DotGraph n) dg  -- | Pre-processing shouldn't change the output of printed Dot code. --   This should work for all 'PrintDot' instances, but is more --   specific to 'DotGraph' values.-prop_preProcessingID    :: (DotRepr dg n) => dg n -> Bool+prop_preProcessingID    :: (PrintDotRepr dg n) => dg n -> Bool prop_preProcessingID dg = preProcess dotCode == dotCode   where     dotCode = printDotGraph dg --- | This is a version of 'prop_printParseID' that tries to parse the---   pretty-printed output of 'prettyPrint'' rather than just 'printIt'.-prop_parsePrettyID    :: (DotRepr dg n, Eq (dg n), ParseDot (dg n))-                         => dg n -> Bool-prop_parsePrettyID dg = (parseIt' . prettyPrint') dg == dg- -- | This property verifies that 'dotizeGraph', etc. only /augment/ the --   original graph; that is, the actual nodes, edges and labels for --   each remain unchanged.  Whilst 'dotize', etc. only require@@ -92,49 +90,25 @@           $ groupSortBy fst les     uniqLs ls = ls == nub ls --- | Ensure that the definition of 'nodeInformation' for 'DotGraph'---   finds all the nodes.-prop_findAllNodes   :: (Ord el, Graph g) => g nl el -> Bool-prop_findAllNodes g = ((==) `on` sort) gns dgns-  where-    gns = nodes g-    dg = setDirectedness graphToDot nonClusteredParams g-    dgns = map nodeID $ graphNodes dg---- | Ensure that the definition of 'nodeInformation' for 'GDotGraph'+-- | Ensure that the definition of 'nodeInformation' for a DotRepr --   finds all the nodes.-prop_findAllNodesG   :: (Ord el, Graph g) => g nl el -> Bool-prop_findAllNodesG g = ((==) `on` sort) gns dgns+prop_findAllNodes       :: (DotRepr dg Int, Ord el, Graph g)+                           => dg Int -> g nl el -> Bool+prop_findAllNodes dg' g = ((==) `on` sort) gns dgns   where     gns = nodes g-    dg = generaliseDotGraph $ setDirectedness graphToDot nonClusteredParams g+    dg = canonicalToType dg' $ setDirectedness graphToDot nonClusteredParams g     dgns = map nodeID $ graphNodes dg --- | Ensure that the definition of 'nodeInformation' for 'DotGraph'---   finds all the nodes when the explicit 'DotNode' definitions are---   removed.-prop_findAllNodesE   :: (Ord el, Graph g) => g nl el -> Bool-prop_findAllNodesE g = ((==) `on` sort) gns dgns-  where-    gns = nodes g-    dg = removeNodes $ setDirectedness graphToDot nonClusteredParams g-    dgns = map nodeID $ graphNodes dg-    removeNodes dot@DotGraph{graphStatements = stmts}-      = dot { graphStatements-               = stmts {nodeStmts = filter notInEdge $ nodeStmts stmts}-            }-    gnes = Set.fromList . concatMap (\(f,t) -> [f,t]) $ edges g-    notInEdge dn = nodeID dn `Set.notMember` gnes---- | Ensure that the definition of 'nodeInformation' for 'GDotGraph'+-- | Ensure that the definition of 'nodeInformation' for DotReprs --   finds all the nodes when the explicit 'DotNode' definitions are --   removed.-prop_findAllNodesEG   :: (Ord el, Graph g) => g nl el -> Bool-prop_findAllNodesEG g = ((==) `on` sort) gns dgns+prop_findAllNodesE       :: (DotRepr dg Int, Ord el, Graph g)+                            => dg Int -> g nl el -> Bool+prop_findAllNodesE dg' g = ((==) `on` sort) gns dgns   where     gns = nodes g-    dg = generaliseDotGraph . removeNodes-         $ setDirectedness graphToDot nonClusteredParams g+    dg = canonicalToType dg' . removeNodes $ setDirectedness graphToDot nonClusteredParams g     dgns = map nodeID $ graphNodes dg     removeNodes dot@DotGraph{graphStatements = stmts}       = dot { graphStatements@@ -143,40 +117,38 @@     gnes = Set.fromList . concatMap (\(f,t) -> [f,t]) $ edges g     notInEdge dn = nodeID dn `Set.notMember` gnes --- | Ensure that the definition of 'edgeInformation' for 'DotGraph'---   finds all the nodes.-prop_findAllEdges   :: (Ord el, Graph g) => g nl el -> Bool-prop_findAllEdges g = ((==) `on` sort) ges dges-  where-    ges = edges g-    dg = graphToDot nonClusteredParams g-    dges = map (edgeFromNodeID &&& edgeToNodeID) $ graphEdges dg---- | Ensure that the definition of 'edgeInformation' for 'GDotGraph'+-- | Ensure that the definition of 'edgeInformation' for DotReprs --   finds all the nodes.-prop_findAllEdgesG   :: (Ord el, Graph g) => g nl el -> Bool-prop_findAllEdgesG g = ((==) `on` sort) ges dges+prop_findAllEdges       :: (DotRepr dg Int, Ord el, Graph g) => dg Int -> g nl el -> Bool+prop_findAllEdges dg' g = ((==) `on` sort) ges dges   where     ges = edges g-    dg = generaliseDotGraph $ graphToDot nonClusteredParams g-    dges = map (edgeFromNodeID &&& edgeToNodeID) $ graphEdges dg+    dg = canonicalToType dg' $ graphToDot nonClusteredParams g+    dges = map (fromNode &&& toNode) $ graphEdges dg  -- | There should be no clusters or global attributes when converting---   a 'Graph' to a 'DotGraph' without any formatting or clustering.-prop_noGraphInfo   :: (Ord el, Graph g) => g nl el -> Bool-prop_noGraphInfo g = info == (GraphAttrs [], Map.empty)+--   a 'Graph' to a DotRepr (via fromCanonical) without any formatting+--   or clustering.+prop_noGraphInfo       :: (DotRepr dg Int, Ord el, Graph g)+                          => dg Int -> g nl el -> Bool+prop_noGraphInfo dg' g = info == (GraphAttrs [], Map.empty)   where-    dg = setDirectedness graphToDot nonClusteredParams g+    dg = canonicalToType dg'+         $ setDirectedness graphToDot nonClusteredParams g     info = graphStructureInformation dg --- | There should be no clusters or global attributes when converting---   a 'Graph' to a 'GDotGraph' without any formatting or clustering.-prop_noGraphInfoG   :: (Ord el, Graph g) => g nl el -> Bool-prop_noGraphInfoG g = info == (GraphAttrs [], Map.empty)+-- | Canonicalisation should be idempotent.+prop_canonicalise   :: (ParseDot n, PrintDot n, DotRepr dg n) => dg n -> Bool+prop_canonicalise g = cdg == canonicalise cdg   where-    dg = generaliseDotGraph $ setDirectedness graphToDot nonClusteredParams g-    info = graphStructureInformation dg+    cdg = canonicalise g +-- | Removing transitive edges should be idempotent.+prop_transitive   :: (DotRepr dg n) => dg n -> Bool+prop_transitive g = tdg == transitiveReduction tdg+  where+    tdg = transitiveReduction g+ -- ----------------------------------------------------------------------------- -- Helper utility functions @@ -184,10 +156,15 @@ --   find how graphviz /is/ parsing something.  This is easier than --   using @'parseIt' . 'printIt'@ directly, since it avoids having to --   enter and explicit type signature.-tryParse :: (ParseDot a, PrintDot a) => a -> (a, String)+tryParse :: (ParseDot a, PrintDot a) => a -> (a, Text) tryParse = parseIt . printIt  -- | Equivalent to 'tryParse' except that it is assumed that the --   entire 'String' *is* fully consumed. tryParse' :: (ParseDot a, PrintDot a) => a -> a tryParse' = parseIt' . printIt++-- | A wrapper around 'fromCanonical' that lets you specify up-front+--   what type to create (it need not be a sensible value).+canonicalToType   :: (DotRepr dg n) => dg n -> DotGraph n -> dg n+canonicalToType _ = fromCanonical
Data/GraphViz/Types.hs view
@@ -1,149 +1,165 @@-{-# LANGUAGE   MultiParamTypeClasses-             , FlexibleInstances-  #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}  {- |    Module      : Data.GraphViz.Types-   Description : Definition of the Graphviz types.-   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   Description : Haskell representation of Dot graphs.+   Copyright   : (c) Ivan Lazar Miljenovic    License     : 3-Clause BSD-style    Maintainer  : Ivan.Miljenovic@gmail.com -   This module defines the overall types and methods that interact-   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.--   * If you want any 'GlobalAttributes' in a 'DotSubGraph' and want-     them to only apply to that 'DotSubGraph', then you must ensure it-     does indeed have a valid 'GraphID'.--   * All 'DotSubGraph's with @'isCluster' = 'True'@ /must/ have unique-     'subGraphID' values (well, only if you want them to be generated-     sensibly).--   * If eventually outputting to a format such as SVG, then you should-     make sure that your 'DotGraph' has a 'graphID', as that is used-     as the title of the resulting image.+   Four different representations of Dot graphs are available, all of+   which are based loosely upon the specifications at:+   <http://graphviz.org/doc/info/lang.html>.  The 'DotRepr' class+   provides a common interface for them (the 'PrintDotRepr',+   'ParseDotRepr' and 'PPDotRepr' classes are used until class aliases+   are implemented). -   * 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.).+   Every representation takes in a type parameter: this indicates the+   node type (e.g. @DotGraph Int@ is a Dot graph with integer nodes).+   Sum types are allowed, though care must be taken when specifying+   their 'ParseDot' instances if there is the possibility of+   overlapping definitions.  The 'GraphID' type is an existing sum+   type that allows textual and numeric values. -   * Also, whilst Graphviz allows you to mix the types used for nodes,-     this library requires\/assumes that they are all the same type.+   If you require using more than one Dot representation, you will+   most likely need to import at least one of them qualified, as they+   typically all use the same names. -   * '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.+   As a comparison, all four representations provide how you would+   define the following Dot graph (or at least one isomorphic to it)+   (the original of which can be found at+   <http://graphviz.org/content/cluster>).  Note that in all the+   examples, they are not necessarily done the best way (variables+   rather than repeated constants, etc.); they are just there to+   provide a comparison on the structure of each representation. -   * 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.+   > digraph G {+   >+   > 	subgraph cluster_0 {+   > 		style=filled;+   > 		color=lightgrey;+   > 		node [style=filled,color=white];+   > 		a0 -> a1 -> a2 -> a3;+   > 		label = "process #1";+   > 	}+   >+   > 	subgraph cluster_1 {+   > 		node [style=filled];+   > 		b0 -> b1 -> b2 -> b3;+   > 		label = "process #2";+   > 		color=blue+   > 	}+   > 	start -> a0;+   > 	start -> b0;+   > 	a1 -> b3;+   > 	b2 -> a3;+   > 	a3 -> a0;+   > 	a3 -> end;+   > 	b3 -> end;+   >+   > 	start [shape=Mdiamond];+   > 	end [shape=Msquare];+   > } -   * It is not yet possible to create or parse edges with-     subgraphs\/clusters as one of the end points.+    Each representation is suited for different things: -   * When either creating a 'DotGraph' by hand or parsing one, it is-     possible to specify that @'directedGraph' = d@, but 'DotEdge'-     values with @'directedEdge' = 'not' d@.+    ["Data.GraphViz.Types.Canonical"] is ideal for converting other+    graph-like data structures into Dot graphs (the "Data.GraphViz"+    module provides some functions for this).  It is a structured+    representation of Dot code. -   * 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.  If you wish to be able-     to use an arbitrary ordering, you may wish to use-     "Data.GraphViz.Types.Generalised".+    ["Data.GraphViz.Types.Generalised"] matches the actual structure+    of Dot code.  As such, it is suited for parsing in existing Dot+    code. -   * The parser will strip out comments and pre-processor lines, join-     together multiline statements and concatenate split strings together.-     However, pre-processing within HTML-like labels is currently not-     supported.+    ["Data.GraphViz.Types.Graph"] provides graph operations for+    manipulating Dot graphs; this is suited when you want to edit+    existing Dot code.  It uses generalised Dot graphs for parsing and+    canonical Dot graphs for printing. -   * Graphviz allows a node to be \"defined\" twice (e.g. the actual-     node definition, and then in a subgraph with extra global attributes-     applied to it).  This actually represents the same node, but when-     parsing they will be considered as separate 'DotNode's (such that-     'graphNodes' will return both \"definitions\").  The canonical form-     (see @prettyPrint@ in "Data.GraphViz") combines the \"definitions\"-     into one.+    ["Data.GraphViz.Types.Monadic"] is a much easier representation to+    use when defining relatively static Dot graphs in Haskell code,+    and looks vaguely like actual Dot code if you squint a bit. -   See "Data.GraphViz.Attributes" for more limitations.+    Please also read the limitations section at the end for advice on+    how to properly use these Dot representations.  -} module Data.GraphViz.Types-    ( -- * Abstraction from the representation type-      DotRepr(..)-      -- ** Helper types for looking up information within a @DotRepr@.-    , ClusterLookup-    , NodeLookup-    , Path-      -- ** Obtaining the @DotNode@s and @DotEdges@.-    , graphNodes-    , graphEdges-      -- ** Printing and parsing a @DotRepr@.-    , printDotGraph-    , parseDotGraph-      -- * The overall representation of a graph in /Dot/ format.-    , DotGraph(..)-      -- ** Reporting of errors in a @DotGraph@.-    , DotError(..)-    , isValidGraph-    , graphErrors-      -- * Sub-components of a @DotGraph@.-    , GraphID(..) -- Re-exported from Data.GraphViz.Types.Common-    , DotStatements(..)-    , GlobalAttributes(..) -- Re-exported from Data.GraphViz.Types.Common-    , DotSubGraph(..)-    , DotNode(..)-    , DotEdge(..) -- Re-exported from Data.GraphViz.Types.Common-    ) where+       ( DotRepr(..)+       , PrintDotRepr+       , ParseDotRepr+       , PPDotRepr+         -- * Common sub-types+       , GraphID(..)+       , GlobalAttributes(..)+       , DotNode(..)+       , DotEdge(..)+         -- * Helper types for looking up information within a @DotRepr@.+       , ClusterLookup+       , NodeLookup+       , Path+         -- * Obtaining the @DotNode@s and @DotEdges@.+       , graphNodes+       , graphEdges+         -- * Printing and parsing a @DotRepr@.+       , printDotGraph+       , parseDotGraph+         -- * Limitations and documentation+         -- $limitations+       ) where -import Data.GraphViz.Types.Common+import Data.GraphViz.Types.Canonical( DotGraph(..), DotStatements(..)+                                    , DotSubGraph(..))+import Data.GraphViz.Types.Common( GraphID(..), GlobalAttributes(..)+                                 , DotNode(..), DotEdge(..), numericValue) import Data.GraphViz.Types.State-import Data.GraphViz.Attributes( Attribute-                               , usedByGraphs, usedByClusters, usedBySubGraphs)-import Data.GraphViz.Util-import Data.GraphViz.Parsing-import Data.GraphViz.PreProcessing-import Data.GraphViz.Printing+import Data.GraphViz.Util(bool)+import Data.GraphViz.Parsing(ParseDot, parseIt)+import Data.GraphViz.PreProcessing(preProcess)+import Data.GraphViz.Printing(PrintDot, printIt) -import Control.Arrow((&&&))-import Control.Monad(liftM)+import Data.Text.Lazy(Text)+import Control.Monad.Trans.State(get, put, modify, execState, evalState)  -- -----------------------------------------------------------------------------  -- | This class is used to provide a common interface to different --   ways of representing a graph in /Dot/ form.-class (PrintDot (dg n), ParseDot (dg n)) => DotRepr dg n where+--+--   You will most probably /not/ need to create your own instances of+--   this class.+--+--   The type variable represents the current node type of the Dot+--   graph, and the 'Ord' restriction is there because in practice+--   most implementations of some of these methods require it.+class (Ord n) => DotRepr dg n where+  -- | Convert from a graph in canonical form.  This is especially+  --   useful when using the functions from "Data.GraphViz.Algorithms".+  fromCanonical :: DotGraph n -> dg n+   -- | Return the ID of the graph.   getID :: dg n -> Maybe GraphID +  -- | Set the ID of the graph.+  setID :: GraphID -> dg n -> dg n+   -- | Is this graph directed?   graphIsDirected :: dg n -> Bool -  -- | Is this graph strict?+  -- | Set whether a graph is directed or not.+  setIsDirected :: Bool -> dg n -> dg n++  -- | Is this graph strict?  Strict graphs disallow multiple edges.   graphIsStrict :: dg n -> Bool    -- | A strict graph disallows multiple edges.-  makeStrict :: dg n -> dg n+  setStrictness :: Bool -> dg n -> dg n -  -- | Set the ID of the graph.-  setID :: GraphID -> dg n -> dg n+  -- | Change the node values.  This function is assumed to be+  --   /injective/, otherwise the resulting graph will not be+  --   identical to the original (modulo labels).+  mapDotGraph :: (Ord n', DotRepr dg n') => (n -> n') -> dg n -> dg n'    -- | Return information on all the clusters contained within this   --   'DotRepr', as well as the top-level 'GraphAttrs' for the@@ -160,21 +176,41 @@   --   'EdgeAttrs' should be included.   edgeInformation :: Bool -> dg n -> [DotEdge n] +  -- | Give any anonymous sub-graphs or clusters a unique identifier+  --   (i.e. there will be no 'Nothing' key in the 'ClusterLookup'+  --   from 'graphStructureInformation').+  unAnonymise :: dg n -> dg n++-- | This class exists just to make type signatures nicer; all+--   instances of 'DotRepr' should also be an instance of+--   'PrintDotRepr'.+class (DotRepr dg n, PrintDot (dg n)) => PrintDotRepr dg n++-- | This class exists just to make type signatures nicer; all+--   instances of 'DotRepr' should also be an instance of+--   'ParseDotRepr'.+class (DotRepr dg n, ParseDot (dg n)) => ParseDotRepr dg n++-- | This class exists just to make type signatures nicer; all+--   instances of 'DotRepr' should also be an instance of+--   'PPDotRepr'.+class (PrintDotRepr dg n, ParseDotRepr dg n) => PPDotRepr dg n+ -- | Returns all resultant 'DotNode's in the 'DotRepr' (not including --   'NodeAttr's).-graphNodes :: (DotRepr dg n, Ord n) => dg n -> [DotNode n]-graphNodes = toDotNodes . nodeInformation True+graphNodes :: (DotRepr dg n) => dg n -> [DotNode n]+graphNodes = toDotNodes . nodeInformation False  -- | Returns all resultant 'DotEdge's in the 'DotRepr' (not including --   'EdgeAttr's). graphEdges :: (DotRepr dg n) => dg n -> [DotEdge n]-graphEdges = edgeInformation True+graphEdges = edgeInformation False  -- | The actual /Dot/ code for an instance of 'DotRepr'.  Note that it --   is expected that @'parseDotGraph' . 'printDotGraph' == 'id'@ --   (this might not be true the other way around due to un-parseable --   components).-printDotGraph :: (DotRepr dg n) => dg n -> String+printDotGraph :: (PrintDotRepr dg n) => dg n -> Text printDotGraph = printIt  -- | Parse a limited subset of the Dot language to form an instance of@@ -182,29 +218,28 @@ --   may or may not be parseable Dot code. -- --   Also removes any comments, etc. before parsing.-parseDotGraph :: (DotRepr dg n) => String -> dg n+parseDotGraph :: (ParseDotRepr dg n) => Text -> dg n parseDotGraph = fst . parseIt . preProcess  -- -----------------------------------------------------------------------------+-- Instance for Canonical graphs, to avoid cyclic modules. --- | The internal representation of a graph in Dot form.-data DotGraph a = DotGraph { strictGraph     :: Bool  -- ^ If 'True', no multiple edges are drawn.-                           , directedGraph   :: Bool-                           , graphID         :: Maybe GraphID-                           , graphStatements :: DotStatements a-                           }-                  deriving (Eq, Ord, Show, Read)+instance (Ord n) => DotRepr DotGraph n where+  fromCanonical = id -instance (Ord n, PrintDot n, ParseDot n) => DotRepr DotGraph n where   getID = graphID +  setID i g = g { graphID = Just i }+   graphIsDirected = directedGraph +  setIsDirected d g = g { directedGraph = d }+   graphIsStrict = strictGraph -  makeStrict g = g { strictGraph = True }+  setStrictness s g = g { strictGraph = s } -  setID i g = g { graphID = Just i }+  mapDotGraph = fmap    graphStructureInformation = getGraphInfo                               . statementStructure . graphStatements@@ -215,133 +250,126 @@   edgeInformation wGlobal = getDotEdges wGlobal                             . statementEdges . graphStatements --- | 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 toDot-    where-      printGraphID' = printGraphID strictGraph directedGraph graphID--instance (ParseDot a) => ParseDot (DotGraph a) where-    parseUnqt = parseStmtBased parse (parseGraphID DotGraph)--    parse = parseUnqt -- Don't want the option of quoting-            `adjustErr`-            (++ "\n\nNot a valid DotGraph")--instance Functor DotGraph where-    fmap f g = g { graphStatements = fmap f $ graphStatements g }---- -------------------------------------------------------------------------------data DotStatements a = DotStmts { attrStmts :: [GlobalAttributes]-                                , subGraphs :: [DotSubGraph a]-                                , nodeStmts :: [DotNode a]-                                , edgeStmts :: [DotEdge a]-                                }-                     deriving (Eq, Ord, Show, Read)--instance (PrintDot a) => PrintDot (DotStatements a) where-    unqtDot stmts = vcat [ unqtDot $ attrStmts stmts-                         , unqtDot $ subGraphs stmts-                         , unqtDot $ nodeStmts stmts-                         , unqtDot $ 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-                         }+  unAnonymise = renumber --- | 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)+instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n+instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n+instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n  statementStructure :: DotStatements n -> GraphState () statementStructure stmts   = do mapM_ addGraphGlobals $ attrStmts stmts        mapM_ (withSubGraphID addSubGraph statementStructure) $ subGraphs stmts -statementNodes :: (Ord a) => DotStatements a -> NodeState a ()+statementNodes :: (Ord n) => DotStatements n -> NodeState n () statementNodes stmts   = do mapM_ addNodeGlobals $ attrStmts stmts        mapM_ (withSubGraphID recursiveCall statementNodes) $ subGraphs stmts        mapM_ addNode $ nodeStmts stmts        mapM_ addEdgeNodes $ edgeStmts stmts -statementEdges :: DotStatements a -> EdgeState a ()+statementEdges :: DotStatements n -> EdgeState n () statementEdges stmts   = do mapM_ addEdgeGlobals $ attrStmts stmts        mapM_ (withSubGraphID recursiveCall statementEdges) $ subGraphs stmts        mapM_ addEdge $ edgeStmts stmts +withSubGraphID        :: (Maybe (Maybe GraphID) -> b -> a)+                         -> (DotStatements n -> b) -> DotSubGraph n -> a+withSubGraphID f g sg = f mid . g $ subGraphStmts sg+  where+    mid = bool Nothing (Just $ subGraphID sg) $ isCluster sg++renumber    :: DotGraph n -> DotGraph n+renumber dg = dg { graphStatements = newStmts }+  where+    startN = succ $ maxSGInt dg++    newStmts = evalState (stRe $ graphStatements dg) startN++    stRe st = do sgs' <- mapM sgRe $ subGraphs st+                 return $ st { subGraphs = sgs' }+    sgRe sg = do sgid' <- case subGraphID sg of+                            Nothing -> do n <- get+                                          put $ succ n+                                          return . Just $ Int n+                            sgid    -> return sgid+                 stmts' <- stRe $ subGraphStmts sg+                 return $ sg { subGraphID    = sgid'+                             , subGraphStmts = stmts'+                             }++maxSGInt    :: DotGraph n -> Int+maxSGInt dg = execState (stInt $ graphStatements dg)+              . flip check 0+              $ graphID dg+  where+    check = maybe id max . (numericValue =<<)++    stInt = mapM_ sgInt . subGraphs+    sgInt sg = do modify (check $ subGraphID sg)+                  stInt $ subGraphStmts sg+ -- ----------------------------------------------------------------------------- -data DotSubGraph a = DotSG { isCluster     :: Bool-                           , subGraphID    :: Maybe GraphID-                           , subGraphStmts :: DotStatements a-                           }-                   deriving (Eq, Ord, Show, Read)+{- $limitations -instance (PrintDot a) => PrintDot (DotSubGraph a) where-    unqtDot = printStmtBased printSubGraphID' subGraphStmts toDot+   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 textual values is done automagically. -    unqtListToDot = printStmtBasedList printSubGraphID' subGraphStmts toDot+   A summary of known limitations\/differences: -    listToDot = unqtListToDot+   * When creating 'GraphID' values for graphs and sub-graphs,+     you should ensure that none of them have the same printed value+     as one of the node identifiers values to avoid any possible problems. -printSubGraphID' :: DotSubGraph a -> DotCode-printSubGraphID' = printSubGraphID (isCluster &&& subGraphID)+   * If you want any 'GlobalAttributes' in a sub-graph and want+     them to only apply to that sub-graph, then you must ensure it+     does indeed have a valid 'GraphID'. -instance (ParseDot a) => ParseDot (DotSubGraph a) where-    parseUnqt = parseStmtBased parseUnqt (parseSubGraphID DotSG)-                `onFail`-                -- Take "anonymous" DotSubGraphs into account.-                liftM (DotSG False Nothing) (parseBracesBased parseUnqt)+   * All sub-graphs which represent clusters should have unique+     identifiers (well, only if you want them to be generated+     sensibly). -    parse = parseUnqt -- Don't want the option of quoting-            `adjustErr`-            (++ "\n\nNot a valid Sub Graph")+   * If eventually outputting to a format such as SVG, then you should+     make sure to specify an identifier for the overall graph, as that is+     used as the title of the resulting image. -    parseUnqtList = sepBy (whitespace' >> parseUnqt) newline'+   * Whilst the graphs, 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.). -    parseList = parseUnqtList+   * Also, whilst Graphviz allows you to mix the types used for nodes,+     this library requires\/assumes that they are all the same type (but+     you /can/ use a sum-type). -instance Functor DotSubGraph where-    fmap f sg = sg { subGraphStmts = fmap f $ subGraphStmts sg }+   * '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. -invalidSubGraph    :: DotSubGraph a -> [DotError a]-invalidSubGraph sg = invalidStmts valFunc (subGraphStmts sg)-    where-      valFunc = bool usedBySubGraphs usedByClusters (isCluster sg)+   * 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. -withSubGraphID        :: (Maybe (Maybe GraphID) -> b -> a)-                         -> (DotStatements n -> b) -> DotSubGraph n -> a-withSubGraphID f g sg = f mid . g $ subGraphStmts sg-  where-    mid = bool Nothing (Just $ subGraphID sg) $ isCluster sg+   * It is not yet possible to create or parse edges with+     subgraphs\/clusters as one of the end points.++   * The parser will strip out comments and pre-processor lines, join+     together multiline statements and concatenate split strings together.+     However, pre-processing within HTML-like labels is currently not+     supported.++   * Graphviz allows a node to be \"defined\" twice (e.g. the actual+     node definition, and then in a subgraph with extra global attributes+     applied to it).  This actually represents the same node, but when+     parsing they will be considered as separate 'DotNode's (such that+     'graphNodes' will return both \"definitions\").  @canonicalise@ from+     "Data.GraphViz.Algorithms" can be used to fix this.++   See "Data.GraphViz.Attributes" for more limitations.+ -}
+ Data/GraphViz/Types/Canonical.hs view
@@ -0,0 +1,189 @@+{- |+   Module      : Data.GraphViz.Types.Canonical+   Description : The canonical representation of Dot graphs.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   A canonical Dot graph requires that within each graph/sub-graph,+   the statements are in the following order:++   * global attributes++   * sub-graphs/clusters++   * nodes++   * edges++   This Dot graph representation is ideally suited for converting+   other data structures to Dot form (especially with the help of+   @graphElemsToDot@ from "Data.GraphViz").++   If you require arbitrary ordering of statements, then use+   "Data.GraphViz.Types.Generalised".++   The sample graph could be implemented (this is actually the result+   of calling @canonicalise@ from "Data.GraphViz.Algorithms" on the+   generalised one) as:++   > DotGraph { strictGraph = False+   >          , directedGraph = True+   >          , graphID = Just (Str "G")+   >          , graphStatements = DotStmts { attrStmts = []+   >                                       , subGraphs = [ DotSG { isCluster = True+   >                                                             , subGraphID = Just (Int 0)+   >                                                             , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [ style filled+   >                                                                                                                   , color LightGray+   >                                                                                                                   , textLabel "process #1"]+   >                                                                                                      , NodeAttrs [style filled, color White]]}+   >                                                                                       , subGraphs = []+   >                                                                                        , nodeStmts = [ DotNode "a0" []+   >                                                                                                      , DotNode "a1" []+   >                                                                                                      , DotNode "a2" []+   >                                                                                                      , DotNode "a3" []]+   >                                                                                        , edgeStmts = [ DotEdge "a0" "a1" []+   >                                                                                                      , DotEdge "a1" "a2" []+   >                                                                                                      , DotEdge "a2" "a3" []+   >                                                                                                      , DotEdge "a3" "a0" []]}}+   >                                                     , DotSG { isCluster = True+   >                                                             , subGraphID = Just (Int 1)+   >                                                             , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [textLabel "process #2", color Blue]+   >                                                                                                      , NodeAttrs [style filled]]+   >                                                                                        , subGraphs = []+   >                                                                                        , nodeStmts = [ DotNode "b0" []+   >                                                                                                      , DotNode "b1" []+   >                                                                                                      , DotNode "b2" []+   >                                                                                                      , DotNode "b3" []]+   >                                                                                        , edgeStmts = [ DotEdge "b0" "b1" []+   >                                                                                                      , DotEdge "b1" "b2" []+   >                                                                                                      , DotEdge "b2" "b3" []]}}]+   >                                       , nodeStmts = [ DotNode "end" [shape MSquare]+   >                                                     , DotNode "start" [shape MDiamond]]+   >                                       , edgeStmts = [ DotEdge "start" "a0" []+   >                                                     , DotEdge "start" "b0" []+   >                                                     , DotEdge "a1" "b3" []+   >                                                     , DotEdge "b2" "a3" []+   >                                                     , DotEdge "a3" "end" []+   >                                                     , DotEdge "b3" "end" []]}}++   Note that whilst the above graph represents the same Dot graph as+   specified in "Data.GraphViz.Types.Generalised", etc., it /may/ be+   drawn slightly differently by the various Graphviz tools.++ -}+module Data.GraphViz.Types.Canonical+       ( DotGraph(..)+         -- * Sub-components of a @DotGraph@.+       , DotStatements(..)+       , DotSubGraph(..)+         -- * Re-exported from @Data.GraphViz.Types@+       , GraphID(..)+       , GlobalAttributes(..)+       , DotNode(..)+       , DotEdge(..)+       ) where++import Data.GraphViz.Types.Common+import Data.GraphViz.Parsing+import Data.GraphViz.Printing++import Control.Arrow((&&&))+import Control.Monad(liftM)++-- -----------------------------------------------------------------------------++-- | A Dot graph in canonical form.+data DotGraph n = DotGraph { strictGraph     :: Bool  -- ^ If 'True', no multiple edges are drawn.+                           , directedGraph   :: Bool+                           , graphID         :: Maybe GraphID+                           , graphStatements :: DotStatements n+                           }+                deriving (Eq, Ord, Show, Read)++instance (PrintDot n) => PrintDot (DotGraph n) where+  unqtDot = printStmtBased printGraphID' graphStatements toDot+    where+      printGraphID' = printGraphID strictGraph directedGraph graphID++instance (ParseDot n) => ParseDot (DotGraph n) where+  parseUnqt = parseStmtBased parse (parseGraphID DotGraph)++  parse = parseUnqt -- Don't want the option of quoting+          `adjustErr`+          (++ "\n\nNot a valid DotGraph")++-- | Assumed to be an injective mapping function.+instance Functor DotGraph where+  fmap f g = g { graphStatements = fmap f $ graphStatements g }++-- -----------------------------------------------------------------------------++data DotStatements n = DotStmts { attrStmts :: [GlobalAttributes]+                                , subGraphs :: [DotSubGraph n]+                                , nodeStmts :: [DotNode n]+                                , edgeStmts :: [DotEdge n]+                                }+                     deriving (Eq, Ord, Show, Read)++instance (PrintDot n) => PrintDot (DotStatements n) where+  unqtDot stmts = vcat $ sequence [ unqtDot $ attrStmts stmts+                                  , unqtDot $ subGraphs stmts+                                  , unqtDot $ nodeStmts stmts+                                  , unqtDot $ edgeStmts stmts+                                  ]++instance (ParseDot n) => ParseDot (DotStatements n) where+  parseUnqt = do atts <- tryParseList+                 newline'+                 sGraphs <- tryParseList+                 newline'+                 nodes <- tryParseList+                 newline'+                 edges <- tryParseList+                 return $ DotStmts atts sGraphs nodes edges++  parse = parseUnqt -- Don't want the option of quoting+          `adjustErr`+          (++ "Not a valid set of statements")++instance Functor DotStatements where+  fmap f stmts = stmts { subGraphs = map (fmap f) $ subGraphs stmts+                       , nodeStmts = map (fmap f) $ nodeStmts stmts+                       , edgeStmts = map (fmap f) $ edgeStmts stmts+                       }++-- -----------------------------------------------------------------------------++data DotSubGraph n = DotSG { isCluster     :: Bool+                           , subGraphID    :: Maybe GraphID+                           , subGraphStmts :: DotStatements n+                           }+                   deriving (Eq, Ord, Show, Read)++instance (PrintDot n) => PrintDot (DotSubGraph n) where+  unqtDot = printStmtBased printSubGraphID' subGraphStmts toDot++  unqtListToDot = printStmtBasedList printSubGraphID' subGraphStmts toDot++  listToDot = unqtListToDot++printSubGraphID' :: DotSubGraph n -> DotCode+printSubGraphID' = printSubGraphID (isCluster &&& subGraphID)++instance (ParseDot n) => ParseDot (DotSubGraph n) where+  parseUnqt = parseStmtBased parseUnqt (parseSubGraphID DotSG)+              `onFail`+              -- Take "anonymous" DotSubGraphs into account.+              liftM (DotSG False Nothing) (parseBracesBased parseUnqt)++  parse = parseUnqt -- Don't want the option of quoting+          `adjustErr`+          (++ "\n\nNot a valid Sub Graph")++  parseUnqtList = sepBy (whitespace' >> parseUnqt) newline'++  parseList = parseUnqtList++instance Functor DotSubGraph where+  fmap f sg = sg { subGraphStmts = fmap f $ subGraphStmts sg }
− Data/GraphViz/Types/Clustering.hs 
@@ -1,120 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--{- |-   Module      : Data.GraphViz.Types.Clustering-   Description : Definition of the clustering types for Graphviz.-   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines types for creating clusters.--}-module Data.GraphViz.Types.Clustering-    ( LNodeCluster-    , NodeCluster(..)-    , clustersToNodes-    ) where--import Data.GraphViz.Types-import Data.GraphViz.Attributes--import Data.Either(partitionEithers)-import Data.List(groupBy, sortBy)-import Data.Graph.Inductive.Graph(Graph, Node, LNode, labNodes)---- --------------------------------------------------------------------------------- | A type alias for 'NodeCluster' that specifies that the node value---   is an 'LNode'.-type LNodeCluster c a = NodeCluster c (LNode a)---- | Define into which cluster a particular node belongs.---   Clusters can be nested to arbitrary depth.-data NodeCluster c a = N 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 /Dot/ representation for the given graph.-clustersToNodes :: (Ord c, Graph gr) => (LNode a -> NodeCluster c (LNode l))-                   -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])-                   -> (LNode l -> Attributes) -> gr a b-                   -> ([DotSubGraph Node], [DotNode Node])-clustersToNodes clusterBy cID fmtCluster fmtNode-    = treesToDot cID fmtCluster fmtNode-      . collapseNClusts-      . map (clustToTree . clusterBy)-      . labNodes---- --------------------------------------------------------------------------------- | A tree representation of a cluster.-data ClusterTree c a = NT a-                     | CT c [ClusterTree c a]-                       deriving (Show)---- | Convert a single node cluster into its tree representation.-clustToTree          :: NodeCluster c a -> ClusterTree c a-clustToTree (N ln)   = NT ln-clustToTree (C c nc) = CT c [clustToTree nc]---- | Two nodes are in the same "default" cluster; otherwise check if they---   are in the same cluster.-sameClust :: (Eq c) => ClusterTree c a -> ClusterTree c a -> Bool-sameClust (NT _)    (NT _)    = True-sameClust (CT c1 _) (CT c2 _) = c1 == c2-sameClust _         _         = False---- | 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 _ _)  = LT-clustOrder (CT _ _)  (NT _)    = GT-clustOrder (CT c1 _) (CT c2 _) = compare c1 c2---- | Extract the sub-trees.-getNodes           :: ClusterTree c a -> [ClusterTree c a]-getNodes n@(NT _)  = [n]-getNodes (CT _ ns) = ns---- | Combine clusters.-collapseNClusts :: (Ord c) => [ClusterTree c a] -> [ClusterTree c a]-collapseNClusts = concatMap grpCls-                  . groupBy sameClust-                  . sortBy clustOrder-    where-      grpCls []              = []-      grpCls ns@(NT _ : _)   = ns-      grpCls cs@(CT c _ : _) = [CT c (collapseNClusts $ concatMap getNodes cs)]---- | 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 (LNode a)]-              -> ([DotSubGraph Node], [DotNode Node])-treesToDot cID fmtCluster fmtNode-    = partitionEithers-      . map (treeToDot cID fmtCluster fmtNode)---- | Convert this 'ClusterTree' into its /Dot/ representation.-treeToDot :: (c -> Maybe GraphID) -> (c -> [GlobalAttributes])-             -> (LNode a -> Attributes) -> ClusterTree c (LNode 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-      stmts = DotStmts { attrStmts = fmtCluster c-                       , subGraphs = cs-                       , nodeStmts = ns-                       , edgeStmts = []-                       }-      (cs, ns) = treesToDot cID fmtCluster fmtNode nts
Data/GraphViz/Types/Common.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-}  {- |@@ -15,12 +16,16 @@ import Data.GraphViz.Parsing import Data.GraphViz.Printing import Data.GraphViz.Util-import Data.GraphViz.Attributes( Attributes, Attribute(HeadPort, TailPort)-                               , usedByGraphs, usedByClusters-                               , usedByNodes, usedByEdges)+import Data.GraphViz.Attributes.Complete( Attributes, Attribute(HeadPort, TailPort)+                                        , usedByGraphs, usedByClusters+                                        , usedByNodes) import Data.GraphViz.Attributes.Internal(PortPos, parseEdgeBasedPP)+import Data.GraphViz.State(setDirectedness, getDirectedness, getsGS, modifyGS)  import Data.Maybe(isJust)+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Read as T+import Data.Text.Lazy(Text) import Control.Monad(liftM, liftM2, when)  -- -----------------------------------------------------------------------------@@ -30,46 +35,42 @@ --   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+data GraphID = Str Text              | Int Int              | Dbl Double-               deriving (Eq, Ord, Show, Read)+             deriving (Eq, Ord, Show, Read)  instance PrintDot GraphID where-    unqtDot (Str str) = unqtDot str-    unqtDot (Int i)   = unqtDot i-    unqtDot (Dbl d)   = unqtDot d+  unqtDot (Str str) = unqtDot str+  unqtDot (Int i)   = unqtDot i+  unqtDot (Dbl d)   = unqtDot d -    toDot (Str str) = toDot str-    toDot gID       = unqtDot gID+  toDot (Str str) = toDot str+  toDot gID       = unqtDot gID  instance ParseDot GraphID where-    parseUnqt = liftM stringNum parseUnqt+  parseUnqt = liftM stringNum parseUnqt -    parse = liftM stringNum parse-            `adjustErr`-            (++ "\nNot a valid GraphID")+  parse = liftM stringNum parse+          `adjustErr`+          (++ "\nNot a valid GraphID") -stringNum     :: String -> GraphID+stringNum     :: Text -> GraphID stringNum str = maybe checkDbl Int $ stringToInt str   where     checkDbl = if isNumString str                then Dbl $ toDouble str                else Str str --- --------------------------------------------------------------------------------- | 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, Ord, Show, Read)+numericValue           :: GraphID -> Maybe Int+numericValue (Str str) = either (const Nothing) (Just . round . fst)+                         $ T.signed T.double str+numericValue (Int n)   = Just n+numericValue (Dbl x)   = Just $ round x  -- ----------------------------------------------------------------------------- --- Re-exported by Data.GraphViz.Types and Data.GraphViz.Types.Generalised+-- Re-exported by Data.GraphViz.Types.*  -- | Represents a list of top-level list of 'Attribute's for the --   entire graph/sub-graph.  Note that 'GraphAttrs' also applies to@@ -81,38 +82,46 @@ data GlobalAttributes = GraphAttrs { attrs :: Attributes }                       | NodeAttrs  { attrs :: Attributes }                       | EdgeAttrs  { attrs :: Attributes }-                        deriving (Eq, Ord, Show, Read)+                      deriving (Eq, Ord, Show, Read)  instance PrintDot GlobalAttributes where-    -- Can't use printAttrBased because an empty list still must be printed.-    unqtDot ga = printGlobAttrType ga <+> toDot (attrs ga) <> semi+  unqtDot = printAttrBased True printGlobAttrType attrs -    unqtListToDot = printAttrBasedList printGlobAttrType attrs+  unqtListToDot = printAttrBasedList True printGlobAttrType attrs -    listToDot = unqtListToDot+  listToDot = unqtListToDot +-- GraphAttrs, NodeAttrs and EdgeAttrs respectively+partitionGlobal :: [GlobalAttributes] -> (Attributes, Attributes, Attributes)+partitionGlobal = foldr select ([], [], [])+  where+    select globA ~(gs,ns,es) = case globA of+                                 GraphAttrs as -> (as ++ gs, ns, es)+                                 NodeAttrs  as -> (gs, as ++ ns, es)+                                 EdgeAttrs  as -> (gs, ns, as ++ es)+ printGlobAttrType              :: GlobalAttributes -> DotCode printGlobAttrType GraphAttrs{} = text "graph" printGlobAttrType NodeAttrs{}  = text "node" printGlobAttrType EdgeAttrs{}  = text "edge"  instance ParseDot GlobalAttributes where-    -- Not using parseAttrBased here because we want to force usage of-    -- Attributes.-    parseUnqt = do gat <- parseGlobAttrType-                   as <- whitespace' >> parse-                   return $ gat as-                `onFail`-                liftM determineType parse+  -- Not using parseAttrBased here because we want to force usage of+  -- Attributes.+  parseUnqt = do gat <- parseGlobAttrType+                 as <- whitespace' >> parse+                 return $ gat as+              `onFail`+              liftM determineType parse -    parse = parseUnqt -- Don't want the option of quoting-            `adjustErr`-            (++ "\n\nNot a valid listing of global attributes")+  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 = parseStatements parse+  -- Have to do this manually because of the special case+  parseUnqtList = parseStatements parse -    parseList = parseUnqtList+  parseList = parseUnqtList  parseGlobAttrType :: Parse (Attributes -> GlobalAttributes) parseGlobAttrType = oneOf [ stringRep GraphAttrs "graph"@@ -122,65 +131,53 @@  determineType :: Attribute -> GlobalAttributes determineType attr-    | usedByGraphs attr   = GraphAttrs attr'-    | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case-    | usedByNodes attr    = NodeAttrs attr'-    | otherwise           = EdgeAttrs attr' -- Must be for edges.-    where-      attr' = [attr]--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+  | usedByGraphs attr   = GraphAttrs attr'+  | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case+  | usedByNodes attr    = NodeAttrs attr'+  | otherwise           = EdgeAttrs attr' -- Must be for edges.+  where+    attr' = [attr]  -- -----------------------------------------------------------------------------  -- | A node in 'DotGraph'.-data DotNode a = DotNode { nodeID :: a+data DotNode n = DotNode { nodeID :: n                          , nodeAttributes :: Attributes                          }-                 deriving (Eq, Ord, Show, Read)+               deriving (Eq, Ord, Show, Read) -instance (PrintDot a) => PrintDot (DotNode a) where-    unqtDot = printAttrBased printNodeID nodeAttributes+instance (PrintDot n) => PrintDot (DotNode n) where+  unqtDot = printAttrBased False printNodeID nodeAttributes -    unqtListToDot = printAttrBasedList printNodeID nodeAttributes+  unqtListToDot = printAttrBasedList False printNodeID nodeAttributes -    listToDot = unqtListToDot+  listToDot = unqtListToDot -printNodeID :: (PrintDot a) => DotNode a -> DotCode+printNodeID :: (PrintDot n) => DotNode n -> DotCode printNodeID = toDot . nodeID -instance (ParseDot a) => ParseDot (DotNode a) where-    parseUnqt = parseAttrBased parseNodeID+instance (ParseDot n) => ParseDot (DotNode n) where+  parseUnqt = parseAttrBased parseNodeID -    parse = parseUnqt -- Don't want the option of quoting+  parse = parseUnqt -- Don't want the option of quoting -    parseUnqtList = parseAttrBasedList parseNodeID+  parseUnqtList = parseAttrBasedList parseNodeID -    parseList = parseUnqtList+  parseList = parseUnqtList -parseNodeID :: (ParseDot a) => Parse (Attributes -> DotNode a)+parseNodeID :: (ParseDot n) => Parse (Attributes -> DotNode n) parseNodeID = liftM DotNode parseAndCheck   where-    parseAndCheck = do a <- parse+    parseAndCheck = do n <- parse                        me <- optional parseUnwanted-                       maybe (return a) (const notANode) me+                       maybe (return n) (const notANode) me     notANode = fail "This appears to be an edge, not a node"     parseUnwanted = oneOf [ parseEdgeType >> return ()                           , character ':' >> return () -- PortPos value                           ]  instance Functor DotNode where-    fmap f n = n { nodeID = f $ nodeID n }--invalidNode   :: DotNode a -> [DotError a]-invalidNode n = map (NodeError (Just $ nodeID n))-                $ filter (not . usedByNodes) (nodeAttributes n)+  fmap f n = n { nodeID = f $ nodeID n }  -- ----------------------------------------------------------------------------- @@ -189,48 +186,49 @@ -- c"-style edge statements).  -- | An edge in 'DotGraph'.-data DotEdge a = DotEdge { edgeFromNodeID :: a-                         , edgeToNodeID   :: a-                         , directedEdge   :: Bool+data DotEdge n = DotEdge { fromNode       :: n+                         , toNode         :: n                          , edgeAttributes :: Attributes                          }-             deriving (Eq, Ord, Show, Read)+               deriving (Eq, Ord, Show, Read) -instance (PrintDot a) => PrintDot (DotEdge a) where-    unqtDot = printAttrBased printEdgeID edgeAttributes+instance (PrintDot n) => PrintDot (DotEdge n) where+  unqtDot = printAttrBased False printEdgeID edgeAttributes -    unqtListToDot = printAttrBasedList printEdgeID edgeAttributes+  unqtListToDot = printAttrBasedList False printEdgeID edgeAttributes -    listToDot = unqtListToDot+  listToDot = unqtListToDot -printEdgeID   :: (PrintDot a) => DotEdge a -> DotCode-printEdgeID e = toDot (edgeFromNodeID e)-                <+> bool undirEdge' dirEdge' (directedEdge e)-                <+> toDot (edgeToNodeID e)+printEdgeID   :: (PrintDot n) => DotEdge n -> DotCode+printEdgeID e = do isDir <- getDirectedness+                   toDot (fromNode e)+                     <+> bool undirEdge' dirEdge' isDir+                     <+> toDot (toNode e)  -instance (ParseDot a) => ParseDot (DotEdge a) where-    parseUnqt = parseAttrBased parseEdgeID+instance (ParseDot n) => ParseDot (DotEdge n) where+  parseUnqt = parseAttrBased parseEdgeID -    parse = parseUnqt -- Don't want the option of quoting+  parse = parseUnqt -- Don't want the option of quoting -    -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.-    parseUnqtList = liftM concat-                    $ parseStatements parseEdgeLine+  -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.+  parseUnqtList = liftM concat+                  $ parseStatements parseEdgeLine -    parseList = parseUnqtList+  parseList = parseUnqtList -parseEdgeID :: (ParseDot a) => Parse (Attributes -> DotEdge a)+parseEdgeID :: (ParseDot n) => Parse (Attributes -> DotEdge n) parseEdgeID = do eFrom <- parseEdgeNode-                 eType <- parseEdgeType+                 -- Parse both edge types just to be more liberal+                 parseEdgeType                  eTo <- parseEdgeNode-                 return $ mkEdge eFrom eType eTo+                 return $ mkEdge eFrom eTo -type EdgeNode a = (a, Maybe PortPos)+type EdgeNode n = (n, Maybe PortPos)  -- | Takes into account edge statements containing something like --   @a -> \{b c\}@.-parseEdgeNodes :: (ParseDot a) => Parse [EdgeNode a]+parseEdgeNodes :: (ParseDot n) => Parse [EdgeNode n] parseEdgeNodes = parseBraced ( wrapWhitespace                                -- Should really use sepBy1, but this will do.                                $ parseStatements parseEdgeNode@@ -238,19 +236,18 @@                  `onFail`                  liftM return parseEdgeNode -parseEdgeNode :: (ParseDot a) => Parse (EdgeNode a)+parseEdgeNode :: (ParseDot n) => Parse (EdgeNode n) parseEdgeNode = liftM2 (,) parse                            (optional $ character ':' >> parseEdgeBasedPP) -mkEdge :: EdgeNode a -> Bool -> EdgeNode a-          -> Attributes -> DotEdge a-mkEdge (eFrom, mFP) eDir (eTo, mTP) = DotEdge eFrom eTo eDir-                                      . addPortPos TailPort mFP-                                      . addPortPos HeadPort mTP+mkEdge :: EdgeNode n -> EdgeNode n -> Attributes -> DotEdge n+mkEdge (eFrom, mFP) (eTo, mTP) = DotEdge eFrom eTo+                                 . addPortPos TailPort mFP+                                 . addPortPos HeadPort mTP -mkEdges :: [EdgeNode a] -> Bool -> [EdgeNode a]-           -> Attributes -> [DotEdge a]-mkEdges fs eDir ts as = liftM2 (\f t -> mkEdge f eDir t as) fs ts+mkEdges :: [EdgeNode n] -> [EdgeNode n]+           -> Attributes -> [DotEdge n]+mkEdges fs ts as = liftM2 (\f t -> mkEdge f t as) fs ts  addPortPos   :: (PortPos -> Attribute) -> Maybe PortPos                 -> Attributes -> Attributes@@ -261,40 +258,31 @@                                  `onFail`                                  stringRep False undirEdge -parseEdgeLine :: (ParseDot a) => Parse [DotEdge a]+parseEdgeLine :: (ParseDot n) => Parse [DotEdge n] parseEdgeLine = do n1 <- parseEdgeNodes-                   ens <- many1 $ do eType <- parseEdgeType-                                     n <- parseEdgeNodes-                                     return (eType, n)-                   let ens' = (True, n1) : ens-                       efs = zipWith mkEdg ens' (tail ens')+                   ens <- many1 $ do parseEdgeType+                                     parseEdgeNodes+                   let ens' = n1 : ens+                       efs = zipWith mkEdges ens' (tail ens')                        ef = return $ \ as -> concatMap ($as) efs                    parseAttrBased ef-    where-      mkEdg (_, hn) (et, tn) = mkEdges hn et tn  instance Functor DotEdge where-    fmap f e = e { edgeFromNodeID = f $ edgeFromNodeID e-                 , edgeToNodeID   = f $ edgeToNodeID e-                 }+  fmap f e = e { fromNode = f $ fromNode e+               , toNode   = f $ toNode e+               }  dirEdge :: String dirEdge = "->"  dirEdge' :: DotCode-dirEdge' = text dirEdge+dirEdge' = text $ T.pack dirEdge  undirEdge :: String undirEdge = "--"  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)+undirEdge' = text $ T.pack undirEdge  -- ----------------------------------------------------------------------------- -- Labels@@ -303,40 +291,43 @@ dirGraph = "digraph"  dirGraph' :: DotCode-dirGraph' = text dirGraph+dirGraph' = text $ T.pack dirGraph  undirGraph :: String undirGraph = "graph"  undirGraph' :: DotCode-undirGraph' = text undirGraph+undirGraph' = text $ T.pack undirGraph  strGraph :: String strGraph = "strict"  strGraph' :: DotCode-strGraph' = text strGraph+strGraph' = text $ T.pack strGraph  sGraph :: String sGraph = "subgraph"  sGraph' :: DotCode-sGraph' = text sGraph+sGraph' = text $ T.pack sGraph  clust :: String clust = "cluster"  clust' :: DotCode-clust' = text clust+clust' = text $ T.pack clust  -- -----------------------------------------------------------------------------  printGraphID                 :: (a -> Bool) -> (a -> Bool)                                 -> (a -> Maybe GraphID)                                 -> a -> DotCode-printGraphID str isDir mID g = bool empty strGraph' (str g)-                               <+> bool undirGraph' dirGraph' (isDir g)-                               <+> maybe empty toDot (mID g)+printGraphID str isDir mID g = do setDirectedness isDir'+                                  bool empty strGraph' (str g)+                                    <+> bool undirGraph' dirGraph' isDir'+                                    <+> maybe empty toDot (mID g)+  where+    isDir' = isDir g  parseGraphID   :: (Bool -> Bool -> Maybe GraphID -> a) -> Parse a parseGraphID f = do allWhitespace'@@ -346,16 +337,20 @@                                            `onFail`                                            stringRep False undirGraph                                          )+                    setDirectedness dir                     gID <- optional $ parseAndSpace parse                     return $ f str dir gID  printStmtBased          :: (a -> DotCode) -> (a -> b) -> (b -> DotCode)                            -> a -> DotCode-printStmtBased f r dr a = printBracesBased (f a) (dr $ r a)+printStmtBased f r dr a = do gs <- getsGS id+                             dc <- printBracesBased (f a) (dr $ r a)+                             modifyGS (const gs)+                             return dc  printStmtBasedList        :: (a -> DotCode) -> (a -> b) -> (b -> DotCode)                              -> [a] -> DotCode-printStmtBasedList f r dr = vcat . map (printStmtBased f r dr)+printStmtBasedList f r dr = vcat . mapM (printStmtBased f r dr)  parseStmtBased :: Parse stmt -> Parse (stmt -> a) -> Parse a parseStmtBased = flip apply . parseBracesBased@@ -364,19 +359,22 @@ -- brace lined up with the h value, which due to indentation might not -- be the case with braces. printBracesBased     :: DotCode -> DotCode -> DotCode-printBracesBased h i = vcat [ h <+> lbrace-                            , ind i-                            , rbrace-                            ]+printBracesBased h i = vcat $ sequence [ h <+> lbrace+                                       , ind i+                                       , rbrace+                                       ]   where-    ind = nest 4+    ind = indent 4 +-- | This /must/ only be used for sub-graphs, etc. parseBracesBased   :: Parse a -> Parse a-parseBracesBased p = whitespace' >> parseBraced (wrapWhitespace p)+parseBracesBased p = do gs <- getsGS id+                        a <- whitespace' >> parseBraced (wrapWhitespace p)+                        modifyGS (const gs)+                        return a                      `adjustErr`                      (++ "\nNot a valid value wrapped in braces.") - printSubGraphID     :: (a -> (Bool, Maybe GraphID)) -> a -> DotCode printSubGraphID f a = sGraph'                       <+> maybe cl dtID mID@@ -391,7 +389,7 @@   where     noClust = toDot sID     -- Have to manually render it as we need the un-quoted form.-    addClust = toDot . (++) clust . (:) '_'+    addClust = toDot . T.append (T.pack clust) . T.cons '_'                . renderDot $ mkDot sID     mkDot (Str str) = text str -- Quotes will be escaped later     mkDot gid       = unqtDot gid@@ -426,7 +424,7 @@      -- For Strings, there are no more quotes to unescape, so consume     -- what you can.-    pID = liftM stringNum (many next)+    pID = liftM stringNum $ manySatisfy (const True)  {- This is a much nicer definition, but unfortunately it doesn't work.    The problem is that Graphviz decides that a subgraph is a cluster@@ -443,17 +441,20 @@                return (isCl, sID) -} -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+-- The Bool indicates whether or not to print empty lists+printAttrBased                :: Bool -> (a -> DotCode) -> (a -> Attributes)+                                 -> a -> DotCode+printAttrBased prEmp ff fas a = dc <> semi+  where+    f = ff a+    dc = case fas a of+           [] | not prEmp -> f+           as -> f <+> toDot as -printAttrBasedList        :: (a -> DotCode) -> (a -> Attributes)-                             -> [a] -> DotCode-printAttrBasedList ff fas = vcat . map (printAttrBased ff fas)+-- The Bool indicates whether or not to print empty lists+printAttrBasedList              :: Bool -> (a -> DotCode) -> (a -> Attributes)+                                   -> [a] -> DotCode+printAttrBasedList prEmp ff fas = vcat . mapM (printAttrBased prEmp ff fas)  parseAttrBased   :: Parse (Attributes -> a) -> Parse a parseAttrBased p = do f <- p@@ -469,7 +470,7 @@ statementEnd :: Parse () statementEnd = parseSplit >> newline'   where-    parseSplit = (whitespace' >> oneOf [ liftM return $ character ';'+    parseSplit = (whitespace' >> oneOf [ character ';' >> return ()                                        , newline                                        ]                  )
Data/GraphViz/Types/Generalised.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE   MultiParamTypeClasses-             , FlexibleInstances-  #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}  {- |    Module      : Data.GraphViz.Types.Generalised.@@ -9,36 +7,61 @@    License     : 3-Clause BSD-style    Maintainer  : Ivan.Miljenovic@gmail.com -   This module provides an alternate definition of the types found in-   "Data.GraphViz.Types", in that the ordering constraint found in-   'DotStatements' is no longer present.  All other-   limitations\/constraints are still present however.+   The generalised Dot representation most closely matches the+   implementation of actual Dot code, as it places no restrictions on+   ordering of elements, etc.  As such it should be able to parse any+   existing Dot code (taking into account the parsing+   limitations/assumptions). -   The types here have the same names as those in-   "Data.GraphViz.Types" but with a prefix of @\"G\"@.+   The sample graph could be implemented (this is actually a prettied+   version of parsing in the Dot code) as: -   This module is partially experimental, and may change in the-   future.--}+   > DotGraph { strictGraph = False+   >          , directedGraph = True+   >          , graphID = Just (Str "G")+   >          , graphStatements = Seq.fromList [ SG $ DotSG { isCluster = True+   >                                                        , subGraphID = Just (Int 0)+   >                                                        , subGraphStmts = Seq.fromList [ GA $ GraphAttrs [style filled]+   >                                                                                       , GA $ GraphAttrs [color LightGray]+   >                                                                                       , GA $ NodeAttrs [style filled, color White]+   >                                                                                       , DE $ DotEdge "a0" "a1" []+   >                                                                                       , DE $ DotEdge "a1" "a2" []+   >                                                                                       , DE $ DotEdge "a2" "a3" []+   >                                                                                       , GA $ GraphAttrs [textLabel "process #1"]]}+   >                                           , SG $ DotSG { isCluster = True+   >                                                        , subGraphID = Just (Int 1)+   >                                                        , subGraphStmts = fromList [ GA $ NodeAttrs [style filled]+   >                                                                                   , DE $ DotEdge "b0" "b1" []+   >                                                                                   , DE $ DotEdge "b1" "b2" []+   >                                                                                   , DE $ DotEdge "b2" "b3" []+   >                                                                                   , GA $ GraphAttrs [textLabel "process #2"]+   >                                                                                   , GA $ GraphAttrs [color Blue]]}+   >                                           , DE $ DotEdge "start" "a0" []+   >                                           , DE $ DotEdge "start" "b0" []+   >                                           , DE $ DotEdge "a1" "b3" []+   >                                           , DE $ DotEdge "b2" "a3" []+   >                                           , DE $ DotEdge "a3" "a0" []+   >                                           , DE $ DotEdge "a3" "end" []+   >                                           , DE $ DotEdge "b3" "end" []+   >                                           , DN $ DotNode "start" [shape MDiamond]+   >                                           , DN $ DotNode "end" [shape MSquare]]}++ -} module Data.GraphViz.Types.Generalised-       ( -- * The overall representation of a graph in generalised /Dot/ format.-         GDotGraph(..)-         -- * Sub-components of a @GDotGraph@.-       , GDotStatements-       , GDotStatement(..)-       , GDotSubGraph(..)-         -- ** Re-exported from @Data.GraphViz.Types@.+       ( DotGraph(..)+         -- * Sub-components of a @DotGraph@.+       , DotStatements+       , DotStatement(..)+       , DotSubGraph(..)+         -- * Re-exported from @Data.GraphViz.Types@.        , GraphID(..)        , GlobalAttributes(..)        , DotNode(..)        , DotEdge(..)-         -- * Conversion from a @DotGraph@.-       , generaliseDotGraph        ) where -import Data.GraphViz.Types hiding ( GraphID(..)-                                  , GlobalAttributes(..)-                                  , DotEdge(..))+import Data.GraphViz.Types+import qualified Data.GraphViz.Types.Canonical as C import Data.GraphViz.Types.Common import Data.GraphViz.Types.State import Data.GraphViz.Parsing@@ -48,109 +71,125 @@ import qualified Data.Sequence as Seq import Data.Sequence(Seq, (><)) import qualified Data.Foldable as F+import qualified Data.Traversable as T import Control.Arrow((&&&)) import Control.Monad(liftM)+import Control.Monad.Trans.State(get, put, modify, execState, evalState)  -- -----------------------------------------------------------------------------  -- | The internal representation of a generalised graph in Dot form.-data GDotGraph a = GDotGraph { gStrictGraph     :: Bool  -- ^ If 'True', no multiple edges are drawn.-                             , gDirectedGraph   :: Bool-                             , gGraphID         :: Maybe GraphID-                             , gGraphStatements :: GDotStatements a-                             }-                 deriving (Eq, Ord, Show, Read)+data DotGraph n = DotGraph { -- | If 'True', no multiple edges are drawn.+                             strictGraph     :: Bool+                           , directedGraph   :: Bool+                           , graphID         :: Maybe GraphID+                           , graphStatements :: DotStatements n+                           }+                deriving (Eq, Ord, Show, Read) -instance (Ord n, PrintDot n, ParseDot n) => DotRepr GDotGraph n where-  getID = gGraphID+instance (Ord n) => DotRepr DotGraph n where+  fromCanonical = generaliseDotGraph -  graphIsDirected = gDirectedGraph+  getID = graphID -  graphIsStrict = gStrictGraph+  setID i g = g { graphID = Just i } -  makeStrict g = g { gStrictGraph = True }+  graphIsDirected = directedGraph -  setID i g = g { gGraphID = Just i }+  setIsDirected d g = g { directedGraph = d } +  graphIsStrict = strictGraph++  setStrictness s g = g { strictGraph = s }++  mapDotGraph = fmap+   graphStructureInformation = getGraphInfo-                              . statementStructure . gGraphStatements+                              . statementStructure . graphStatements    nodeInformation wGlobal = getNodeLookup wGlobal-                            . statementNodes . gGraphStatements+                            . statementNodes . graphStatements    edgeInformation wGlobal = getDotEdges wGlobal-                            . statementEdges . gGraphStatements+                            . statementEdges . graphStatements -instance (PrintDot a) => PrintDot (GDotGraph a) where-  unqtDot = printStmtBased printGraphID' gGraphStatements printGStmts+  unAnonymise = renumber++instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n+instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n+instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n++instance (PrintDot n) => PrintDot (DotGraph n) where+  unqtDot = printStmtBased printGraphID' graphStatements printGStmts     where-      printGraphID' = printGraphID gStrictGraph gDirectedGraph gGraphID+      printGraphID' = printGraphID strictGraph directedGraph graphID -instance (ParseDot a) => ParseDot (GDotGraph a) where-    parseUnqt = parseStmtBased parseGStmts (parseGraphID GDotGraph)+instance (ParseDot n) => ParseDot (DotGraph n) where+  parseUnqt = parseStmtBased parseGStmts (parseGraphID DotGraph) -    parse = parseUnqt -- Don't want the option of quoting-            `adjustErr`-            (++ "\n\nNot a valid DotGraph")+  parse = parseUnqt -- Don't want the option of quoting+          `adjustErr`+          (++ "\n\nNot a valid DotGraph") -instance Functor GDotGraph where-    fmap f g = g { gGraphStatements = (fmap . fmap) f $ gGraphStatements g }+-- | Assumed to be an injective mapping function.+instance Functor DotGraph where+  fmap f g = g { graphStatements = (fmap . fmap) f $ graphStatements g } --- | Convert a 'DotGraph' to a 'GDotGraph', keeping the same order of+-- | Convert a 'DotGraph' to a 'DotGraph', keeping the same order of --   statements.-generaliseDotGraph    :: DotGraph a -> GDotGraph a-generaliseDotGraph dg = GDotGraph { gStrictGraph = strictGraph dg-                                  , gDirectedGraph = directedGraph dg-                                  , gGraphID = graphID dg-                                  , gGraphStatements = generaliseStatements-                                                       $ graphStatements dg-                                  }+generaliseDotGraph    :: C.DotGraph n -> DotGraph n+generaliseDotGraph dg = DotGraph { strictGraph     = C.strictGraph dg+                                 , directedGraph   = C.directedGraph dg+                                 , graphID         = C.graphID dg+                                 , graphStatements = generaliseStatements+                                                     $ C.graphStatements dg+                                 }  -- ----------------------------------------------------------------------------- -type GDotStatements a = Seq (GDotStatement a)+type DotStatements n = Seq (DotStatement n) -printGStmts :: (PrintDot a) => GDotStatements a -> DotCode+printGStmts :: (PrintDot n) => DotStatements n -> DotCode printGStmts = toDot . F.toList -parseGStmts :: (ParseDot a) => Parse (GDotStatements a)+parseGStmts :: (ParseDot n) => Parse (DotStatements n) parseGStmts = liftM Seq.fromList parse -statementStructure :: GDotStatements a -> GraphState ()+statementStructure :: DotStatements n -> GraphState () statementStructure = F.mapM_ stmtStructure -statementNodes :: (Ord a) => GDotStatements a -> NodeState a ()+statementNodes :: (Ord n) => DotStatements n -> NodeState n () statementNodes = F.mapM_ stmtNodes -statementEdges :: GDotStatements a -> EdgeState a ()+statementEdges :: DotStatements n -> EdgeState n () statementEdges = F.mapM_ stmtEdges -generaliseStatements       :: DotStatements a -> GDotStatements a+generaliseStatements       :: C.DotStatements n -> DotStatements n generaliseStatements stmts = atts >< sgs >< ns >< es   where-    atts = Seq.fromList . map GA $ attrStmts stmts-    sgs = Seq.fromList . map (SG . generaliseSubGraph) $ subGraphs stmts-    ns = Seq.fromList . map DN $ nodeStmts stmts-    es = Seq.fromList . map DE $ edgeStmts stmts+    atts = Seq.fromList . map GA $ C.attrStmts stmts+    sgs  = Seq.fromList . map (SG . generaliseSubGraph) $ C.subGraphs stmts+    ns   = Seq.fromList . map DN $ C.nodeStmts stmts+    es   = Seq.fromList . map DE $ C.edgeStmts stmts  -data GDotStatement a = GA GlobalAttributes-                     | SG (GDotSubGraph a)-                     | DN (DotNode a)-                     | DE (DotEdge a)-                     deriving (Eq, Ord, Show, Read)+data DotStatement n = GA GlobalAttributes+                    | SG (DotSubGraph n)+                    | DN (DotNode n)+                    | DE (DotEdge n)+                    deriving (Eq, Ord, Show, Read) -instance (PrintDot a) => PrintDot (GDotStatement a) where+instance (PrintDot n) => PrintDot (DotStatement n) where   unqtDot (GA ga) = unqtDot ga   unqtDot (SG sg) = unqtDot sg   unqtDot (DN dn) = unqtDot dn   unqtDot (DE de) = unqtDot de -  unqtListToDot = vcat . map unqtDot+  unqtListToDot = vcat . mapM unqtDot    listToDot = unqtListToDot -instance (ParseDot a) => ParseDot (GDotStatement a) where+instance (ParseDot n) => ParseDot (DotStatement n) where   parseUnqt = oneOf [ liftM GA parseUnqt                     , liftM SG parseUnqt                     , liftM DN parseUnqt@@ -172,24 +211,24 @@    parseList = parseUnqtList -instance Functor GDotStatement where+instance Functor DotStatement where   fmap _ (GA ga) = GA ga -- Have to re-make this to make the type checker happy.   fmap f (SG sg) = SG $ fmap f sg   fmap f (DN dn) = DN $ fmap f dn   fmap f (DE de) = DE $ fmap f de -stmtStructure         :: GDotStatement n -> GraphState ()+stmtStructure         :: DotStatement n -> GraphState () stmtStructure (GA ga) = addGraphGlobals ga stmtStructure (SG sg) = withSubGraphID addSubGraph statementStructure sg stmtStructure _       = return () -stmtNodes         :: (Ord a) => GDotStatement a -> NodeState a ()+stmtNodes         :: (Ord n) => DotStatement n -> NodeState n () stmtNodes (GA ga) = addNodeGlobals ga stmtNodes (SG sg) = withSubGraphID recursiveCall statementNodes sg stmtNodes (DN dn) = addNode dn stmtNodes (DE de) = addEdgeNodes de -stmtEdges         :: GDotStatement a -> EdgeState a ()+stmtEdges         :: DotStatement n -> EdgeState n () stmtEdges (GA ga) = addEdgeGlobals ga stmtEdges (SG sg) = withSubGraphID recursiveCall statementEdges sg stmtEdges (DE de) = addEdge de@@ -197,27 +236,27 @@  -- ----------------------------------------------------------------------------- -data GDotSubGraph a = GDotSG { gIsCluster     :: Bool-                             , gSubGraphID    :: Maybe GraphID-                             , gSubGraphStmts :: GDotStatements a-                             }-                    deriving (Eq, Ord, Show, Read)+data DotSubGraph n = DotSG { isCluster     :: Bool+                           , subGraphID    :: Maybe GraphID+                           , subGraphStmts :: DotStatements n+                           }+                   deriving (Eq, Ord, Show, Read) -instance (PrintDot a) => PrintDot (GDotSubGraph a) where-  unqtDot = printStmtBased printSubGraphID' gSubGraphStmts printGStmts+instance (PrintDot n) => PrintDot (DotSubGraph n) where+  unqtDot = printStmtBased printSubGraphID' subGraphStmts printGStmts -  unqtListToDot = printStmtBasedList printSubGraphID' gSubGraphStmts printGStmts+  unqtListToDot = printStmtBasedList printSubGraphID' subGraphStmts printGStmts    listToDot = unqtListToDot -printSubGraphID' :: GDotSubGraph a -> DotCode-printSubGraphID' = printSubGraphID (gIsCluster &&& gSubGraphID)+printSubGraphID' :: DotSubGraph n -> DotCode+printSubGraphID' = printSubGraphID (isCluster &&& subGraphID) -instance (ParseDot a) => ParseDot (GDotSubGraph a) where-  parseUnqt = parseStmtBased parseGStmts (parseSubGraphID GDotSG)+instance (ParseDot n) => ParseDot (DotSubGraph n) where+  parseUnqt = parseStmtBased parseGStmts (parseSubGraphID DotSG)               `onFail`-              -- Take anonymous GDotSubGraphs into account-              liftM (GDotSG False Nothing) (parseBracesBased parseGStmts)+              -- Take anonymous DotSubGraphs into account+              liftM (DotSG False Nothing) (parseBracesBased parseGStmts)    parse = parseUnqt -- Don't want the option of quoting           `adjustErr`@@ -227,19 +266,52 @@    parseList = parseUnqtList -instance Functor GDotSubGraph where-    fmap f sg = sg { gSubGraphStmts = (fmap . fmap) f $ gSubGraphStmts sg }+instance Functor DotSubGraph where+  fmap f sg = sg { subGraphStmts = (fmap . fmap) f $ subGraphStmts sg } -generaliseSubGraph                       :: DotSubGraph a -> GDotSubGraph a-generaliseSubGraph (DotSG isC mID stmts) = GDotSG { gIsCluster     = isC-                                                  , gSubGraphID    = mID-                                                  , gSubGraphStmts = stmts'-                                                  }+generaliseSubGraph :: C.DotSubGraph n -> DotSubGraph n+generaliseSubGraph (C.DotSG isC mID stmts) = DotSG { isCluster     = isC+                                                   , subGraphID    = mID+                                                   , subGraphStmts = stmts'+                                                   }   where     stmts' = generaliseStatements stmts  withSubGraphID        :: (Maybe (Maybe GraphID) -> b -> a)-                         -> (GDotStatements n -> b) -> GDotSubGraph n -> a-withSubGraphID f g sg = f mid . g $ gSubGraphStmts sg+                         -> (DotStatements n -> b) -> DotSubGraph n -> a+withSubGraphID f g sg = f mid . g $ subGraphStmts sg   where-    mid = bool Nothing (Just $ gSubGraphID sg) $ gIsCluster sg+    mid = bool Nothing (Just $ subGraphID sg) $ isCluster sg++renumber    :: DotGraph n -> DotGraph n+renumber dg = dg { graphStatements = newStmts }+  where+    startN = succ $ maxSGInt dg++    newStmts = evalState (stsRe $ graphStatements dg) startN++    stsRe = T.mapM stRe+    stRe (SG sg) = liftM SG $ sgRe sg+    stRe stmt    = return stmt+    sgRe sg = do sgid' <- case subGraphID sg of+                            Nothing -> do n <- get+                                          put $ succ n+                                          return . Just $ Int n+                            sgid    -> return sgid+                 stmts' <- stsRe $ subGraphStmts sg+                 return $ sg { subGraphID    = sgid'+                             , subGraphStmts = stmts'+                             }++maxSGInt    :: DotGraph n -> Int+maxSGInt dg = execState (stsInt $ graphStatements dg)+              . flip check 0+              $ graphID dg+  where+    check = maybe id max . (numericValue =<<)++    stsInt = F.mapM_ stInt+    stInt (SG sg) = sgInt sg+    stInt _       = return ()+    sgInt sg = do modify (check $ subGraphID sg)+                  stsInt $ subGraphStmts sg
+ Data/GraphViz/Types/Graph.hs view
@@ -0,0 +1,774 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++{- |+   Module      : Data.GraphViz.Types.Graph+   Description : A graph-like representation of Dot graphs.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   It is sometimes useful to be able to manipulate a Dot graph /as/ an+   actual graph.  This representation lets you do so, using an+   inductive approach based upon that from FGL (note that 'DotGraph'+   is /not/ an instance of the FGL classes due to having the wrong+   kind).  Note, however, that the API is not as complete as proper+   graph implementations.++   For purposes of manipulation, all edges are found in the root graph+   and not in a cluster; as such, having 'EdgeAttrs' in a cluster's+   'GlobalAttributes' is redundant.++   Printing is achieved via "Data.GraphViz.Types.Canonical" (using+   'toCanonical') and parsing via "Data.GraphViz.Types.Generalised"+   (so /any/ piece of Dot code can be parsed in).++   This representation doesn't allow non-cluster sub-graphs.  Also, all+   clusters /must/ have a unique identifier.  For those functions (with+   the exception of 'DotRepr' methods) that take or return a \"@Maybe+   GraphID@\", a value of \"@Nothing@\" refers to the root graph; \"@Just+   clust@\" refers to the cluster with the identifier \"@clust@\".++   You would not typically explicitly create these values, instead+   converting existing Dot graphs (via 'fromDotRepr').  However, one+   way of constructing the sample graph would be:++setID (Str "G")+. setStrictness False+. setIsDirected True+. setClusterAttributes (Int 0) [GraphAttrs [style filled, color LightGray, textLabel "process #1"], NodeAttrs [style filled, color White]]+. setClusterAttributes (Int 1) [ GraphAttrs [textLabel "process #2", color Blue], NodeAttrs [style filled]]+$ composeList [ Cntxt "a0"    (Just $ Int 0)   []               [("a3",[]),("start",[])] [("a1",[])]+              , Cntxt "a1"    (Just $ Int 0)   []               []                       [("a2",[]),("b3",[])]+              , Cntxt "a2"    (Just $ Int 0)   []               []                       [("a3",[])]+              , Cntxt "a3"    (Just $ Int 0)   []               [("b2",[])]              [("end",[])]+              , Cntxt "b0"    (Just $ Int 1)   []               [("start",[])]           [("b1",[])]+              , Cntxt "b1"    (Just $ Int 1)   []               []                       [("b2",[])]+              , Cntxt "b2"    (Just $ Int 1)   []               []                       [("b3",[])]+              , Cntxt "b3"    (Just $ Int 1)   []               []                       [("end",[])]+              , Cntxt "end"   Nothing          [shape MSquare]  []                       []+              , Cntxt "start" Nothing          [shape MDiamond] []                       []]++ -}+module Data.GraphViz.Types.Graph+       ( DotGraph+       , GraphID(..)+       , Context(..)+         -- * Conversions+       , toCanonical+       , unsafeFromCanonical+       , fromDotRepr+         -- * Graph information+       , isEmpty+       , hasClusters+       , isEmptyGraph+       , graphAttributes+       , parentOf+       , clusterAttributes+       , foundInCluster+       , attributesOf+       , predecessorsOf+       , successorsOf+       , adjacentTo+       , adjacent+         -- * Graph construction+       , mkGraph+       , emptyGraph+       , (&)+       , composeList+       , addNode+       , DotNode(..)+       , addDotNode+       , addEdge+       , DotEdge(..)+       , addDotEdge+       , addCluster+       , setClusterParent+       , setClusterAttributes+         -- * Graph deconstruction+       , decompose+       , decomposeAny+       , decomposeList+       , deleteNode+       , deleteAllEdges+       , deleteEdge+       , deleteDotEdge+       , deleteCluster+       , removeEmptyClusters+       ) where++import Data.GraphViz.Types+import qualified Data.GraphViz.Types.Canonical as C+import qualified Data.GraphViz.Types.Generalised as G+import Data.GraphViz.Types.Common(partitionGlobal)+import qualified Data.GraphViz.Types.State as St+import Data.GraphViz.Attributes.Same+import Data.GraphViz.Attributes.Complete(Attributes)+import Data.GraphViz.Util(groupSortBy, groupSortCollectBy)+import Data.GraphViz.Algorithms(CanonicaliseOptions(..), canonicaliseOptions)+import Data.GraphViz.Algorithms.Clustering+import Data.GraphViz.Printing(PrintDot(..))+import Data.GraphViz.Parsing(ParseDot(..))++import Data.List(foldl', delete, unfoldr)+import qualified Data.Foldable as F+import Data.Maybe(mapMaybe, fromMaybe)+import qualified Data.Map as M+import Data.Map(Map)+import qualified Data.Set as S+import qualified Data.Sequence as Seq+import Control.Arrow((***))+import Control.Monad(liftM, liftM2)+import Text.Read(Lexeme(Ident), lexP, parens, readPrec)+import Text.ParserCombinators.ReadPrec(prec)++-- -----------------------------------------------------------------------------++-- | A Dot graph that allows graph operations on it.+data DotGraph n = DG { strictGraph   :: !Bool+                     , directedGraph :: !Bool+                     , graphAttrs    :: !GlobAttrs+                     , graphID       :: !(Maybe GraphID)+                     , clusters      :: !(Map GraphID ClusterInfo)+                     , values        :: !(NodeMap n)+                     }+                deriving (Eq, Ord)++-- | It should be safe to substitute 'unsafeFromCanonical' for+--   'fromCanonical' in the output of this.+instance (Ord n, Show n) => Show (DotGraph n) where+  showsPrec d dg = showParen (d > 10) $+                   showString "fromCanonical " . shows (toCanonical dg)++-- | If the graph is the output from 'show', then it should be safe to+--   substitute 'unsafeFromCanonical' for 'fromCanonical'.+instance (Ord n, Read n) => Read (DotGraph n) where+  readPrec = parens . prec 10+             $ do Ident "fromCanonical" <- lexP+                  cdg <- readPrec+                  return $ fromCanonical cdg++data GlobAttrs = GA { graphAs :: !SAttrs+                    , nodeAs  :: !SAttrs+                    , edgeAs  :: !SAttrs+                    }+               deriving (Eq, Ord, Show, Read)++data NodeInfo n = NI { _inCluster    :: !(Maybe GraphID)+                     , _attributes   :: !Attributes+                     , _predecessors :: !(EdgeMap n)+                     , _successors   :: !(EdgeMap n)+                     }+                deriving (Eq, Ord, Show, Read)++data ClusterInfo = CI { parentCluster :: !(Maybe GraphID)+                      , clusterAttrs  :: !GlobAttrs+                      }+                 deriving (Eq, Ord, Show, Read)++type NodeMap n = Map n (NodeInfo n)++type EdgeMap n = Map n [Attributes]++-- | The decomposition of a node from a dot graph.  Any loops should+--   be found in 'successors' rather than 'predecessors'.  Note also+--   that these are created/consumed as if for /directed/ graphs.+data Context n = Cntxt { node         :: !n+                         -- | The cluster this node can be found in;+                         --   @Nothing@ indicates the node can be+                         --   found in the root graph.+                       , inCluster    :: !(Maybe GraphID)+                       , attributes   :: !Attributes+                       , predecessors :: ![(n, Attributes)]+                       , successors   :: ![(n, Attributes)]+                       }+               deriving (Eq, Ord, Show, Read)++adjacent :: Context n -> [DotEdge n]+adjacent c = mapU (flip DotEdge n) (predecessors c)+             ++ mapU (DotEdge n) (successors c)+  where+    n = node c+    mapU = map . uncurry++emptyGraph :: DotGraph n+emptyGraph = DG { strictGraph   = False+                , directedGraph = True+                , graphID       = Nothing+                , graphAttrs    = emptyGA+                , clusters      = M.empty+                , values        = M.empty+                }++emptyGA :: GlobAttrs+emptyGA = GA S.empty S.empty S.empty++-- -----------------------------------------------------------------------------+-- Construction++-- | Merge the 'Context' into the graph.  Assumes that the specified+--   node is not in the graph but that all endpoints in the+--   'successors' and 'predecessors' (with the exception of loops)+--   are.  If the cluster is not present in the graph, then it will be+--   added with no attributes with a parent of the root graph.+--+--   Note that @&@ and @'decompose'@ are /not/ quite inverses, as this+--   function will add in the cluster if it does not yet exist in the+--   graph, but 'decompose' will not delete it.+(&) :: (Ord n) => Context n -> DotGraph n -> DotGraph n+(Cntxt n mc as ps ss) & dg = withValues merge dg'+  where+    ps' = toMap ps+    ps'' = M.delete n ps'+    ss' = toMap ss+    ss'' = M.delete n ss'++    dg' = addNode n mc as dg++    merge = addSucc n ps'' . addPred n ss''+            . M.adjust (\ni -> ni { _predecessors = ps', _successors = ss' }) n++infixr 5 &++-- | Recursively merge the list of contexts.+--+--   > composeList = foldr (&) emptyGraph+composeList :: (Ord n) => [Context n] -> DotGraph n+composeList = foldr (&) emptyGraph++addSucc :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n+addSucc = addPS niSucc++addPred :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n+addPred = addPS niPred++addPS :: (Ord n) => ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)+         -> n -> EdgeMap n -> NodeMap n -> NodeMap n+addPS fni t fas nm = t `seq` foldl' addSucc' nm fas'+  where+    fas' = fromMap fas++    addSucc' nm' (f,as) = f `seq` M.alter (addS as) f nm'++    addS as = Just+              . maybe (error "Node not in the graph!")+                      (fni (M.insertWith (++) t [as]))++-- | Add a node to the current graph.  Throws an error if the node+--   already exists in the graph.+--+--   If the specified cluster does not yet exist in the graph, then it+--   will be added (as a sub-graph of the overall graph and no+--   attributes).+addNode :: (Ord n)+           => n+           -> Maybe GraphID -- ^ The cluster the node can be found in+                            --   (@Nothing@ refers to the root graph).+           -> Attributes+           -> DotGraph n+           -> DotGraph n+addNode n mc as dg+  | n `M.member` ns = error "Node already exists in the graph"+  | otherwise       = addEmptyCluster mc+                      $ dg { values   = ns' }+  where+    ns = values dg+    ns' = M.insert n (NI mc as M.empty M.empty) ns++-- | A variant of 'addNode' that takes in a DotNode (not in a+--   cluster).+addDotNode                :: (Ord n) => DotNode n -> DotGraph n -> DotGraph n+addDotNode (DotNode n as) = addNode n Nothing as++-- | Add the specified edge to the graph; assumes both node values are+--   already present in the graph.  If the graph is undirected then+--   the order of nodes doesn't matter.+addEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n+addEdge f t as = withValues merge+  where+    -- Add the edge assuming it's directed; let the getter functions+    -- be smart regarding directedness.+    merge = addPred t (M.singleton f [as]) . addSucc f (M.singleton t [as])++-- | A variant of 'addEdge' that takes a 'DotEdge' value.+addDotEdge                  :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n+addDotEdge (DotEdge f t as) = addEdge f t as++-- | Add a new cluster to the graph; throws an error if the cluster+--   already exists.  Assumes that it doesn't match the identifier of+--   the overall graph.  If the parent cluster doesn't already exist+--   in the graph then it will be added.+addCluster :: GraphID          -- ^ The identifier for this cluster.+              -> Maybe GraphID -- ^ The parent of this cluster+                               --   (@Nothing@ refers to the root+                               --   graph)+              -> [GlobalAttributes]+              -> DotGraph n+              -> DotGraph n+addCluster c mp gas dg+  | c `M.member` cs = error "Cluster already exists in the graph"+  | otherwise       = addEmptyCluster mp+                      $ dg { clusters = M.insert c ci cs }+  where+    cs = clusters dg+    ci = CI mp $ toGlobAttrs gas++-- Used to make sure that the parent cluster exists+addEmptyCluster :: Maybe GraphID -> DotGraph n -> DotGraph n+addEmptyCluster = maybe id (withClusters . flip dontReplace defCI)+  where+    dontReplace = M.insertWith (const id)+    defCI = CI Nothing emptyGA++-- | Specify the parent of the cluster; adds both in if not already present.+setClusterParent     :: GraphID -> Maybe GraphID -> DotGraph n -> DotGraph n+setClusterParent c p = withClusters (M.adjust setP c) . addCs+  where+    addCs = addEmptyCluster p . addEmptyCluster (Just c)+    setP ci = ci { parentCluster = p }++-- | Specify the attributes of the cluster; adds it if not already+--   present.+setClusterAttributes       :: GraphID -> [GlobalAttributes]+                              -> DotGraph n -> DotGraph n+setClusterAttributes c gas = withClusters (M.adjust setAs c)+                             . addEmptyCluster (Just c)+  where+    setAs ci = ci { clusterAttrs = toGlobAttrs gas }++-- | Create a graph with no clusters.+mkGraph :: (Ord n) => [DotNode n] -> [DotEdge n] -> DotGraph n+mkGraph ns es = flip (foldl' (flip addDotEdge)) es+                $ foldl' (flip addDotNode) emptyGraph ns++-- | Convert this DotGraph into canonical form.  All edges are found+--   in the outer graph rather than in clusters.+toCanonical :: (Ord n) => DotGraph n -> C.DotGraph n+toCanonical dg = C.DotGraph { C.strictGraph     = strictGraph dg+                            , C.directedGraph   = directedGraph dg+                            , C.graphID         = graphID dg+                            , C.graphStatements = stmts+                            }+  where+    stmts = C.DotStmts { C.attrStmts = fromGlobAttrs $ graphAttrs dg+                       , C.subGraphs = cs+                       , C.nodeStmts = ns+                       , C.edgeStmts = getEdgeInfo False dg+                       }++    cls = clusters dg+    pM = clusterPath' dg++    clustAs = maybe [] (fromGlobAttrs . clusterAttrs) . (`M.lookup`cls)++    lns = map (\ (n,ni) -> (n,(_inCluster ni, _attributes ni)))+          . M.assocs $ values dg++    (cs,ns) = clustersToNodes pathOf id clustAs snd lns++    pathOf (n,(c,as)) = pathFrom c (n,as)+    pathFrom c ln = F.foldr C (N ln) . fromMaybe Seq.empty $ (`M.lookup`pM) =<< c++-- -----------------------------------------------------------------------------+-- Deconstruction++-- | A partial inverse of @'&'@, in that if a node exists in a graph+--   then it will be decomposed, but will not remove the cluster that+--   it was in even if it was the only node in that cluster.+decompose :: (Ord n) => n -> DotGraph n -> Maybe (Context n, DotGraph n)+decompose n dg+  | n `M.notMember` ns = Nothing+  | otherwise          = Just (c, dg')+  where+    ns = values dg+    (Just (NI mc as ps ss), ns') = M.updateLookupWithKey (const . const Nothing) n ns++    c = Cntxt n mc as (fromMap $ n `M.delete` ps) (fromMap ss)+    dg' = dg { values = delSucc n ps . delPred n ss $ ns' }++-- | As with 'decompose', but do not specify /which/ node to+--   decompose.+decomposeAny :: (Ord n) => DotGraph n -> Maybe (Context n, DotGraph n)+decomposeAny dg+  | isEmpty dg = Nothing+  | otherwise  = decompose (fst . M.findMin $ values dg) dg++-- | Recursively decompose the Dot graph into a list of contexts such+--   that if @(c:cs) = decomposeList dg@, then @dg = c & 'composeList' cs@.+--+--   Note that all global attributes are lost, so this is /not/+--   suitable for representing a Dot graph on its own.+decomposeList :: (Ord n) => DotGraph n -> [Context n]+decomposeList = unfoldr decomposeAny++delSucc :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n+delSucc = delPS niSucc++delPred :: (Ord n) => n -> EdgeMap n -> NodeMap n -> NodeMap n+delPred = delPS niPred++-- Only takes in EdgeMap rather than [n] to make it easier to call+-- from decompose+delPS :: (Ord n) => ((EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n)+         -> n -> EdgeMap n -> NodeMap n -> NodeMap n+delPS fni t fm nm = foldl' delE nm $ M.keys fm+  where+    delE nm' f = M.adjust (fni $ M.delete t) f nm'++-- | Delete the specified node from the graph; returns the original+--   graph if that node isn't present.+deleteNode      :: (Ord n) => n -> DotGraph n -> DotGraph n+deleteNode n dg = maybe dg snd $ decompose n dg++-- | Delete all edges between the two nodes; returns the original+--   graph if there are no edges.+deleteAllEdges          :: (Ord n) => n -> n -> DotGraph n -> DotGraph n+deleteAllEdges n1 n2 = withValues (delAE n1 n2 . delAE n2 n1)+  where+    delAE f t = delSucc f t' . delPred f t'+      where+        t' = M.singleton t []++-- | Deletes the specified edge from the DotGraph (note: for unordered+--   graphs both orientations are considered).+deleteEdge :: (Ord n) => n -> n -> Attributes -> DotGraph n -> DotGraph n+deleteEdge n1 n2 as dg = withValues delEs dg+  where+    delE f t = M.adjust (niSucc $ M.adjust (delete as) t) f+               . M.adjust (niPred $ M.adjust (delete as) f) t++    delEs | directedGraph dg = delE n1 n2+          | otherwise        = delE n1 n2 . delE n2 n1++-- | As with 'deleteEdge' but takes a 'DotEdge' rather than individual+--   values.+deleteDotEdge :: (Ord n) => DotEdge n -> DotGraph n -> DotGraph n+deleteDotEdge (DotEdge n1 n2 as) = deleteEdge n1 n2 as++-- | Delete the specified cluster, and makes any clusters or nodes+--   within it be in its root cluster (or the overall graph if+--   required).+deleteCluster      :: (Ord n) => GraphID -> DotGraph n -> DotGraph n+deleteCluster c dg = withValues (M.map adjNode)+                     . withClusters (M.map adjCluster . M.delete c)+                     $ dg+  where+    p = parentCluster =<< c `M.lookup` clusters dg++    adjParent p'+      | p' == Just c = p+      | otherwise    = p'++    adjNode ni = ni { _inCluster = adjParent $ _inCluster ni }++    adjCluster ci = ci { parentCluster = adjParent $ parentCluster ci }++-- | Remove clusters with no sub-clusters and no nodes within them.+removeEmptyClusters :: (Ord n) => DotGraph n -> DotGraph n+removeEmptyClusters dg = dg { clusters = cM' }+  where+    cM = clusters dg+    cM' = (cM `M.difference` invCs) `M.difference` invNs++    invCs = usedClustsIn $ M.map parentCluster cM+    invNs = usedClustsIn . M.map _inCluster $ values dg++    usedClustsIn = M.fromAscList+                   . map (liftM2 (,) (fst . head) (map snd))+                   . groupSortBy fst+                   . mapMaybe (uncurry (fmap . flip (,)))+                   . M.assocs++-- -----------------------------------------------------------------------------+-- Information++-- | Does this graph have any nodes?+isEmpty :: DotGraph n -> Bool+isEmpty = M.null . values++-- | Does this graph have any clusters?+hasClusters :: DotGraph n -> Bool+hasClusters = M.null . clusters++-- | Determine if this graph has nodes or clusters.+isEmptyGraph :: DotGraph n -> Bool+isEmptyGraph = liftM2 (&&) isEmpty (not . hasClusters)++graphAttributes :: DotGraph n -> [GlobalAttributes]+graphAttributes = fromGlobAttrs . graphAttrs++-- | Return the ID for the cluster the node is in.+foundInCluster :: (Ord n) => DotGraph n -> n -> Maybe GraphID+foundInCluster dg n = _inCluster $ values dg M.! n++-- | Return the attributes for the node.+attributesOf :: (Ord n) => DotGraph n -> n -> Attributes+attributesOf dg n = _attributes $ values dg M.! n++-- | Predecessor edges for the specified node.  For undirected graphs+--   equivalent to 'adjacentTo'.+predecessorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n]+predecessorsOf dg t+  | directedGraph dg = emToDE (flip DotEdge t)+                       . _predecessors $ values dg M.! t+  | otherwise        = adjacentTo dg t++-- | Successor edges for the specified node.  For undirected graphs+--   equivalent to 'adjacentTo'.+successorsOf :: (Ord n) => DotGraph n -> n -> [DotEdge n]+successorsOf dg f+  | directedGraph dg = emToDE (DotEdge f)+                       . _successors $ values dg M.! f+  | otherwise        = adjacentTo dg f++-- | All edges involving this node.+adjacentTo :: (Ord n) => DotGraph n -> n -> [DotEdge n]+adjacentTo dg n = sucs ++ preds+  where+    ni = values dg M.! n+    sucs = emToDE (DotEdge n) $ _successors ni+    preds = emToDE (flip DotEdge n) $ n `M.delete` _predecessors ni++emToDE :: (Ord n) => (n -> Attributes -> DotEdge n)+          -> EdgeMap n -> [DotEdge n]+emToDE f = map (uncurry f) . fromMap++-- | Which cluster (or the root graph) is this cluster in?+parentOf :: DotGraph n -> GraphID -> Maybe GraphID+parentOf dg c = parentCluster $ clusters dg M.! c++clusterAttributes :: DotGraph n -> GraphID -> [GlobalAttributes]+clusterAttributes dg c = fromGlobAttrs . clusterAttrs $ clusters dg M.! c++-- -----------------------------------------------------------------------------+-- For DotRepr instance++instance (Ord n) => DotRepr DotGraph n where+  fromCanonical = fromDotRepr++  getID = graphID++  setID i g = g { graphID = Just i }++  graphIsDirected = directedGraph++  setIsDirected d g = g { directedGraph = d }++  graphIsStrict = strictGraph++  setStrictness s g = g { strictGraph = s }++  mapDotGraph = mapNs++  graphStructureInformation = getGraphInfo++  nodeInformation = getNodeInfo++  edgeInformation = getEdgeInfo++  unAnonymise = id -- No anonymous clusters!++instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n+instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n+instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n++-- | Uses the PrintDot instance for canonical 'C.DotGraph's.+instance (Ord n, PrintDot n) => PrintDot (DotGraph n) where+  unqtDot = unqtDot . toCanonical++-- | Uses the ParseDot instance for generalised 'G.DotGraph's.+instance (Ord n, ParseDot n) => ParseDot (DotGraph n) where+  parseUnqt = liftM fromGDot $ parseUnqt+    where+      -- fromGDot :: G.DotGraph n -> DotGraph n+      fromGDot = fromDotRepr . flip asTypeOf (undefined :: G.DotGraph n)++cOptions :: CanonicaliseOptions+cOptions = COpts { edgesInClusters = False+                 , groupAttributes = True+                 }++-- | Convert any existing DotRepr instance to a 'DotGraph'.+fromDotRepr :: (DotRepr dg n) => dg n -> DotGraph n+fromDotRepr = unsafeFromCanonical . canonicaliseOptions cOptions . unAnonymise++-- | Convert a canonical Dot graph to a graph-based one.  This assumes+--   that the canonical graph is the same format as returned by+--   'toCanonical'.  The \"unsafeness\" is that all nodes are assumed+--   to be explicitly listed precisely once, and that only edges found+--   in the root graph are considered.  If this isn't the case, use+--   'fromCanonical' instead.+--+--   The 'graphToDot' function from "Data.GraphViz" produces output+--   suitable for this function.+unsafeFromCanonical :: (Ord n) => C.DotGraph n -> DotGraph n+unsafeFromCanonical dg = DG { strictGraph   = C.strictGraph dg+                            , directedGraph = dirGraph+                            , graphAttrs    = as+                            , graphID       = mgid+                            , clusters      = cs+                            , values        = ns+                            }+  where+    stmts = C.graphStatements dg+    mgid = C.graphID dg+    dirGraph = C.directedGraph dg++    (as, cs, ns) = fCStmt Nothing stmts++    fCStmt p stmts' = (sgAs, cs', ns')+      where+        sgAs = toGlobAttrs $ C.attrStmts stmts'+        (cs', sgNs) = (M.unions *** M.unions) . unzip+                      . map (fCSG p) $ C.subGraphs stmts'+        nNs = M.fromList . map (fDN p) $ C.nodeStmts stmts'+        ns' = sgNs `M.union` nNs++    fCSG p sg = (M.insert sgid ci cs', ns')+      where+        msgid@(Just sgid) = C.subGraphID sg+        (as', cs', ns') = fCStmt msgid $ C.subGraphStmts sg+        ci = CI p as'++    fDN p (DotNode n as') = ( n+                            , NI { _inCluster    = p+                                 , _attributes   = as'+                                 , _predecessors = eSel n tEs+                                 , _successors   = eSel n fEs+                                 }+                            )++    es = C.edgeStmts stmts+    fEs = toEdgeMap fromNode toNode es+    tEs = delLoops $ toEdgeMap toNode fromNode es+    eSel n es' = fromMaybe M.empty $ n `M.lookup` es'+    delLoops = M.mapWithKey M.delete++toEdgeMap     :: (Ord n) => (DotEdge n -> n) -> (DotEdge n -> n) -> [DotEdge n]+                 -> Map n (EdgeMap n)+toEdgeMap f t = M.map eM . M.fromList . groupSortCollectBy f t'+  where+    t' = liftM2 (,) t edgeAttributes+    eM = M.fromList . groupSortCollectBy fst snd++mapNs :: (Ord n, Ord n') => (n -> n') -> DotGraph n -> DotGraph n'+mapNs f (DG st d as mid cs vs) = DG st d as mid cs+                                 $ mapNM vs+  where+    mapNM = M.map mapNI . mpM+    mapNI (NI mc as' ps ss) = NI mc as' (mpM ps) (mpM ss)+    mpM = M.mapKeys f++getGraphInfo    :: DotGraph n -> (GlobalAttributes, ClusterLookup)+getGraphInfo dg = (gas, cl)+  where+    toGA = GraphAttrs . unSame+    (gas, cgs) = (toGA *** M.map toGA) $ globAttrMap graphAs dg+    pM = M.map pInit $ clusterPath dg++    cl = M.mapWithKey addPath $ M.mapKeysMonotonic Just cgs++    addPath c as = ( maybe [] (:[]) $ c `M.lookup` pM+                   , as+                   )++    pInit p = case Seq.viewr p of+                (p' Seq.:> _) -> p'+                _             -> Seq.empty++getNodeInfo             :: (Ord n) => Bool -> DotGraph n+                           -> NodeLookup n+getNodeInfo withGlob dg = M.map toLookup ns+  where+    (gGlob, aM) = globAttrMap nodeAs dg+    pM = clusterPath dg++    ns = values dg++    toLookup ni = (pth, as')+      where+        as = _attributes ni+        mp = _inCluster ni+        pth = fromMaybe Seq.empty $ mp `M.lookup` pM+        pAs = fromMaybe gGlob $ flip M.lookup aM =<< mp+        as' | withGlob  = unSame $ toSAttr as `S.union` pAs+            | otherwise = as++getEdgeInfo             :: (Ord n) => Bool -> DotGraph n -> [DotEdge n]+getEdgeInfo withGlob dg = concatMap (uncurry mkDotEdges) es+  where+    gGlob = edgeAs $ graphAttrs dg++    es = concatMap (uncurry (map . (,)))+         . M.assocs . M.map (M.assocs . _successors)+         $ values dg++    addGlob as+      | withGlob  = unSame $ toSAttr as `S.union` gGlob+      | otherwise = as++    mkDotEdges f (t, ass) = map (DotEdge f t . addGlob) ass++globAttrMap       :: (GlobAttrs -> SAttrs) -> DotGraph n+                     -> (SAttrs, Map GraphID SAttrs)+globAttrMap af dg = (gGlob, aM)+  where+    gGlob = af $ graphAttrs dg++    cs = clusters dg++    aM = M.map attrsFor cs++    attrsFor ci = as `S.union` pAs+      where+        as = af $ clusterAttrs ci+        p = parentCluster ci+        pAs = fromMaybe gGlob $ flip M.lookup aM =<< p++clusterPath :: DotGraph n -> Map (Maybe GraphID) St.Path+clusterPath = M.mapKeysMonotonic Just . M.map (fmap Just) . clusterPath'++clusterPath' :: DotGraph n -> Map GraphID (Seq.Seq GraphID)+clusterPath' dg = pM+  where+    cs = clusters dg++    pM = M.mapWithKey pathOf cs++    pathOf c ci = pPth Seq.|> c+      where+        mp = parentCluster ci+        pPth = fromMaybe Seq.empty $ flip M.lookup pM =<< mp++-- -----------------------------------------------------------------------------++withValues      :: (Ord n) => (NodeMap n -> NodeMap n)+                   -> DotGraph n -> DotGraph n+withValues f dg = dg { values = f $ values dg }++withClusters      :: (Map GraphID ClusterInfo -> Map GraphID ClusterInfo)+                     -> DotGraph n -> DotGraph n+withClusters f dg = dg { clusters = f $ clusters dg }++toGlobAttrs :: [GlobalAttributes] -> GlobAttrs+toGlobAttrs = mkGA . partitionGlobal+  where+    mkGA (ga,na,ea) = GA (toSAttr ga) (toSAttr na) (toSAttr ea)++fromGlobAttrs :: GlobAttrs -> [GlobalAttributes]+fromGlobAttrs (GA ga na ea) = filter (not . null . attrs)+                              [ GraphAttrs $ unSame ga+                              , NodeAttrs  $ unSame na+                              , EdgeAttrs  $ unSame ea+                              ]++niSucc      :: (Ord n) => (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n+niSucc f ni = ni { _successors = f $ _successors ni }++niPred      :: (Ord n) => (EdgeMap n -> EdgeMap n) -> NodeInfo n -> NodeInfo n+niPred f ni = ni { _predecessors = f $ _predecessors ni }++toMap :: (Ord n) => [(n, Attributes)] -> EdgeMap n+toMap = M.fromAscList . groupSortCollectBy fst snd++fromMap :: EdgeMap n -> [(n, Attributes)]+fromMap = concatMap (uncurry (map . (,))) . M.toList
+ Data/GraphViz/Types/Monadic.hs view
@@ -0,0 +1,220 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++{- |+   Module      : Data.GraphViz.Types.Monadic+   Description : A monadic interface for making Dot graphs.+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module is based upon the /dotgen/ library by Andy Gill:+   <http://hackage.haskell.org/package/dotgen>++   It provides a monadic interface for constructing generalised Dot+   graphs.  Note that this does /not/ have an instance for @DotRepr@+   (e.g. what would be the point of the @fromCanonical@ function, as+   you can't do anything with the result): it is purely for+   construction purposes.  Use the generalised Dot graph instance for+   printing, etc.++   Note that the generalised Dot graph types are /not/ re-exported, in+   case it causes a clash with other modules you may choose to import.++   The example graph in "Data.GraphViz.Types" can be written as:++   > digraph (Str "G") $ do+   >+   >    cluster (Int 0) $ do+   >        graphAttrs [style filled, color LightGray]+   >        nodeAttrs [style filled, color White]+   >        "a0" --> "a1"+   >        "a1" --> "a2"+   >        "a2" --> "a3"+   >        graphAttrs [textLabel "process #1"]+   >+   >    cluster (Int 1) $ do+   >        nodeAttrs [style filled]+   >        "b0" --> "b1"+   >        "b1" --> "b2"+   >        "b2" --> "b3"+   >        graphAttrs [textLabel "process #2", color Blue]+   >+   >    "start" --> "a0"+   >    "start" --> "b0"+   >    "a1" --> "b3"+   >    "b2" --> "a3"+   >    "a3" --> "end"+   >    "b3" --> "end"+   >+   >    node "start" [shape MDiamond]+   >    node "end" [shape MSquare]++ -}+module Data.GraphViz.Types.Monadic+       ( Dot+       , DotM+       , GraphID(..)+         -- * Creating a generalised DotGraph.+       , digraph+       , digraph'+       , graph+       , graph'+         -- * Adding global attributes.+       , graphAttrs+       , nodeAttrs+       , edgeAttrs+         -- * Adding items to the graph.+         -- ** Clusters+       , cluster+         -- ** Nodes+       , node+       , node'+         -- ** Edges+       , edge+       , (-->)+       , (<->)+       ) where++import Data.GraphViz.Attributes(Attributes)+import Data.GraphViz.Types.Common+import Data.GraphViz.Types.Generalised++import qualified Data.DList as DL+import Data.DList(DList)+import qualified Data.Sequence as Seq++-- -----------------------------------------------------------------------------+-- The Dot monad.++-- | The monadic representation of a Dot graph.+type Dot n = DotM n ()++-- | The actual monad; as with 'Dot' but allows you to return a value+--   within the do-block.  The actual implementation is based upon the+--   Writer monad.+newtype DotM n a = DotM { runDot :: (a, DotStmts n) }++execDot :: DotM n a -> DotStmts n+execDot = snd . runDot++instance Monad (DotM n) where+  return a = DotM (a, DL.empty)++  dt >>= f = DotM+             $ let ~(a,stmts)  = runDot dt+                   ~(b,stmts') = runDot $ f a+               in (b, stmts `DL.append` stmts')++tell :: DotStmts n -> Dot n+tell = DotM . (,) ()++tellStmt :: DotStmt n -> Dot n+tellStmt = tell . DL.singleton++-- -----------------------------------------------------------------------------+-- Creating the DotGraph++-- | Create a directed dot graph with the specified graph ID.+digraph :: GraphID -> DotM n a -> DotGraph n+digraph = mkGraph True . Just++-- | Create a directed dot graph with no graph ID.+digraph' :: DotM n a -> DotGraph n+digraph' = mkGraph True Nothing++-- | Create a undirected dot graph with the specified graph ID.+graph :: GraphID -> DotM n a -> DotGraph n+graph = mkGraph False . Just++-- | Create a undirected dot graph with no graph ID.+graph' :: DotM n a -> DotGraph n+graph' = mkGraph False Nothing++mkGraph :: Bool -> Maybe GraphID -> DotM n a -> DotGraph n+mkGraph isDir mid dot = DotGraph { strictGraph     = False+                                 , directedGraph   = isDir+                                 , graphID         = mid+                                 , graphStatements = execStmts dot+                                 }++-- -----------------------------------------------------------------------------+-- Statements++type DotStmts n = DList (DotStmt n)++execStmts :: DotM n a -> DotStatements n+execStmts = convertStatements . execDot++convertStatements :: DotStmts n -> DotStatements n+convertStatements = Seq.fromList . map convertStatement . DL.toList++data DotStmt n = MA GlobalAttributes+               | MC (Cluster n)+               | MN (DotNode n)+               | ME (DotEdge n)++convertStatement          :: DotStmt n -> DotStatement n+convertStatement (MA gas) = GA gas+convertStatement (MC cl)  = SG . DotSG True (Just $ clID cl)+                                 . execStmts $ clStmts cl+convertStatement (MN dn)  = DN dn+convertStatement (ME de)  = DE de++-- -----------------------------------------------------------------------------+-- Global Attributes++-- | Add graph/sub-graph/cluster attributes.+graphAttrs :: Attributes -> Dot n+graphAttrs = tellStmt . MA . GraphAttrs++-- | Add global node attributes.+nodeAttrs :: Attributes -> Dot n+nodeAttrs = tellStmt . MA . NodeAttrs++-- | Add global edge attributes+edgeAttrs :: Attributes -> Dot n+edgeAttrs = tellStmt . MA . EdgeAttrs++-- -----------------------------------------------------------------------------+-- Clusters++data Cluster n = Cl { clID    :: GraphID+                    , clStmts :: Dot n+                    }++-- | Add a named cluster to the graph.+cluster     :: GraphID -> DotM n a -> Dot n+cluster cid = tellStmt . MC . Cl cid . (>> return ())++-- -----------------------------------------------------------------------------+-- Nodes++-- | Add a node to the graph.+node   :: n -> Attributes -> Dot n+node n = tellStmt . MN . DotNode n++-- | Add a node with no attributes to the graph.+node' :: n -> Dot n+node' = flip node []++-- -----------------------------------------------------------------------------+-- Edges++-- | Add an edge to the graph.+edge     :: n -> n -> Attributes -> Dot n+edge f t = tellStmt . ME . DotEdge f t++-- | Add an edge with no attributes.+(-->) :: n -> n -> Dot n+f --> t = edge f t []++infixr 9 -->++-- | An alias for '-->' to make edges look more undirected.+(<->) :: n -> n -> Dot n+(<->) = (-->)++infixr 9 <->++-- -----------------------------------------------------------------------------+
Data/GraphViz/Types/State.hs view
@@ -35,13 +35,16 @@        ) where  import Data.GraphViz.Types.Common-import Data.GraphViz.Attributes(Attributes, Attribute, sameAttribute)+import Data.GraphViz.Attributes.Complete( Attributes+                                        , usedByClusters, usedByGraphs)+import Data.GraphViz.Attributes.Same  import Data.Function(on)+import qualified Data.DList as DList+import Data.DList(DList) import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Set as Set-import Data.Set(Set) import qualified Data.Sequence as Seq import Data.Sequence(Seq, (|>), ViewL(..)) import Control.Arrow((&&&), (***))@@ -99,31 +102,8 @@                         modifyGlobal (const gas)                         modifyPath (const p) --- --------------------------------------------------------------------------------- | Defined as a wrapper around 'Attribute' where equality is based---   solely upon the constructor, not the contents.-newtype SameAttr = SA { getAttr :: Attribute }-                 deriving (Show, Read)--instance Eq SameAttr where-  (==) = sameAttribute `on` getAttr--instance Ord SameAttr where-  compare sa1 sa2-    | sa1 == sa2 = EQ-    | otherwise  = (compare `on` getAttr) sa1 sa2--type SAttrs = Set SameAttr--toSAttr :: Attributes -> SAttrs-toSAttr = Set.fromList . map SA- unionWith        :: SAttrs -> Attributes -> SAttrs-unionWith sas as = Set.fromList (map SA as) `Set.union` sas--unSame :: SAttrs -> Attributes-unSame = map getAttr . Set.toList+unionWith sas as = toSAttr as `Set.union` sas  -- ----------------------------------------------------------------------------- -- Dealing with sub-graphs@@ -140,23 +120,24 @@ type ClusterInfo = (DList Path, SAttrs)  getGraphInfo :: GraphState a -> (GlobalAttributes, ClusterLookup)-getGraphInfo = ((toGlobal . globalAttrs) &&& (convert . value))+getGraphInfo = ((graphGlobal . globalAttrs) &&& (convert . value))                . flip execState initState   where-    convert = Map.map ((uniq . toList) *** toGlobal)-    toGlobal = GraphAttrs . unSame+    convert = Map.map ((uniq . DList.toList) *** toGlobal)+    toGlobal = GraphAttrs . filter usedByClusters . unSame+    graphGlobal = GraphAttrs . filter usedByGraphs . unSame     initState = SV Set.empty True Seq.empty Map.empty     uniq = Set.toList . Set.fromList  mergeCInfos          :: ClusterInfo -> ClusterInfo -> ClusterInfo-mergeCInfos (p1,as1) = append p1 *** Set.union as1+mergeCInfos (p1,as1) = DList.append p1 *** Set.union as1  addCluster                 :: Maybe (Maybe GraphID) -> Path -> SAttrs                               -> GraphState () addCluster Nothing    _ _  = return () addCluster (Just gid) p as = modifyValue $ Map.insertWith mergeCInfos gid ci   where-    ci = (singleton p, as)+    ci = (DList.singleton p, as)  -- Use this instead of recursiveCall addSubGraph           :: Maybe (Maybe GraphID) -> GraphState a -> GraphState ()@@ -236,10 +217,10 @@                             mergeNode n as gas p  addEdgeNodes :: (Ord n) => DotEdge n -> NodeState n ()-addEdgeNodes (DotEdge f t _ _) = do gas <- getGlobals-                                    p <- getPath-                                    addEN f gas p-                                    addEN t gas p+addEdgeNodes (DotEdge f t _) = do gas <- getGlobals+                                  p <- getPath+                                  addEN f gas p+                                  addEN t gas p   where     addEN n = mergeNode n [] @@ -249,9 +230,9 @@ type EdgeState n a = GVState (DList (DotEdge n)) a  getDotEdges       :: Bool -> EdgeState n a -> [DotEdge n]-getDotEdges addGs = toList . value . flip execState initState+getDotEdges addGs = DList.toList . value . flip execState initState   where-    initState = SV Set.empty addGs Seq.empty empty+    initState = SV Set.empty addGs Seq.empty DList.empty  addEdgeGlobals                :: GlobalAttributes -> EdgeState n () addEdgeGlobals (EdgeAttrs as) = addGlobals as@@ -261,23 +242,4 @@ addEdge de@DotEdge{edgeAttributes = as}   = do gas <- getGlobals        let de' = de { edgeAttributes = unSame $ unionWith gas as }-       modifyValue $ snoc de'---- -------------------------------------------------------------------------------type DList a = [a] -> [a]--snoc :: a -> DList a -> DList a-snoc a da = da . (a:)--empty :: DList a-empty = id--toList :: DList a -> [a]-toList = ($[])--append       :: DList a -> DList a -> DList a-append xs ys = xs . ys--singleton :: a -> DList a-singleton = (:)+       modifyValue $ flip DList.snoc de'
Data/GraphViz/Util.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings, PatternGuards #-} {-# OPTIONS_HADDOCK hide #-}  {- |@@ -14,7 +15,6 @@ import Data.Char( isAsciiUpper                 , isAsciiLower                 , isDigit-                , toLower                 , ord                 ) @@ -23,13 +23,16 @@ import Data.Function(on) import qualified Data.Set as Set import Data.Set(Set)+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Read as T+import Data.Text.Lazy(Text)+import Control.Monad(liftM2)  -- ----------------------------------------------------------------------------- -isIDString        :: String -> Bool-isIDString []     = True-isIDString (f:os) = frstIDString f-                    && all restIDString os+isIDString :: Text -> Bool+isIDString = maybe False (\(f,os) -> frstIDString f && T.all restIDString os)+             . T.uncons  -- | First character of a non-quoted 'String' must match this. frstIDString   :: Char -> Bool@@ -44,54 +47,73 @@ restIDString c = frstIDString c || isDigit c  -- | Determine if this String represents a number.-isNumString     :: String -> Bool+isNumString     :: Text -> Bool isNumString ""  = False isNumString "-" = False-isNumString str = case str of-                    ('-':str') -> go str'-                    _          -> go str-    where-      go s = case span isDigit (map toLower s) of-               (ds@(_:_),[]) -> all isDigit ds-               ([],'.':[])   -> False-               ([],'.':d:ds) -> isDigit d && checkEs' ds-               (_,'.':ds)    -> checkEs $ dropWhile isDigit ds-               ([],_)        -> False-               (_,ds)        -> checkEs ds-      checkEs' s = case break ('e' ==) s of-                     ([], _) -> False-                     (ds,es) -> all isDigit ds && checkEs es-      checkEs []       = True-      checkEs ('e':ds) = isIntString ds-      checkEs _        = False+isNumString str = case T.uncons $ T.toLower str of+                    Just ('-',str') -> go str'+                    _               -> go str+  where+    -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all+    -- possible cases+    go s = uncurry go' $ T.span isDigit s+    go' ds nds+      | T.null nds = True+      | T.null ds && nds == "." = False+      | T.null ds+      , Just ('.',nds') <- T.uncons nds+      , Just (d,nds'') <- T.uncons nds' = isDigit d && checkEs' nds''+      | Just ('.',nds') <- T.uncons nds = checkEs $ T.dropWhile isDigit nds'+      | T.null ds = False+      | otherwise = checkEs nds+    checkEs' s = case T.break ('e' ==) s of+                   ("", _) -> False+                   (ds,es) -> T.all isDigit ds && checkEs es+    checkEs str' = case T.uncons str' of+                     Nothing       -> True+                     Just ('e',ds) -> isIntString ds+                     _             -> False +{- -- | This assumes that 'isNumString' is 'True'.-toDouble     :: String -> Double-toDouble str = case str of-                 ('-':str') -> read $ '-' : adj str'-                 _          -> read $ adj str+toDouble     :: Text -> Double+toDouble str = case T.uncons $ T.toLower str of+                 Just ('-', str') -> toD $ '-' `T.cons` adj str'+                 _                -> toD $ adj str   where-    adj s = (:) '0'-            $ case span ('.' ==) (map toLower s) of-                (ds@(_:_), '.':[])   -> ds ++ '.' : '0' : []-                (ds, '.':es@('e':_)) -> ds ++ '.' : '0' : es-                _                    -> s+    adj s = T.cons '0'+            $ case T.span ('.' ==) s of+                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'+                (ds, ds') | Just ('.',es) <- T.uncons ds'+                          , Just ('e',es') <- T.uncons es+                            -> ds `T.snoc` '.' `T.snoc` '0'+                                   `T.snoc` 'e' `T.snoc` '0' `T.append` es'+                _         -> s+    toD = either (const $ error "Not a Double") fst . T.signed T.double+-}+-- | This assumes that 'isNumString' is 'True'.+toDouble     :: Text -> Double+toDouble str = case T.uncons $ T.toLower str of+                 Just ('-', str') -> toD $ '-' `T.cons` adj str'+                 _                -> toD $ adj str+  where+    adj s = T.cons '0'+            $ case T.span ('.' ==) s of+                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'+                (ds, ds') | Just ('.',es) <- T.uncons ds'+                          , Just ('e',_) <- T.uncons es+                            -> ds `T.snoc` '.' `T.snoc` '0' `T.append` es+                _              -> s+    toD = read . T.unpack -isIntString :: String -> Bool+isIntString :: Text -> Bool isIntString = isJust . stringToInt  -- | Determine if this String represents an integer.-stringToInt     :: String -> Maybe Int-stringToInt str = if isNum-                  then Just (read str)-                  else Nothing-  where-    isNum = case str of-              ""        -> False-              ['-']     -> False-              ('-':num) -> isNum' num-              _         -> isNum' str-    isNum' = all isDigit+stringToInt     :: Text -> Maybe Int+stringToInt str = case T.signed T.decimal str of+                       Right (n, "") -> Just n+                       _             -> Nothing  -- | Graphviz requires double quotes to be explicitly escaped. escapeQuotes           :: String -> String@@ -105,11 +127,11 @@ descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str descapeQuotes (c:str)        = c : descapeQuotes str -isKeyword :: String -> Bool-isKeyword = flip Set.member keywords . map toLower+isKeyword :: Text -> Bool+isKeyword = flip Set.member keywords . T.toLower  -- | The following are Dot keywords and are not valid as labels, etc. unquoted.-keywords :: Set String+keywords :: Set Text keywords = Set.fromList [ "node"                         , "edge"                         , "graph"@@ -128,6 +150,9 @@  groupSortBy   :: (Ord b) => (a -> b) -> [a] -> [[a]] groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)++groupSortCollectBy     :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]+groupSortCollectBy f g = map (liftM2 (,) (f . head) (map g)) . groupSortBy f  -- | Fold over 'Bool's; first param is for 'False', second for 'True'. bool       :: a -> a -> Bool -> a
FAQ view
@@ -33,13 +33,17 @@ another; however _graphviz_ has the most comprehensive support available out of all of them: -* Two different methods of specifying Dot graphs:+* There are [four different representations] of Dot graphs: -    1. Strict, which matches the layout of `dot -Tcanon`.-    2. Liberal, which allows statements to be in any order.+    1. Canonical, which matches the layout of `dot -Tcanon`.+    2. Generalised, which allows statements to be in any order.+    3. A graph-based one that allows manipulation of the Dot graph.+    4. A monadic interface for embedding graphs in Haskell. -  There are also conversion functions between the two of them.+  There are also conversion functions between them. +  [four different representations](#whats-the-difference-between-the-different-dotgraph-types)+ * The ability to parse and generate most aspects of Dot [syntax] and   [attributes].  This includes taking into account escaping and   quoting rules where applicable.@@ -50,19 +54,22 @@ * The ability to use a custom node type for Dot graphs.  * Support for the all five layout algorithm programs and all specified-  [output formats].+  [output formats] as well as the ability to use custom programs, etc.    [output formats]: http://www.graphviz.org/doc/info/output.html -* Functions to convert [FGL] graphs to and from the internal Dot-  representations.  In future, this will be expanded to a much larger-  range of graph-like values once a suitable abstraction is available.+* Functions to convert [FGL] graphs and other graph-like structures+  (albeit not as nicely) to and from the internal Dot representations.+  In future, this will be expanded to a much larger range of+  graph-like values once a suitable abstraction is available.    [FGL]: http://web.engr.oregonstate.edu/~erwig/fgl/haskell/  * The ability to augment Dot and FGL graphs with positioning   information by round-trip passing through Graphviz. +* Pure Haskell implementations of `dot -Tcanon` and `tred`.+ * _graphviz_ is continually being worked upon and expanded to better   suit/match the requirements of Graphviz, to improve performance and   to make it easier for the programmer to use.@@ -78,7 +85,7 @@ [package versioning policy]; this means that you can immediately tell when the API has had a backwards-incompatible change by comparing the first two elements of the version.  However, these changes won't-affect most users.+always affect most users.  [package versioning policy]: http://www.haskell.org/haskellwiki/Package_versioning_policy @@ -94,11 +101,9 @@ * Comments, pre-processor lines and split lines are (currently) not   supported within HTML-like labels. -* _graphviz_ is currently locale-specific: Dot graphs are meant to be-  encoded in UTF-8 by default unless specified to be Latin-1, but this-  isn't verified or checked.  Dot code that is parsed in is assumed to-  be in UTF-8; in future this will be enforced (both for printing and-  parsing purposes).+* _graphviz_ only uses UTF-8 encoding for printing and parsing+  (whereas Graphviz allows Latin1 encoding with the `charset`+  attribute).  * Graphviz is more liberal in accepting "invalid" values   (e.g. accepting a floating-point value when only integer values are@@ -121,12 +126,10 @@  * Only polygon-based `shape`s are available. -* The default `layersep` is used when printing and parsing-  `layerRange` and `layerList` values; this will be fixed in a future-  release (when state-based printing and parsing is implemented).--* The `/ssss/yyyy` and `//yyyy` forms of printing and parsing `color`s-  are not yet available.+* The `charset` attribute is not available as _graphviz_ assumes that+  all Dot graphs will be in UTF-8 for simplicity; if Latin1-encoded+  graphs need to be parsed then you shall need to do all I/O for them+  by hand.  #### Available items of note #### @@ -277,18 +280,37 @@ import pre-defined graphs, or else generate Dot code for use with other tools. -### What's the difference between DotGraph and GDotGraph? ###+### What's the difference between the different DotGraph types? ### -The layout of `DotGraph` matches the output of `dot -Tcanon`.  It has-a fixed layout which makes it easier to reason about and get-sub-components.+_graphviz_ has four different "implementations" of Dot code: -`GDotGraph` on the other hand is more liberal in its layout, allowing-you to put statements in any order you please.  This is useful in-cases where you want to use the common Graphviz "hack" of specifying-global attributes that don't apply to sub-graphs _after_ the-sub-graphs in question.+**Canonical:** +: matches the output of `dot -Tcanon`.  Recommended for use when+  converting existing data into Dot (especially with the+  `graphElemsToDot` function in `Data.GraphViz`).++**Generalised:**++: most closely matches the layout of actual Dot code, as such this is+  preferred when parsing in arbitrary Dot graphs.  Also useful in+  cases where you want to use the common Graphviz "hack" of specifying+  global attributes that don't apply to sub-graphs _after_ the+  sub-graphs in question.++**Graph:**++: provides common graph operations on Dot graphs, based upon those+  found in the [FGL].++**Monadic:**++: a nicer way of defining relatively static Dot graphs to embed within+  Haskell code, etc.  Loosely based (with permission!) upon Andy+  Gill's [dotgen] library.++  [dotgen]: http://hackage.haskell.org/package/dotgen+ ### What's the best way to parse Dot code? ###  In both cases below, you should use the `parseDotGraph` function to@@ -358,10 +380,6 @@  The following attributes are **not** recommended for use: -* `Charset`: the only accepted options are `"UTF-8"` and `"Latin-1"`,-  but in future _graphviz_ will not contain this attribute and will-  only allow UTF-8 usage.- * `Color` for anything except edge colours (and if you must, the   border colour for a node). @@ -492,10 +510,6 @@ * You should specify an ID for the overall graph when outputting to a   format such as SVG as it becomes the title of that image. -* It is possible to specify a graph as being directed/undirected but-  having individual edges being the opposite; care should be taken to-  avoid this (this possible issue may be resolved in future).- * Graphviz allows a node to be "defined" twice with different   attributes; in practice they are combined into one node.  Running   Dot code through `dot -Tcanon` before parsing removes this problem.@@ -530,22 +544,28 @@  [Parsec]: http://hackage.haskell.org/package/parsec -### Why do you have two different representations of Dot graphs? ###+### Why do you have four different representations of Dot graphs? ### -_graphviz_ has-[two different representations](#whats-the-difference-between-dotgraph-and-gdotgraph)-of Dot graphs.  Apart from the reasons given before, `DotGraph` was-the original representation, whereas `GDotGraph` was only introduced-in the 2999.8.0.0 release.+_graphviz_ has [four different representations] of Dot graphs.  Apart+from the reasons given before, the canonical implementation was the+original representation, whereas the generalised one was only+introduced in the 2999.8.0.0 release and the other two in the+2999.12.0.0 release. -Note, however, that I was thinking of adding something like-`GDotGraph` back around the time of the+Note, however, that I was thinking of adding something like the+generalised implementation back around the time of the [2999.0.0.0 release](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064436.html), yet [people didn't like the idea](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064442.html). -As such, `GDotGraph` is there if anyone needs/wants to use it, but-usage of `DotGraph` is recommended/preferred.+The graph-based implementation was added solely so I could write as+(un-yet finished) tutorial, and thought others might find it useful.+The monadic implementation came about as an attempt to encourage more+people to use _graphviz_ rather than other libraries such as [dotgen],+and I thought a nicer way of writing Dot graphs might help (the+initial plans involved complicated type-hackery to try and almost make+it a DSL for actual Dot code; however it ended up being too+complicated and unwieldy).  ### Why are only FGL graphs supported? ###
README view
@@ -36,10 +36,10 @@ * The ability to not only generate but also parse Dot code with two   options: strict and liberal (in terms of ordering of statements). -* Functions to convert [FGL] graphs to Dot code - including support to-  group them into clusters - with a high degree of customisation by-  specifying which attributes to use and limited support for the-  inverse operation.+* Functions to convert [FGL] graphs and other graph-like data+  structures to Dot code - including support to group them into+  clusters - with a high degree of customisation by specifying which+  attributes to use and limited support for the inverse operation.  * Round-trip support for passing an [FGL] graph through Graphviz to   augment node and edge labels with positional information, etc.@@ -50,7 +50,7 @@  \(C\) 2008 [Matthew Sackman](http://www.wellquite.org/) -\(C\) 2008 - 2010 [Ivan Lazar Miljenovic](http://ivanmiljenovic.wordpress.com/)+\(C\) 2008 - onwards [Ivan Lazar Miljenovic](http://ivanmiljenovic.wordpress.com/)  [3-Clause BSD License]: http://www.opensource.org/licenses/bsd-license.php
RunTests.hs view
@@ -14,7 +14,6 @@                             , defaultTests, runChosenTests)  import Data.Char(toLower)-import Data.List(maximum) import Data.Maybe(mapMaybe) import qualified Data.Map as Map import Data.Map(Map)@@ -60,9 +59,6 @@       , "        (where <key> denotes a space-separated list of keys"       , "         from the table below)."       , ""-      , "The entire test suite takes approximately 50 minutes to run on a"-      , "2 GHz Mobile Core 2 Duo (running with a single thread)."-      , ""       , helpTable       ] @@ -73,10 +69,10 @@   where     andLen = ((id &&& length) .)     testNames = map (andLen lookupName &&& andLen name) defaultTests-    fmtName ((ln,lnl),(n,nl)) = concat [ ln-                                       , replicate (maxLN-lnl+spacerLen) ' '-                                       , n-                                       ]+    fmtName ((ln,lnl),(n,_)) = concat [ ln+                                      , replicate (maxLN-lnl+spacerLen) ' '+                                      , n+                                      ]     line = replicate (maxLN + spacerLen + maxN) '-'     maxLN = maximum $ map (snd . fst) testNames     maxN = maximum $ map (snd . snd) testNames
TODO view
@@ -11,31 +11,36 @@ Short term ---------- -* Make the parsers and printers state-based, which means they will be-  better able to cope with `ColorScheme` and layers better.+* Quickstart-style documentation to help users get going with graphviz+  quickly. -* Improve the printer and parser performance (to be done whilst making-  them state-based).+* Add nicer syntax for record labels, and specifying ports in Monadic+  Dot graphs. -* Fix encoding problems: Graphviz uses UTF-8 by default, Latin1 when-  set; to resolve ambiguities force usage of UTF-8 and remove the-  option of Latin-1.  To do so, will probably use the-  [text](http://hackage.haskell.org/package/text) library (which will-  hopefully also improve performance for the previous point).+* Add convenience functions for creating GraphIDs (ala Labellable). -* Quickstart-style documentation to help users get going with graphviz-  quickly.+* Add support for SVG colors. +* Define new classes to distinguish between printing/parsing Attribute+  values and other values (as only the former requires quoted+  variants).++* Clean up AttributeGenerator and get it to use a better+  pretty-printing library.+ Medium term ----------- -* Improve the test suite such that the generated `DotGraph` and-  `GDotGraph` values are valid (and thus can be passed to Graphviz-  proper).  This will require the state-based printer and parser from-  above to be implemented.+* Improve the test suite such that the generated `DotGraph` values are+  valid (and thus can be passed to Graphviz proper).  This may not in+  fact be possible as guaranteeing an arbitrary `Attribute` is valid+  is rather tricky (as the value itself needs to be verified,+  especially stateful ones). -* Add support for non-visualisation Graphviz tools (e.g. dijkstra and-  tred).+* Switch to a proper test-suite library rather than the hand-rolled+  one currently being used.++* Add support for clusters as endpoints of edges.  Long term ---------
graphviz.cabal view
@@ -1,11 +1,11 @@ Name:               graphviz-Version:            2999.11.0.0+Version:            2999.12.0.0 Stability:          Beta-Synopsis:           Graphviz bindings for Haskell.+Synopsis:           Bindings to Graphviz for graph visualisation. Description: { This library provides bindings for the Dot language used by the-Graphviz (<http://graphviz.org/>) suite of programs, as well as-functions to call those programs.+Graphviz (<http://graphviz.org/>) suite of programs for visualising+graphs, as well as functions to call those programs. . Main features of the graphviz library include: .@@ -21,10 +21,10 @@ * The ability to not only generate but also parse Dot code with two   options: strict and liberal (in terms of ordering of statements). .-* Functions to convert FGL graphs to Dot code - including support to-  group them into clusters - with a high degree of customisation by-  specifying which attributes to use and limited support for the-  inverse operation.+* Functions to convert FGL graphs and other graph-like data structures+  to Dot code - including support to group them into clusters - with a+  high degree of customisation by specifying which attributes to use+  and limited support for the inverse operation. . * Round-trip support for passing an FGL graph through Graphviz to   augment node and edge labels with positional information, etc.@@ -61,25 +61,37 @@                            process,                            fgl == 5.4.*,                            filepath,-                           polyparse == 1.4.*,-                           pretty,+                           polyparse == 1.7.*,                            bytestring == 0.9.*,                            colour == 2.3.*,-                           transformers == 0.2.*+                           transformers == 0.2.*,+                           text,+                           wl-pprint-text,+                           dlist == 0.5.*          Exposed-Modules:   Data.GraphViz                            Data.GraphViz.Types+                           Data.GraphViz.Types.Canonical                            Data.GraphViz.Types.Generalised+                           Data.GraphViz.Types.Graph+                           Data.GraphViz.Types.Monadic                            Data.GraphViz.Parsing                            Data.GraphViz.Printing+                           Data.GraphViz.State                            Data.GraphViz.Commands+                           Data.GraphViz.Commands.IO                            Data.GraphViz.Attributes+                           Data.GraphViz.Attributes.Complete                            Data.GraphViz.Attributes.Colors                            Data.GraphViz.Attributes.HTML                            Data.GraphViz.PreProcessing+                           Data.GraphViz.Exception+                           Data.GraphViz.Algorithms -        Other-Modules:     Data.GraphViz.Attributes.Internal-                           Data.GraphViz.Types.Clustering+        Other-Modules:     Data.GraphViz.Algorithms.Clustering+                           Data.GraphViz.Attributes.ColorScheme+                           Data.GraphViz.Attributes.Internal+                           Data.GraphViz.Attributes.Same                            Data.GraphViz.Types.Common                            Data.GraphViz.Types.State                            Data.GraphViz.Util@@ -87,10 +99,15 @@            Build-Depends:       QuickCheck >= 2.3 && < 2.5             Exposed-Modules:     Data.GraphViz.Testing+                                Data.GraphViz.Testing.Instances                                 Data.GraphViz.Testing.Properties -           Other-Modules:       Data.GraphViz.Testing.Instances-                                Data.GraphViz.Testing.Instances.FGL+           Other-Modules:       Data.GraphViz.Testing.Instances.FGL+                                Data.GraphViz.Testing.Instances.Helpers+                                Data.GraphViz.Testing.Instances.Attributes+                                Data.GraphViz.Testing.Instances.Common+                                Data.GraphViz.Testing.Instances.Canonical+                                Data.GraphViz.Testing.Instances.Generalised          if True            Ghc-Options: -Wall@@ -111,10 +128,10 @@         Main-Is:           RunTests.hs          if True-           Ghc-Options: -O2+           Ghc-Options: -O -Wall          if impl(ghc >= 6.12.1)            Ghc-Options: -fno-warn-unused-do-bind -        GHC-Prof-Options: -auto-all -caf-all+        GHC-Prof-Options: -auto-all -caf-all -rtsopts }
utils/AttributeGenerator.hs view
@@ -38,6 +38,7 @@     where       cds = [ createDefn             , createAlias+            , nameAlias             , showInstance             , parseInstance             , usedByFunc "Graphs" forGraphs@@ -46,6 +47,8 @@             , usedByFunc "Nodes" forNodes             , usedByFunc "Edges" forEdges             , sameAttributeFunc+            , defValueFunc+            , validUnknownFunc             ]  genArbitrary :: Atts -> Doc@@ -64,6 +67,7 @@                    , parseNames   :: [Code]                    , valtype      :: VType                    , parseDef     :: Maybe Code+                   , defValue     :: Maybe Code                    , forGraphs    :: Bool                    , forClusters  :: Bool                    , forSubGraphs :: Bool@@ -72,23 +76,25 @@                    , comment      :: Doc                    } -makeAttr                   :: Constructor -> [Name] -> UsedBy -> VType-                              -> Maybe Default -- Used when parsing the field-                              -> Maybe Default -> Maybe Minimum -> Maybe Comment-                              -> Attribute-makeAttr c ns u v df d m cm = A { cnst         = text c-                                , name         = head ns'-                                , parseNames   = ns'-                                , valtype      = v -- just in case need to do fancy-                                                   -- stuff-                                , parseDef     = liftM text df-                                , forGraphs    = isFor 'G'-                                , forClusters  = isFor 'C' || forSG-                                , forSubGraphs = forSG-                                , forNodes     = isFor 'N'-                                , forEdges     = isFor 'E'-                                , comment      = cm'-                                }+makeAttr                      :: Constructor -> [Name] -> UsedBy -> VType+                                 -> Maybe Default -- Used when parsing the field+                                 -> Maybe Default -- Used as a default value if necessary+                                 -> Maybe Default -> Maybe Minimum -> Maybe Comment+                                 -> Attribute+makeAttr c ns u v df d fd m cm = A { cnst         = text c+                                   , name         = head ns'+                                   , parseNames   = ns'+                                   , valtype      = v -- just in case need to do fancy+                                                      -- stuff+                                   , parseDef     = liftM text df+                                   , defValue     = liftM text d+                                   , forGraphs    = isFor 'G'+                                   , forClusters  = isFor 'C' || forSG+                                   , forSubGraphs = forSG+                                   , forNodes     = isFor 'N'+                                   , forEdges     = isFor 'E'+                                   , comment      = cm'+                                   }     where       ns' = map text ns       isFor f = f `elem` u@@ -100,7 +106,7 @@             . punctuate semi             . map mDoc             $ catMaybes [ addF "Valid for" (Just u)-                        , addF "Default" d+                        , addF "Default" fd                         , addF "Parsing Default" df'                         , addF "Minimum" m                         , addF "Notes" cm@@ -124,7 +130,7 @@ vtype           :: VType -> Doc vtype Dbl       = text "Double" vtype Integ     = text "Int"-vtype Strng     = text "String"+vtype Strng     = text "Text" vtype EStrng    = text "EscString" vtype Bl        = text "Bool" vtype (Cust t)  = text t@@ -144,7 +150,7 @@                      . (++ [defUnknown])                      . map createDefn                      $ atts att-      derivs = nest (tab + 2) $ text "deriving (Eq, Ord, Show, Read)"+      derivs = nest tab $ text "deriving (Eq, Ord, Show, Read)"       createDefn a = [cnst a <+> vtypeCode a                      , if isEmpty cm                        then empty@@ -152,7 +158,7 @@                      ]           where             cm = comment a-      defUnknown = [ unknownAttr <+> vtype Strng <+> vtype Strng+      defUnknown = [ unknownAttr <+> unknownNameAlias <+> vtype Strng                    , text "-- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively."                    ] @@ -164,6 +170,21 @@     where       tp = tpNm att +nameAlias     :: Atts -> Code+nameAlias att = comment+                $$ (text "type"+                    <+> unknownNameAlias+                    <+> equals+                    <+> vtype Strng)+  where+    comment = text "-- | The name for an" <+> unknownAttr+              <> text "; must satisfy "+              <+> quotes validUnknownName+              <> text "."++unknownNameAlias :: Code+unknownNameAlias = text "AttributeName"+ showInstance     :: Atts -> Code showInstance att = hdr $+$ insts'     where@@ -192,7 +213,8 @@ parseInstance att = hdr $+$ nest tab fns     where       hdr = text "instance" <+> text "ParseDot" <+> tpNm att <+> text "where"-      fn = pFunc <+> equals <+> text "oneOf" <+> ops+      fn = pFunc <+> equals <+> (text "stringParse" <+> parens (text "concat" <+> ops)+                                 $$ text "`onFail`" $$ pUnknown)       fns = vsep [ fn                  , text "parse" <+> equals <+> pFunc                  , text "parseList" <+> equals <+> text "parseUnqtList"@@ -201,7 +223,6 @@             . asRows             . firstOthers lbrack comma             . map return-            . (++ [pUnknown])             . map parseAttr             $ atts att       pFunc = text "parseUnqt"@@ -219,7 +240,7 @@                  <+> parens (text "parseEq >> parse")  arbitraryInstance     :: Atts -> Code-arbitraryInstance att = vsep [hdr $+$ fns, kFunc]+arbitraryInstance att = hdr $+$ fns     where       hdr = text "instance" <+> text "Arbitrary" <+> tpNm att <+> text "where"       fns = nest tab $ vsep [aFn, sFn]@@ -243,31 +264,53 @@                      , dollar <+> shrinkFor (valtype a) <+> var                      ]       aUnknown = text "liftM2" <+> unknownAttr-                 <+> parens (text "suchThat" <+> text "arbIDString" <+> kFuncNm)+                 <+> parens (text "suchThat" <+> text "arbIDString" <+> validUnknownName)                  <+> arbitraryFor Strng       sUnknown = [ sFunc <+> parens (unknownAttr <+> char 'a' <+> var)                  , equals <+> text "liftM2" <+> unknownAttr-                 , parens (text "liftM" <+> parens (text "filter" <+> kFuncNm)+                 , parens (text "liftM" <+> parens (text "filter" <+> validUnknownName)                            <+> shrinkFor Strng <+> char 'a')                    <+> parens (shrinkFor Strng <+> var)                  ] -      kFunc = asRows (kTpSig : kTrs ++ [kOth])-      kFuncNm = text "validUnknown"-      kTpSig = [ kFuncNm-               , colon <> colon <+> text "String -> Bool"-               ]-      kTrs = map kTr . concatMap parseNames $ atts att-      kTr pn = [ kFuncNm <+> doubleQuotes pn-               , equals <+> text "False"-               ]-      kOth = [ kFuncNm <+> char '_'-             , equals <+> text "True"-             ]+validUnknownName :: Code+validUnknownName = text "validUnknown" +validUnknownFunc     :: Atts -> Code+validUnknownFunc att = cmnt $$ asRows [tpSig, def] $$ whClause+    where+      var = text "txt"+      setVar = text "names"+      cmnt = text "-- | Determine if the provided 'Text' value is a valid name"+             <+> text "for an '" <> unknownAttr <> text "'."+      tpSig = [ validUnknownName+              , colon <> colon <+> text "AttributeName -> Bool"+              ]+      def = [ validUnknownName <+> var+            , equals <+>+              (text "T.toLower" <+> var+               <+> text "`S.notMember`" <+> setVar+               $$ text "&&" <+> text "isIDString" <+> var)+            ]+      whClause = nest tab+                 $ text "where"+                 $$ nest tab setDef+      setDef = setVar <+> equals <+> mkSet+      mkSet = parens (text "S.fromList . map T.toLower"+                      $$ dollar+                      <+> setList)+              $$ text "`S.union`"+              $$ text "keywords"+      setList = flip ($$) rbrack+                . asRows+                . firstOthers lbrack comma+                . flip (++) [[doubleQuotes (text "charset")+                              <+> text "-- Defined upstream, just not used here."]]+                . map ((:[]) . doubleQuotes)+                . concatMap parseNames+                $ atts att+ arbitraryFor                :: VType -> Doc-arbitraryFor Strng          = text "arbString"-arbitraryFor EStrng         = text "arbString" arbitraryFor (Cust ('[':_)) = text "arbList" arbitraryFor _              = text "arbitrary" @@ -276,8 +319,6 @@  shrinkFor :: VType -> Doc shrinkFor (Cust ('[':_)) = text "nonEmptyShrinks"-shrinkFor Strng          = text "shrinkString"-shrinkFor EStrng         = text "shrinkString" shrinkFor _              = text "shrink"  usedByFunc          :: String -> (Attribute -> Bool) -> Atts -> Code@@ -339,6 +380,26 @@           , equals <+> text "False"           ] +defValueFunc :: Atts -> Code+defValueFunc att = cmnt $$ asRows (tpSig : stmts ++ [unknownAtr])+  where+    cmnt = text "-- | Return the default value for a specific" <+> quotes dt+           <+> text "if possible; graph/cluster values are preferred"+           <+> text "over node/edge values."+    dFunc = text "defaultAttributeValue"+    dt = tpNm att+    tpSig = [ dFunc+            , colon <> colon+              <+> dt <+> text "->" <+> text "Maybe" <+> dt+            ]+    stmts = map sf . filter (isJust . defValue) $ atts att+    sf a = [ dFunc <+> cnst a <> braces empty+           , equals <+> text "Just" <+> text "$" <+> cnst a+             <+> fromJust (defValue a)+           ]+    unknownAtr = [ dFunc <+> char '_'+                 , equals <+> text "Nothing"+                 ]  -- ----------------------------------------------------------------------------- @@ -346,7 +407,7 @@  -- Size of a tab character tab :: Int-tab = 4+tab = 2  firstOthers            :: Doc -> Doc -> [[Doc]] -> [[Doc]] firstOthers _ _ []     = []@@ -388,150 +449,149 @@ -- The actual attributes  attributes :: [Attribute]-attributes = [ makeAttr "Damping" ["Damping"] "G" Dbl Nothing (Just "@0.99@") (Just "@0.0@") (Just "neato only")-             , makeAttr "K" ["K"] "GC" Dbl Nothing (Just "@0.3@") (Just "@0@") (Just "sfdp, fdp only")-             , makeAttr "URL" ["URL", "href"] "ENGC" EStrng Nothing (Just "none") Nothing (Just "svg, postscript, map only")-             , makeAttr "ArrowHead" ["arrowhead"] "E" (Cust "ArrowType") Nothing (Just "@'normal'@") Nothing Nothing-             , makeAttr "ArrowSize" ["arrowsize"] "E" Dbl Nothing (Just "@1.0@") (Just "@0.0@") Nothing-             , makeAttr "ArrowTail" ["arrowtail"] "E" (Cust "ArrowType") Nothing (Just "@'normal'@") Nothing Nothing-             , makeAttr "Aspect" ["aspect"] "G" (Cust "AspectType") Nothing Nothing Nothing (Just "dot only")-             , makeAttr "Bb" ["bb"] "G" (Cust "Rect") Nothing Nothing Nothing (Just "write only")-             , makeAttr "BgColor" ["bgcolor"] "GC" (Cust "Color") Nothing (Just "X11Color 'Transparent'") Nothing Nothing-             , makeAttr "Center" ["center"] "G" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "Charset" ["charset"] "G" Strng Nothing (Just "@\\\"UTF-8\\\"@") Nothing Nothing-             , makeAttr "ClusterRank" ["clusterrank"] "G" (Cust "ClusterMode") Nothing (Just "@'Local'@") Nothing (Just "dot only")-             , makeAttr "ColorScheme" ["colorscheme"] "ENCG" (Cust "ColorScheme") Nothing (Just "@'X11'@") Nothing Nothing-             , makeAttr "Color" ["color"] "ENC" (Cust "[Color]") Nothing (Just "@X11Color 'Black'@") Nothing Nothing-             , makeAttr "Comment" ["comment"] "ENG" Strng Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Compound" ["compound"] "G" Bl (Just "True") (Just "@'False'@") Nothing (Just "dot only")-             , makeAttr "Concentrate" ["concentrate"] "G" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "Constraint" ["constraint"] "E" Bl (Just "True")  (Just "@'True'@") Nothing (Just "dot only")-             , makeAttr "Decorate" ["decorate"] "E" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "DefaultDist" ["defaultdist"] "G" Dbl Nothing (Just "@1+(avg. len)*sqrt(|V|)@") (Just "@epsilon@") (Just "neato only")-             , makeAttr "Dimen" ["dimen"] "G" Integ Nothing (Just "@2@") (Just "@2@") (Just "sfdp, fdp, neato only")-             , makeAttr "Dim" ["dim"] "G" Integ Nothing (Just "@2@") (Just "@2@") (Just "sfdp, fdp, neato only")-             , makeAttr "Dir" ["dir"] "E" (Cust "DirType") Nothing (Just "@'Forward'@ (directed), @'NoDir'@ (undirected)") Nothing Nothing-             , makeAttr "DirEdgeConstraints" ["diredgeconstraints"] "G" (Cust "DEConstraints") (Just "EdgeConstraints") (Just "@'NoConstraints'@") Nothing (Just "neato only")-             , makeAttr "Distortion" ["distortion"] "N" Dbl Nothing (Just "@0.0@") (Just "@-100.0@") Nothing-             , makeAttr "DPI" ["dpi", "resolution"] "G" Dbl Nothing (Just "@96.0@, @0.0@") Nothing (Just "svg, bitmap output only; \\\"resolution\\\" is a synonym")-             , makeAttr "EdgeURL" ["edgeURL", "edgehref"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "EdgeTarget" ["edgetarget"] "E" EStrng Nothing (Just "none") Nothing (Just "svg, map only")-             , makeAttr "EdgeTooltip" ["edgetooltip"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Epsilon" ["epsilon"] "G" Dbl Nothing (Just "@.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@)") Nothing (Just "neato only")-             , makeAttr "ESep" ["esep"] "G" (Cust "DPoint") Nothing (Just "@+3@") Nothing (Just "not dot")-             , makeAttr "FillColor" ["fillcolor"] "NC" (Cust "Color") Nothing (Just "@X11Color 'LightGray'@ (nodes), @X11Color 'Black'@ (clusters)") Nothing Nothing-             , makeAttr "FixedSize" ["fixedsize"] "N" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "FontColor" ["fontcolor"] "ENGC" (Cust "Color") Nothing (Just "@X11Color 'Black'@") Nothing Nothing-             , makeAttr "FontName" ["fontname"] "ENGC" Strng Nothing (Just "@\\\"Times-Roman\\\"@") Nothing Nothing-             , makeAttr "FontNames" ["fontnames"] "G" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg only")-             , makeAttr "FontPath" ["fontpath"] "G" Strng Nothing (Just "system-dependent") Nothing Nothing-             , makeAttr "FontSize" ["fontsize"] "ENGC" Dbl Nothing (Just "@14.0@") (Just "@1.0@") Nothing-             , makeAttr "Group" ["group"] "N" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "HeadURL" ["headURL", "headhref"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "HeadClip" ["headclip"] "E" Bl (Just "True") (Just "@'True'@") Nothing Nothing-             , makeAttr "HeadLabel" ["headlabel"] "E" (Cust "Label") Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "HeadPort" ["headport"] "E" (Cust "PortPos") Nothing (Just "@'PP' 'CenterPoint'@") Nothing Nothing-             , makeAttr "HeadTarget" ["headtarget"] "E" EStrng Nothing (Just "none") Nothing (Just "svg, map only")-             , makeAttr "HeadTooltip" ["headtooltip"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Height" ["height"] "N" Dbl Nothing (Just "@0.5@") (Just "@0.02@") Nothing-             , makeAttr "ID" ["id"] "GNE" (Cust "Label") Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, postscript, map only")-             , makeAttr "Image" ["image"] "N" Strng Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "ImageScale" ["imagescale"] "N" (Cust "ScaleType") (Just "UniformScale") (Just "@'NoScale'@") Nothing Nothing-             , makeAttr "LabelURL" ["labelURL", "labelhref"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "LabelAngle" ["labelangle"] "E" Dbl Nothing (Just "@-25.0@") (Just "@-180.0@") Nothing-             , makeAttr "LabelDistance" ["labeldistance"] "E" Dbl Nothing (Just "@1.0@") (Just "@0.0@") Nothing-             , makeAttr "LabelFloat" ["labelfloat"] "E" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "LabelFontColor" ["labelfontcolor"] "E" (Cust "Color") Nothing (Just "@X11Color 'Black'@") Nothing Nothing-             , makeAttr "LabelFontName" ["labelfontname"] "E" Strng Nothing (Just "@\\\"Times-Roman\\\"@") Nothing Nothing-             , makeAttr "LabelFontSize" ["labelfontsize"] "E" Dbl Nothing (Just "@14.0@") (Just "@1.0@") Nothing-             , makeAttr "LabelJust" ["labeljust"] "GC" (Cust "Justification") Nothing (Just "@'JCenter'@") Nothing Nothing-             , makeAttr "LabelLoc" ["labelloc"] "GCN" (Cust "VerticalPlacement") Nothing (Just "@'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)") Nothing Nothing-             , makeAttr "LabelTarget" ["labeltarget"] "E" EStrng Nothing (Just "none") Nothing (Just "svg, map only")-             , makeAttr "LabelTooltip" ["labeltooltip"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Label" ["label"] "ENGC" (Cust "Label") Nothing (Just "@'StrLabel' \\\"\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise)") Nothing Nothing-             , makeAttr "Landscape" ["landscape"] "G" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "LayerSep" ["layersep"] "G" Strng Nothing (Just "@\\\" :\\t\\\"@") Nothing Nothing-             , makeAttr "Layers" ["layers"] "G" (Cust "LayerList") Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Layer" ["layer"] "EN" (Cust "LayerRange") Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Layout" ["layout"] "G" Strng Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Len" ["len"] "E" Dbl Nothing (Just "@1.0@ (neato), @0.3@ (fdp)") Nothing (Just "fdp, neato only")-             , makeAttr "LevelsGap" ["levelsgap"] "G" Dbl Nothing (Just "@0.0@") Nothing (Just "neato only")-             , makeAttr "Levels" ["levels"] "G" Integ Nothing (Just "@MAXINT@") (Just "@0@") (Just "sfdp only")-             , makeAttr "LHead" ["lhead"] "E" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "LPos" ["lp"] "EGC" (Cust "Point") Nothing Nothing Nothing (Just "write only")-             , makeAttr "LTail" ["ltail"] "E" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "Margin" ["margin"] "NG" (Cust "DPoint") Nothing (Just "device-dependent") Nothing Nothing-             , makeAttr "MaxIter" ["maxiter"] "G" Integ Nothing (Just "@100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp)") Nothing (Just "fdp, neato only")-             , makeAttr "MCLimit" ["mclimit"] "G" Dbl Nothing (Just "@1.0@") Nothing (Just "dot only")-             , makeAttr "MinDist" ["mindist"] "G" Dbl Nothing (Just "@1.0@") (Just "@0.0@") (Just "circo only")-             , makeAttr "MinLen" ["minlen"] "E" Integ Nothing (Just "@1@") (Just "@0@") (Just "dot only")-             , makeAttr "Model" ["model"] "G" (Cust "Model") Nothing (Just "@'ShortPath'@") Nothing (Just "neato only")-             , makeAttr "Mode" ["mode"] "G" (Cust "ModeType") Nothing (Just "@'Major'@") Nothing (Just "neato only")-             , makeAttr "Mosek" ["mosek"] "G" Bl (Just "True") (Just "@'False'@") Nothing (Just "neato only; requires the Mosek software")-             , makeAttr "NodeSep" ["nodesep"] "G" Dbl Nothing (Just "@0.25@") (Just "@0.02@") (Just "dot only")-             , makeAttr "NoJustify" ["nojustify"] "GCNE" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "Normalize" ["normalize"] "G" Bl (Just "True") (Just "@'False'@") Nothing (Just "not dot")-             , makeAttr "Nslimit1" ["nslimit1"] "G" Dbl Nothing Nothing Nothing (Just "dot only")-             , makeAttr "Nslimit" ["nslimit"] "G" Dbl Nothing Nothing Nothing (Just "dot only")-             , makeAttr "Ordering" ["ordering"] "G" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "Orientation" ["orientation"] "N" Dbl Nothing (Just "@0.0@") (Just "@360.0@") Nothing-             , makeAttr "OutputOrder" ["outputorder"] "G" (Cust "OutputMode") Nothing (Just "@'BreadthFirst'@") Nothing Nothing-             , makeAttr "OverlapScaling" ["overlap_scaling"] "G" Dbl Nothing (Just "@-4@") (Just "@-1.0e10@") (Just "prism only")-             , makeAttr "Overlap" ["overlap"] "G" (Cust "Overlap") (Just "KeepOverlaps") (Just "@'KeepOverlaps'@") Nothing (Just "not dot")-             , makeAttr "PackMode" ["packmode"] "G" (Cust "PackMode") Nothing (Just "@'PackNode'@") Nothing (Just "not dot")-             , makeAttr "Pack" ["pack"] "G" (Cust "Pack") (Just "DoPack") (Just "@'False'@") Nothing (Just "not dot")-             , makeAttr "Pad" ["pad"] "G" (Cust "DPoint") Nothing (Just "@'DVal' 0.0555@ (4 points)") Nothing Nothing-             , makeAttr "PageDir" ["pagedir"] "G" (Cust "PageDir") Nothing (Just "@'BL'@") Nothing Nothing-             , makeAttr "Page" ["page"] "G" (Cust "Point") Nothing Nothing Nothing Nothing-             , makeAttr "PenColor" ["pencolor"] "C" (Cust "Color") Nothing (Just "@X11Color 'Black'@") Nothing Nothing-             , makeAttr "PenWidth" ["penwidth"] "CNE" Dbl Nothing (Just "@1.0@") (Just "@0.0@") Nothing-             , makeAttr "Peripheries" ["peripheries"] "NC" Integ Nothing (Just "shape default (nodes), @1@ (clusters)") (Just "0") Nothing-             , makeAttr "Pin" ["pin"] "N" Bl (Just "True") (Just "@'False'@") Nothing (Just "fdp, neato only")-             , makeAttr "Pos" ["pos"] "EN" (Cust "Pos") Nothing Nothing Nothing Nothing-             , makeAttr "QuadTree" ["quadtree"] "G" (Cust "QuadType") (Just "NormalQT") (Just "@'NormalQT'@") Nothing (Just "sfdp only")-             , makeAttr "Quantum" ["quantum"] "G" Dbl Nothing (Just "@0.0@") (Just "@0.0@") Nothing-             , makeAttr "RankDir" ["rankdir"] "G" (Cust "RankDir") Nothing (Just "@'TB'@") Nothing (Just "dot only")-             , makeAttr "RankSep" ["ranksep"] "G" (Cust "[Double]") Nothing (Just "@0.5@ (dot), @1.0@ (twopi)") (Just "0.02") (Just "twopi, dot only")-             , makeAttr "Rank" ["rank"] "S" (Cust "RankType") Nothing Nothing Nothing (Just "dot only")-             , makeAttr "Ratio" ["ratio"] "G" (Cust "Ratios") Nothing Nothing Nothing Nothing-             , makeAttr "Rects" ["rects"] "N" (Cust "Rect") Nothing Nothing Nothing (Just "write only")-             , makeAttr "Regular" ["regular"] "N" Bl (Just "True") (Just "@'False'@") Nothing Nothing-             , makeAttr "ReMinCross" ["remincross"] "G" Bl (Just "True") (Just "@'False'@") Nothing (Just "dot only")-             , makeAttr "RepulsiveForce" ["repulsiveforce"] "G" Dbl Nothing (Just "@1.0@") (Just "@0.0@") (Just "sfdp only")-             , makeAttr "Root" ["root"] "GN" (Cust "Root") (Just "IsCentral") (Just "@'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes)") Nothing (Just "circo, twopi only")-             , makeAttr "Rotate" ["rotate"] "G" Integ Nothing (Just "@0@") Nothing Nothing-             , makeAttr "SameHead" ["samehead"] "E" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "SameTail" ["sametail"] "E" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "dot only")-             , makeAttr "SamplePoints" ["samplepoints"] "N" Integ Nothing (Just "@8@ (output), @20@ (overlap and image maps)") Nothing Nothing-             , makeAttr "SearchSize" ["searchsize"] "G" Integ Nothing (Just "@30@") Nothing (Just "dot only")-             , makeAttr "Sep" ["sep"] "G" (Cust "DPoint") Nothing (Just "@+4@") Nothing (Just "not dot")-             , makeAttr "ShapeFile" ["shapefile"] "N" Strng Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "Shape" ["shape"] "N" (Cust "Shape") Nothing (Just "@'Ellipse'@") Nothing Nothing-             , makeAttr "ShowBoxes" ["showboxes"] "ENG" Integ Nothing (Just "@0@") (Just "@0@") (Just "dot only")-             , makeAttr "Sides" ["sides"] "N" Integ Nothing (Just "@4@") (Just "@0@") Nothing-             , makeAttr "Size" ["size"] "G" (Cust "Point") Nothing Nothing Nothing Nothing-             , makeAttr "Skew" ["skew"] "N" Dbl Nothing (Just "@0.0@") (Just "@-100.0@") Nothing-             , makeAttr "Smoothing" ["smoothing"] "G" (Cust "SmoothType") Nothing (Just "@'NoSmooth'@") Nothing (Just "sfdp only")-             , makeAttr "SortV" ["sortv"] "GCN" (Cust "Word16") Nothing (Just "@0@") (Just "@0@") Nothing-             , makeAttr "Splines" ["splines"] "G" (Cust "EdgeType") (Just "SplineEdges") Nothing Nothing Nothing-             , makeAttr "Start" ["start"] "G" (Cust "StartType") Nothing (Just "@\\\"\\\"@") Nothing (Just "fdp, neato only")-             , makeAttr "StyleSheet" ["stylesheet"] "G" Strng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg only")-             , makeAttr "Style" ["style"] "ENC" (Cust "[StyleItem]") Nothing Nothing Nothing Nothing-             , makeAttr "TailURL" ["tailURL", "tailhref"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, map only")-             , makeAttr "TailClip" ["tailclip"] "E" Bl (Just "True") (Just "@'True'@") Nothing Nothing-             , makeAttr "TailLabel" ["taillabel"] "E" (Cust "Label") Nothing (Just "@\\\"\\\"@") Nothing Nothing-             , makeAttr "TailPort" ["tailport"] "E" (Cust "PortPos") Nothing (Just "center") Nothing Nothing-             , makeAttr "TailTarget" ["tailtarget"] "E" EStrng Nothing (Just "none") Nothing (Just "svg, map only")-             , makeAttr "TailTooltip" ["tailtooltip"] "E" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "Target" ["target"] "ENGC" EStrng Nothing (Just "none") Nothing (Just "svg, map only")-             , makeAttr "Tooltip" ["tooltip"] "NEC" EStrng Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")-             , makeAttr "TrueColor" ["truecolor"] "G" Bl (Just "True") Nothing Nothing (Just "bitmap output only")-             , makeAttr "Vertices" ["vertices"] "N" (Cust "[Point]") Nothing Nothing Nothing (Just "write only")-             , makeAttr "ViewPort" ["viewport"] "G" (Cust "ViewPort") Nothing (Just "none") Nothing Nothing-             , makeAttr "VoroMargin" ["voro_margin"] "G" Dbl Nothing (Just "@0.05@") (Just "@0.0@") (Just "not dot")-             , makeAttr "Weight" ["weight"] "E" Dbl Nothing (Just "@1.0@") (Just "@0@ (dot), @1@ (neato,fdp,sfdp)") Nothing-             , makeAttr "Width" ["width"] "N" Dbl Nothing (Just "@0.75@") (Just "@0.01@") Nothing-             , makeAttr "Z" ["z"] "N" Dbl Nothing (Just "@0.0@") (Just "@-MAXFLOAT@, @-1000@") Nothing+attributes = [ makeAttr "Damping" ["Damping"] "G" Dbl Nothing (Just "0.99") (Just "@0.99@") (Just "@0.0@") (Just "neato only")+             , makeAttr "K" ["K"] "GC" Dbl Nothing (Just "0.3") (Just "@0.3@") (Just "@0@") (Just "sfdp, fdp only")+             , makeAttr "URL" ["URL", "href"] "ENGC" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, postscript, map only")+             , makeAttr "ArrowHead" ["arrowhead"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing+             , makeAttr "ArrowSize" ["arrowsize"] "E" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") Nothing+             , makeAttr "ArrowTail" ["arrowtail"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing+             , makeAttr "Aspect" ["aspect"] "G" (Cust "AspectType") Nothing Nothing Nothing Nothing (Just "dot only")+             , makeAttr "Bb" ["bb"] "G" (Cust "Rect") Nothing Nothing Nothing Nothing (Just "write only")+             , makeAttr "BgColor" ["bgcolor"] "GC" (Cust "Color") Nothing (Just "(X11Color Transparent)") (Just "@'X11Color' 'Transparent'@") Nothing Nothing+             , makeAttr "Center" ["center"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "ClusterRank" ["clusterrank"] "G" (Cust "ClusterMode") Nothing (Just "Local") (Just "@'Local'@") Nothing (Just "dot only")+             , makeAttr "ColorScheme" ["colorscheme"] "ENCG" (Cust "ColorScheme") Nothing (Just "X11") (Just "@'X11'@") Nothing Nothing+             , makeAttr "Color" ["color"] "ENC" (Cust "[Color]") Nothing (Just "[X11Color Black]") (Just "@['X11Color' 'Black']@") Nothing Nothing+             , makeAttr "Comment" ["comment"] "ENG" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing+             , makeAttr "Compound" ["compound"] "G" Bl (Just "True") (Just "False")(Just "@'False'@") Nothing (Just "dot only")+             , makeAttr "Concentrate" ["concentrate"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "Constraint" ["constraint"] "E" Bl (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "dot only")+             , makeAttr "Decorate" ["decorate"] "E" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "DefaultDist" ["defaultdist"] "G" Dbl Nothing Nothing (Just "@1+(avg. len)*sqrt(|V|)@") (Just "@epsilon@") (Just "neato only")+             , makeAttr "Dimen" ["dimen"] "G" Integ Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "sfdp, fdp, neato only")+             , makeAttr "Dim" ["dim"] "G" Integ Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "sfdp, fdp, neato only")+             , makeAttr "Dir" ["dir"] "E" (Cust "DirType") Nothing Nothing (Just "@'Forward'@ (directed), @'NoDir'@ (undirected)") Nothing Nothing+             , makeAttr "DirEdgeConstraints" ["diredgeconstraints"] "G" (Cust "DEConstraints") (Just "EdgeConstraints") (Just "NoConstraints") (Just "@'NoConstraints'@") Nothing (Just "neato only")+             , makeAttr "Distortion" ["distortion"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@-100.0@") Nothing+             , makeAttr "DPI" ["dpi", "resolution"] "G" Dbl Nothing Nothing (Just "@96.0@, @0.0@") Nothing (Just "svg, bitmap output only; \\\"resolution\\\" is a synonym")+             , makeAttr "EdgeURL" ["edgeURL", "edgehref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")+             , makeAttr "EdgeTarget" ["edgetarget"] "E" EStrng Nothing Nothing (Just "none") Nothing (Just "svg, map only")+             , makeAttr "EdgeTooltip" ["edgetooltip"] "E" EStrng Nothing Nothing (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")+             , makeAttr "Epsilon" ["epsilon"] "G" Dbl Nothing Nothing (Just "@.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@)") Nothing (Just "neato only")+             , makeAttr "ESep" ["esep"] "G" (Cust "DPoint") Nothing (Just "(DVal 3)") (Just "@'DVal' 3@") Nothing (Just "not dot")+             , makeAttr "FillColor" ["fillcolor"] "NC" (Cust "Color") Nothing (Just "(X11Color Black)")(Just "@'X11Color' 'LightGray'@ (nodes), @'X11Color' 'Black'@ (clusters)") Nothing Nothing+             , makeAttr "FixedSize" ["fixedsize"] "N" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "FontColor" ["fontcolor"] "ENGC" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing+             , makeAttr "FontName" ["fontname"] "ENGC" Strng Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing+             , makeAttr "FontNames" ["fontnames"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg only")+             , makeAttr "FontPath" ["fontpath"] "G" Strng Nothing Nothing (Just "system dependent") Nothing Nothing+             , makeAttr "FontSize" ["fontsize"] "ENGC" Dbl Nothing (Just "14") (Just "@14.0@") (Just "@1.0@") Nothing+             , makeAttr "Group" ["group"] "N" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")+             , makeAttr "HeadURL" ["headURL", "headhref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")+             , makeAttr "HeadClip" ["headclip"] "E" Bl (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing+             , makeAttr "HeadLabel" ["headlabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "'StrLabel' @\\\"\\\"@") Nothing Nothing+             , makeAttr "HeadPort" ["headport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing+             , makeAttr "HeadTarget" ["headtarget"] "E" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")+             , makeAttr "HeadTooltip" ["headtooltip"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")+             , makeAttr "Height" ["height"] "N" Dbl Nothing (Just "0.5") (Just "@0.5@") (Just "@0.02@") Nothing+             , makeAttr "ID" ["id"] "GNE" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing (Just "svg, postscript, map only")+             , makeAttr "Image" ["image"] "N" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing+             , makeAttr "ImageScale" ["imagescale"] "N" (Cust "ScaleType") (Just "UniformScale") (Just "NoScale") (Just "@'NoScale'@") Nothing Nothing+             , makeAttr "LabelURL" ["labelURL", "labelhref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")+             , makeAttr "LabelAngle" ["labelangle"] "E" Dbl Nothing (Just "(-25)") (Just "@-25.0@") (Just "@-180.0@") Nothing+             , makeAttr "LabelDistance" ["labeldistance"] "E" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") Nothing+             , makeAttr "LabelFloat" ["labelfloat"] "E" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "LabelFontColor" ["labelfontcolor"] "E" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing+             , makeAttr "LabelFontName" ["labelfontname"] "E" Strng Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing+             , makeAttr "LabelFontSize" ["labelfontsize"] "E" Dbl Nothing (Just "14") (Just "@14.0@") (Just "@1.0@") Nothing+             , makeAttr "LabelJust" ["labeljust"] "GC" (Cust "Justification") Nothing (Just "JCenter") (Just "@'JCenter'@") Nothing Nothing+             , makeAttr "LabelLoc" ["labelloc"] "GCN" (Cust "VerticalPlacement") Nothing (Just "VTop") (Just "@'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)") Nothing Nothing+             , makeAttr "LabelTarget" ["labeltarget"] "E" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")+             , makeAttr "LabelTooltip" ["labeltooltip"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")+             , makeAttr "Label" ["label"] "ENGC" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise)") Nothing Nothing+             , makeAttr "Landscape" ["landscape"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "LayerSep" ["layersep"] "G" (Cust "LayerSep") Nothing (Just "(LSep \" :\\t\")") (Just "@'LSep' \\\" :\\t\\\"@") Nothing Nothing+             , makeAttr "Layers" ["layers"] "G" (Cust "LayerList") Nothing (Just "(LL [])")  (Just "@'LL' []@") Nothing Nothing+             , makeAttr "Layer" ["layer"] "EN" (Cust "LayerRange") Nothing Nothing Nothing Nothing Nothing+             , makeAttr "Layout" ["layout"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing+             , makeAttr "Len" ["len"] "E" Dbl Nothing Nothing (Just "@1.0@ (neato), @0.3@ (fdp)") Nothing (Just "fdp, neato only")+             , makeAttr "LevelsGap" ["levelsgap"] "G" Dbl Nothing (Just "0") (Just "@0.0@") Nothing (Just "neato only")+             , makeAttr "Levels" ["levels"] "G" Integ Nothing (Just "maxBound") (Just "@'maxBound'@") (Just "@0@") (Just "sfdp only")+             , makeAttr "LHead" ["lhead"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")+             , makeAttr "LPos" ["lp"] "EGC" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only")+             , makeAttr "LTail" ["ltail"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")+             , makeAttr "Margin" ["margin"] "NG" (Cust "DPoint") Nothing Nothing (Just "device dependent") Nothing Nothing+             , makeAttr "MaxIter" ["maxiter"] "G" Integ Nothing Nothing (Just "@100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp)") Nothing (Just "fdp, neato only")+             , makeAttr "MCLimit" ["mclimit"] "G" Dbl Nothing (Just "1") (Just "@1.0@") Nothing (Just "dot only")+             , makeAttr "MinDist" ["mindist"] "G" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") (Just "circo only")+             , makeAttr "MinLen" ["minlen"] "E" Integ Nothing (Just "1") (Just "@1@") (Just "@0@") (Just "dot only")+             , makeAttr "Model" ["model"] "G" (Cust "Model") Nothing (Just "ShortPath") (Just "@'ShortPath'@") Nothing (Just "neato only")+             , makeAttr "Mode" ["mode"] "G" (Cust "ModeType") Nothing (Just "Major") (Just "@'Major'@") Nothing (Just "neato only")+             , makeAttr "Mosek" ["mosek"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "neato only; requires the Mosek software")+             , makeAttr "NodeSep" ["nodesep"] "G" Dbl Nothing (Just "0.25") (Just "@0.25@") (Just "@0.02@") (Just "dot only")+             , makeAttr "NoJustify" ["nojustify"] "GCNE" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "Normalize" ["normalize"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "not dot")+             , makeAttr "Nslimit1" ["nslimit1"] "G" Dbl Nothing Nothing Nothing Nothing (Just "dot only")+             , makeAttr "Nslimit" ["nslimit"] "G" Dbl Nothing Nothing Nothing Nothing (Just "dot only")+             , makeAttr "Ordering" ["ordering"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")+             , makeAttr "Orientation" ["orientation"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@360.0@") Nothing+             , makeAttr "OutputOrder" ["outputorder"] "G" (Cust "OutputMode") Nothing (Just "BreadthFirst") (Just "@'BreadthFirst'@") Nothing Nothing+             , makeAttr "OverlapScaling" ["overlap_scaling"] "G" Dbl Nothing (Just "(-4)") (Just "@-4@") (Just "@-1.0e10@") (Just "prism only")+             , makeAttr "Overlap" ["overlap"] "G" (Cust "Overlap") (Just "KeepOverlaps") (Just "KeepOverlaps") (Just "@'KeepOverlaps'@") Nothing (Just "not dot")+             , makeAttr "PackMode" ["packmode"] "G" (Cust "PackMode") Nothing (Just "PackNode") (Just "@'PackNode'@") Nothing (Just "not dot")+             , makeAttr "Pack" ["pack"] "G" (Cust "Pack") (Just "DoPack") (Just "DontPack") (Just "@'False'@") Nothing (Just "not dot")+             , makeAttr "Pad" ["pad"] "G" (Cust "DPoint") Nothing (Just "(DVal 0.0555)") (Just "@'DVal' 0.0555@ (4 points)") Nothing Nothing+             , makeAttr "PageDir" ["pagedir"] "G" (Cust "PageDir") Nothing (Just "Bl") (Just "@'Bl'@") Nothing Nothing+             , makeAttr "Page" ["page"] "G" (Cust "Point") Nothing Nothing Nothing Nothing Nothing+             , makeAttr "PenColor" ["pencolor"] "C" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing+             , makeAttr "PenWidth" ["penwidth"] "CNE" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") Nothing+             , makeAttr "Peripheries" ["peripheries"] "NC" Integ Nothing (Just "1") (Just "shape default (nodes), @1@ (clusters)") (Just "0") Nothing+             , makeAttr "Pin" ["pin"] "N" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "fdp, neato only")+             , makeAttr "Pos" ["pos"] "EN" (Cust "Pos") Nothing Nothing Nothing Nothing Nothing+             , makeAttr "QuadTree" ["quadtree"] "G" (Cust "QuadType") (Just "NormalQT") (Just "NormalQT") (Just "@'NormalQT'@") Nothing (Just "sfdp only")+             , makeAttr "Quantum" ["quantum"] "G" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@0.0@") Nothing+             , makeAttr "RankDir" ["rankdir"] "G" (Cust "RankDir") Nothing (Just "FromTop") (Just "@'FromTop'@") Nothing (Just "dot only")+             , makeAttr "RankSep" ["ranksep"] "G" (Cust "[Double]") Nothing Nothing (Just "@[0.5]@ (dot), @[1.0]@ (twopi)") (Just "[0.02]") (Just "twopi, dot only")+             , makeAttr "Rank" ["rank"] "S" (Cust "RankType") Nothing Nothing Nothing Nothing (Just "dot only")+             , makeAttr "Ratio" ["ratio"] "G" (Cust "Ratios") Nothing Nothing Nothing Nothing Nothing+             , makeAttr "Rects" ["rects"] "N" (Cust "[Rect]") Nothing Nothing Nothing Nothing (Just "write only")+             , makeAttr "Regular" ["regular"] "N" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing+             , makeAttr "ReMinCross" ["remincross"] "G" Bl (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "dot only")+             , makeAttr "RepulsiveForce" ["repulsiveforce"] "G" Dbl Nothing (Just "1") (Just "@1.0@") (Just "@0.0@") (Just "sfdp only")+             , makeAttr "Root" ["root"] "GN" (Cust "Root") (Just "IsCentral") (Just "(NodeName \"\")") (Just "@'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes)") Nothing (Just "circo, twopi only")+             , makeAttr "Rotate" ["rotate"] "G" Integ Nothing (Just "0") (Just "@0@") Nothing Nothing+             , makeAttr "SameHead" ["samehead"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")+             , makeAttr "SameTail" ["sametail"] "E" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only")+             , makeAttr "SamplePoints" ["samplepoints"] "N" Integ Nothing Nothing (Just "@8@ (output), @20@ (overlap and image maps)") Nothing Nothing+             , makeAttr "SearchSize" ["searchsize"] "G" Integ Nothing (Just "30") (Just "@30@") Nothing (Just "dot only")+             , makeAttr "Sep" ["sep"] "G" (Cust "DPoint") Nothing (Just "(DVal 4)") (Just "@'DVal' 4@") Nothing (Just "not dot")+             , makeAttr "ShapeFile" ["shapefile"] "N" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing+             , makeAttr "Shape" ["shape"] "N" (Cust "Shape") Nothing (Just "Ellipse") (Just "@'Ellipse'@") Nothing Nothing+             , makeAttr "ShowBoxes" ["showboxes"] "ENG" Integ Nothing (Just "0") (Just "@0@") (Just "@0@") (Just "dot only")+             , makeAttr "Sides" ["sides"] "N" Integ Nothing (Just "4") (Just "@4@") (Just "@0@") Nothing+             , makeAttr "Size" ["size"] "G" (Cust "Point") Nothing Nothing Nothing Nothing Nothing+             , makeAttr "Skew" ["skew"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@-100.0@") Nothing+             , makeAttr "Smoothing" ["smoothing"] "G" (Cust "SmoothType") Nothing (Just "NoSmooth") (Just "@'NoSmooth'@") Nothing (Just "sfdp only")+             , makeAttr "SortV" ["sortv"] "GCN" (Cust "Word16") Nothing (Just "0") (Just "@0@") (Just "@0@") Nothing+             , makeAttr "Splines" ["splines"] "G" (Cust "EdgeType") (Just "SplineEdges") (Just "SplineEdges") Nothing Nothing Nothing+             , makeAttr "Start" ["start"] "G" (Cust "StartType") Nothing Nothing Nothing Nothing (Just "fdp, neato only")+             , makeAttr "StyleSheet" ["stylesheet"] "G" Strng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg only")+             , makeAttr "Style" ["style"] "ENC" (Cust "[StyleItem]") Nothing Nothing Nothing Nothing Nothing+             , makeAttr "TailURL" ["tailURL", "tailhref"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only")+             , makeAttr "TailClip" ["tailclip"] "E" Bl (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing+             , makeAttr "TailLabel" ["taillabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing Nothing+             , makeAttr "TailPort" ["tailport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing+             , makeAttr "TailTarget" ["tailtarget"] "E" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")+             , makeAttr "TailTooltip" ["tailtooltip"] "E" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")+             , makeAttr "Target" ["target"] "ENGC" EStrng Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only")+             , makeAttr "Tooltip" ["tooltip"] "NEC" EStrng Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only")+             , makeAttr "TrueColor" ["truecolor"] "G" Bl (Just "True") Nothing Nothing Nothing (Just "bitmap output only")+             , makeAttr "Vertices" ["vertices"] "N" (Cust "[Point]") Nothing Nothing Nothing Nothing (Just "write only")+             , makeAttr "ViewPort" ["viewport"] "G" (Cust "ViewPort") Nothing Nothing (Just "none") Nothing Nothing+             , makeAttr "VoroMargin" ["voro_margin"] "G" Dbl Nothing (Just "0.05") (Just "@0.05@") (Just "@0.0@") (Just "not dot")+             , makeAttr "Weight" ["weight"] "E" Dbl Nothing Nothing (Just "@1.0@") (Just "@0@ (dot), @1@ (neato,fdp,sfdp)") Nothing+             , makeAttr "Width" ["width"] "N" Dbl Nothing (Just "0.75") (Just "@0.75@") (Just "@0.01@") Nothing+             , makeAttr "Z" ["z"] "N" Dbl Nothing (Just "0") (Just "@0.0@") (Just "@-MAXFLOAT@, @-1000@") Nothing              ]  unknownAttr :: Doc
utils/TestParsing.hs view
@@ -1,5 +1,7 @@ #!/usr/bin/runhaskell +{-# LANGUAGE ScopedTypeVariables #-}+ {- |    Module      : TestParsing    Description : Check if the graphviz parser can parse "real world" Dot code.@@ -16,13 +18,17 @@  import Data.GraphViz import Data.GraphViz.Types.Generalised-import Data.GraphViz.Parsing(runParser, parse, discard, allWhitespace', eof)+import Data.GraphViz.Parsing(runParser, parse) import Data.GraphViz.PreProcessing(preProcess)+import Data.GraphViz.Commands.IO(hGetStrict, toUTF8)+import Data.GraphViz.Exception -import Control.Exception(try, ErrorCall(..), IOException)+import qualified Data.Text.Lazy as T+import Data.Text.Lazy(Text)+import qualified Data.ByteString.Lazy as B+import Control.Exception.Extensible(try, IOException) import Control.Monad(liftM) import System.Environment(getArgs)-import System.IO(openFile, IOMode(ReadMode))  -- ----------------------------------------------------------------------------- @@ -41,7 +47,7 @@ -- -----------------------------------------------------------------------------  -withParse :: (DotRepr dg n) => (a -> IO String) -> (dg n -> IO ())+withParse :: (DotRepr dg n) => (a -> IO Text) -> (dg n -> IO ())              -> (ErrMsg -> String) -> a -> IO () withParse toStr withDG cmbErr a = do dc <- toStr a                                      edg <- tryParse dc@@ -51,8 +57,8 @@                                                         putStrLn $ cmbErr err                                                         putStrLn  "" -type DG = DotGraph String-type GDG = GDotGraph String+type DG = DotGraph Text+type GDG = GDotGraph Text type ErrMsg = String  tryParseFile    :: FilePath -> IO ()@@ -62,33 +68,33 @@                                         ++ err ++ "\n"     maybeParse (Right dot) = withParse (const $ return dot)                                        (tryParseCanon fp)-                                       (\ e -> fp ++ ": Cannot parse as a GDotGraph:\n"-                                               ++ e)+                                       ("Cannot parse as a GDotGraph: "++)                                        fp - tryParseCanon    :: FilePath -> GDG -> IO () tryParseCanon fp = withParse prettyPrint-                             (const (return ()) . asDG)+                             ((`seq` return ()) . T.length . printDotGraph . asDG)                              (\ e -> fp ++ ": Canonical Form not a DotGraph:\n"                                      ++ e)   where     asDG = flip asTypeOf emptDG     emptDG = DotGraph False False Nothing $ DotStmts [] [] [] [] :: DG+    prettyPrint dg = graphvizWithHandle (commandFor dg) dg Canon hGetStrict -tryParse    :: (DotRepr dg n) => String -> IO (Either ErrMsg (dg n))-tryParse dc = liftM getErrMsg . try+tryParse    :: (DotRepr dg n) => Text -> IO (Either ErrMsg (dg n))+tryParse dc = handle getErr               $ let (dg, rst) = runParser parse $ preProcess dc-                in length rst `seq` return dg--getErrMsg :: Either ErrorCall a -> Either ErrMsg a-getErrMsg = either getEC Right+                in T.length rst `seq` return dg   where-    getEC (ErrorCall e) = Left e+    getErr :: GraphvizException -> IO (Either ErrMsg a)+    getErr = return . Left . show -readFile'    :: FilePath -> IO (Either ErrMsg String)-readFile' fp = liftM getMsg . try-               $ openFile fp ReadMode >>= hGetContents'+readFile' :: FilePath -> IO (Either ErrMsg Text)+readFile' fp = do putStrLn fp+                  liftM getMsg . try $ readUTF8File fp   where-    getMsg :: Either IOException String -> Either ErrMsg String+    getMsg :: Either IOException Text -> Either ErrMsg Text     getMsg = either (Left . show) Right++readUTF8File :: FilePath -> IO Text+readUTF8File = liftM toUTF8 . B.readFile