diff --git a/Changelog.md b/Changelog.md
--- a/Changelog.md
+++ b/Changelog.md
@@ -7,6 +7,95 @@
The following is information about what major changes have gone into
each release.
+Changes in 2999.17.0.0
+----------------------
+
+* Add support for Graphviz 2.32.0, 2.32.1, 2.34.0, 2.36.0 and 2.38.0:
+
+ - **WARNING**: at least as of Graphviz-2.32.0, `dot -Tcanon` no
+ longer produces Dot code that is in the format expected by the
+ Canonical Dot representation in this library. As such, unless
+ you're very sure of your sources you should _always_ use the
+ Generalised representation for parsing (see also the new
+ `FromGeneralisedDot` class mentioned below).
+
+ - New attributes:
+
+ + `XDotVersion` (as of 2.34.0)
+
+ + `InputScale` (as of 2.36.0)
+
+ + `OverlapShrink` (as of 2.36.0)
+
+ - Changed attributes:
+
+ + `Aspect` no longer available (as of 2.36.0)
+
+ + New `ModeType` values for use with `sfdp`: `SpringMode` and
+ `MaxEnt`.
+
+ + `Weight` now takes a value of type `Number`, that explicitly
+ distinguishes between `Doubles` and `Ints`.
+
+ + `FixedSize` and `Normalize` now have their own types.
+
+ + New `Shape`s: `Star` and `Underline` (as well as `Square`
+ which seems to have been omitted from previous versions).
+
+ - Other relevant changes:
+
+ + `XDot` now takes an optional version. Note that this
+ doesn't have any effect on how _graphviz_ works.
+
+ + The default extension for Dot-graphs is now `.gv` rather
+ than `.dot` to reflect Graphviz's changed conventions.
+
+* Other changes to the API:
+
+ - Add the `FromGeneralisedDot` class, which provides a
+ semi-inverse to `fromCanonical` in `DotRepr`.
+
+ - `GraphID` now uses `Number` rather than separate `Int` and
+ `Double` constructors; this only matters if you manually
+ constructed or de-constructed `GraphID` values (`ToGraphID`
+ still works).
+
+ - Add the ability to parse a Dot graph "liberally": that is, if an
+ `Attribute` doesn't match the specification, then let it fall
+ back to an `UnknownAttribute`. This is still experimental, and
+ requires more manual usage than the in-built commands (e.g. it
+ isn't supported in the default round-tripping).
+
+ - Now using the definition of `bracket` from `polyparse >= 1.9`.
+
+ - Monadic representation now has `Functor` and `Applicative`
+ instances to satisfy the up-coming changes in GHC 7.10.
+
+* Compilation time has been reduced in two ways:
+
+ - The `Data.GraphViz.Attributes.Complete` module has been split up
+ (but still exports the same API, so no need to import more
+ modules). Whilst I haven't measured it, this should also reduce
+ memory requirements for compilation.
+
+ - The testsuite now uses the library explicitly, and thus no
+ longer needs to re-compile half the library.
+
+* Bug-fixes:
+
+ - Double values are now longer parseable without double quotes if
+ they have an exponential term (to better match the definition).
+
+ - It is no longer assumed when round-tripping that `dot -Tdot`
+ generates canonicalised Dot graphs.
+
+* The `TestParsing` script is now directly buildable by Cabal using
+ the `test-parsing` flag (the resulting executable is called
+ `graphviz-testparsing`). This is not made an actual test-suite as
+ not all files found will be actual Dot graphs, and it's known that
+ it fails on some. Instead it's meant to be used as an indication of
+ how well this library parses "real-world" Dot code.
+
Changes in 2999.16.0.0
----------------------
diff --git a/Data/GraphViz.hs b/Data/GraphViz.hs
--- a/Data/GraphViz.hs
+++ b/Data/GraphViz.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings #-}
{- |
Module : Data.GraphViz
@@ -9,8 +9,8 @@
This is the top-level module for the graphviz library. It provides
functions to convert 'Data.Graph.Inductive.Graph.Graph's into the
- /Dot/ language used by the /Graphviz/ suite of programs (as well as
- a limited ability to perform the reverse operation).
+ /Dot/ language used by the /Graphviz/ suite of programs (as well as a
+ limited ability to perform the reverse operation).
If you wish to construct a Haskell representation of a Dot graph
yourself rather than using the conversion functions here, please
@@ -19,8 +19,8 @@
Information about Graphviz and the Dot language can be found at:
-
-}
+
module Data.GraphViz
( -- * Conversion from graphs to /Dot/ format.
-- ** Specifying parameters.
@@ -63,28 +63,29 @@
, module Data.GraphViz.Commands
) where
-import Data.GraphViz.Types
-import Data.GraphViz.Types.Canonical( DotGraph(..), DotStatements(..)
- , DotSubGraph(..))
import Data.GraphViz.Algorithms.Clustering
-import Data.GraphViz.Util(uniq, uniqBy)
import Data.GraphViz.Attributes
-import Data.GraphViz.Attributes.Complete(CustomAttribute, AttributeName
- , customAttribute, findSpecifiedCustom
- , customValue)
+import Data.GraphViz.Attributes.Complete (AttributeName, CustomAttribute,
+ customAttribute, customValue,
+ findSpecifiedCustom)
import Data.GraphViz.Commands
-import Data.GraphViz.Commands.IO(hGetDot)
+import Data.GraphViz.Commands.IO (hGetDot)
+import Data.GraphViz.Internal.Util (uniq, uniqBy)
+import Data.GraphViz.Types
+import Data.GraphViz.Types.Canonical (DotGraph (..), DotStatements (..),
+ DotSubGraph (..))
+import Data.GraphViz.Types.Generalised (FromGeneralisedDot (..))
-import Data.Functor((<$>))
-import Data.Graph.Inductive.Graph
-import qualified Data.Set as Set
-import Control.Arrow((&&&), first)
-import Data.Maybe(mapMaybe, fromJust)
-import qualified Data.Map as Map
-import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import System.IO.Unsafe(unsafePerformIO)
-import Control.Concurrent(forkIO)
+import Control.Arrow (first, (&&&))
+import Control.Concurrent (forkIO)
+import Data.Functor ((<$>))
+import Data.Graph.Inductive.Graph
+import qualified Data.Map as Map
+import Data.Maybe (fromJust, mapMaybe)
+import qualified Data.Set as Set
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import System.IO.Unsafe (unsafePerformIO)
-- -----------------------------------------------------------------------------
@@ -143,7 +144,7 @@
> where
> params = blankParams { globalAttributes = []
> , clusterBy = clustBy
- > , clusterID = Int
+ > , clusterID = Num . Int
> , fmtCluster = clFmt
> , fmtNode = const []
> , fmtEdge = const []
@@ -198,6 +199,7 @@
, fmtEdge :: ((n,n,el) -> Attributes)
}
+
-- | An alias for 'NodeCluster' when dealing with FGL graphs.
type LNodeCluster cl l = NodeCluster cl (Node,l)
@@ -217,7 +219,7 @@
, globalAttributes = []
, clusterBy = N
, isDotCluster = const True
- , clusterID = const (Int 0)
+ , clusterID = const (Num $ Int 0)
, fmtCluster = const []
, fmtNode = const []
, fmtEdge = const []
@@ -444,12 +446,13 @@
-- | Pass the 'DotRepr' through the relevant command and then augment
-- the 'Graph' that it came from.
-dotAttributes :: (Graph gr, PPDotRepr dg Node) => Bool -> gr nl (EdgeID el)
+dotAttributes :: (Graph gr, PPDotRepr dg Node, FromGeneralisedDot dg Node)
+ => Bool -> gr nl (EdgeID el)
-> dg Node -> IO (gr (AttributeNode nl) (AttributeEdge el))
dotAttributes isDir gr dot
= augmentGraph gr . parseDG <$> graphvizWithHandle command dot DotOutput hGetDot
where
- parseDG = (`asTypeOf` dot)
+ parseDG = (`asTypeOf` dot) . fromGeneralised
command = if isDir then dirCommand else undirCommand
-- | Use the 'Attributes' in the provided 'DotGraph' to augment the
diff --git a/Data/GraphViz/Algorithms.hs b/Data/GraphViz/Algorithms.hs
--- a/Data/GraphViz/Algorithms.hs
+++ b/Data/GraphViz/Algorithms.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE MonadComprehensions, MultiParamTypeClasses #-}
{- |
Module : Data.GraphViz.Algorithms
@@ -31,25 +31,26 @@
, transitiveReductionOptions
) where
-import Data.GraphViz.Attributes.Complete( Attributes, defaultAttributeValue)
+import Data.GraphViz.Attributes.Complete (Attributes, defaultAttributeValue)
import Data.GraphViz.Attributes.Same
+import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Types
import Data.GraphViz.Types.Canonical
-import Data.GraphViz.Types.Common
-import Data.GraphViz.Util(bool)
+import Data.GraphViz.Types.Internal.Common
-import Data.Function(on)
-import Data.List(groupBy, sortBy, partition, (\\), deleteBy)
-import Data.Maybe(listToMaybe, mapMaybe, fromMaybe)
-import qualified Data.DList as DList
-import qualified Data.Map as Map
-import Data.Map(Map)
-import qualified Data.Set as Set
-import Data.Set(Set)
-import qualified Data.Foldable as F
-import Control.Arrow(first, second, (***))
-import Control.Monad(unless)
-import Control.Monad.Trans.State
+import Control.Arrow (first, second, (***))
+import Control.Monad (unless)
+import Control.Monad.Trans.State
+import qualified Data.DList as DList
+import qualified Data.Foldable as F
+import Data.Function (on)
+import Data.List (deleteBy, groupBy, partition,
+ sortBy, (\\))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
+import Data.Set (Set)
+import qualified Data.Set as Set
-- -----------------------------------------------------------------------------
diff --git a/Data/GraphViz/Attributes.hs b/Data/GraphViz/Attributes.hs
--- a/Data/GraphViz/Attributes.hs
+++ b/Data/GraphViz/Attributes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{- |
Module : Data.GraphViz.Attributes
@@ -93,13 +93,18 @@
, RankType(..)
) where
-import Data.GraphViz.Attributes.Complete
-import Data.GraphViz.Attributes.Colors.X11
-import qualified Data.GraphViz.Attributes.HTML as Html
+import Data.GraphViz.Attributes.Arrows
+import Data.GraphViz.Attributes.Colors
+import Data.GraphViz.Attributes.Colors.X11
+import Data.GraphViz.Attributes.Complete (Attribute (..),
+ Attributes)
+import qualified Data.GraphViz.Attributes.HTML as Html
+import Data.GraphViz.Attributes.Internal
+import Data.GraphViz.Attributes.Values
+import qualified Data.Text as ST
+import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import qualified Data.Text as ST
-- -----------------------------------------------------------------------------
@@ -378,10 +383,9 @@
edgeEnds :: DirType -> Attribute
edgeEnds = Dir
-box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: Arrow
+box, crow, diamond, dotArrow, inv, noArrow, tee, vee :: Arrow
oDot, invDot, invODot, oBox, oDiamond :: Arrow
-normal = AType [(noMods, Normal)]
inv = AType [(noMods, Inv)]
dotArrow = AType [(noMods, DotArrow)]
invDot = AType [ (noMods, Inv)
diff --git a/Data/GraphViz/Attributes/Arrows.hs b/Data/GraphViz/Attributes/Arrows.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Attributes/Arrows.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_HADDOCK hide #-}
+{- |
+ Module : Data.GraphViz.Attributes.Arrows
+ Description : Arrow types
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+
+
+ -}
+module Data.GraphViz.Attributes.Arrows where
+
+import Data.GraphViz.Internal.Util (bool)
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
+
+import Data.Maybe (isJust)
+
+-- -----------------------------------------------------------------------------
+
+-- | /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:
+--
+-- The 19 basic arrows shown on the overall attributes page have
+-- been defined below as a convenience. Parsing of the 5
+-- backward-compatible special cases is also supported.
+newtype ArrowType = AType [(ArrowModifier, ArrowShape)]
+ deriving (Eq, Ord, Show, Read)
+
+-- Used for default
+normal :: ArrowType
+normal = AType [(noMods, Normal)]
+
+-- Used for backward-compatible parsing
+eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType
+
+eDiamond = AType [(openMod, Diamond)]
+openArr = AType [(noMods, Vee)]
+halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]
+emptyArr = AType [(openMod, Normal)]
+invEmpty = AType [ (noMods, Inv)
+ , (openMod, Normal)]
+
+instance PrintDot ArrowType where
+ unqtDot (AType mas) = hcat $ mapM appMod mas
+ where
+ appMod (m, a) = unqtDot m <> unqtDot a
+
+instance ParseDot ArrowType where
+ parseUnqt = specialArrowParse
+ `onFail`
+ (AType <$> many1 (liftA2 (,) parseUnqt parseUnqt))
+
+specialArrowParse :: Parse ArrowType
+specialArrowParse = stringValue [ ("ediamond", eDiamond)
+ , ("open", openArr)
+ , ("halfopen", halfOpen)
+ , ("empty", emptyArr)
+ , ("invempty", invEmpty)
+ ]
+
+data ArrowShape = Box
+ | Crow
+ | Diamond
+ | DotArrow
+ | Inv
+ | NoArrow
+ | Normal
+ | Tee
+ | Vee
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot ArrowShape where
+ unqtDot Box = text "box"
+ unqtDot Crow = text "crow"
+ unqtDot Diamond = text "diamond"
+ unqtDot DotArrow = text "dot"
+ unqtDot Inv = text "inv"
+ unqtDot NoArrow = text "none"
+ unqtDot Normal = text "normal"
+ unqtDot Tee = text "tee"
+ unqtDot Vee = text "vee"
+
+instance ParseDot ArrowShape where
+ parseUnqt = stringValue [ ("box", Box)
+ , ("crow", Crow)
+ , ("diamond", Diamond)
+ , ("dot", DotArrow)
+ , ("inv", Inv)
+ , ("none", NoArrow)
+ , ("normal", Normal)
+ , ("tee", Tee)
+ , ("vee", Vee)
+ ]
+
+-- | What modifications to apply to an 'ArrowShape'.
+data ArrowModifier = ArrMod { arrowFill :: ArrowFill
+ , arrowSide :: ArrowSide
+ }
+ deriving (Eq, Ord, Show, Read)
+
+-- | Apply no modifications to an 'ArrowShape'.
+noMods :: ArrowModifier
+noMods = ArrMod FilledArrow BothSides
+
+-- | 'OpenArrow' and 'BothSides'
+openMod :: ArrowModifier
+openMod = ArrMod OpenArrow BothSides
+
+instance PrintDot ArrowModifier where
+ unqtDot (ArrMod f s) = unqtDot f <> unqtDot s
+
+instance ParseDot ArrowModifier where
+ parseUnqt = liftA2 ArrMod parseUnqt parseUnqt
+
+data ArrowFill = OpenArrow
+ | FilledArrow
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot ArrowFill where
+ unqtDot OpenArrow = char 'o'
+ unqtDot FilledArrow = empty
+
+instance ParseDot ArrowFill where
+ parseUnqt = bool FilledArrow OpenArrow . isJust <$> optional (character 'o')
+
+ -- Not used individually
+ parse = parseUnqt
+
+-- | Represents which side (when looking towards the node the arrow is
+-- pointing to) is drawn.
+data ArrowSide = LeftSide
+ | RightSide
+ | BothSides
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot ArrowSide where
+ unqtDot LeftSide = char 'l'
+ unqtDot RightSide = char 'r'
+ unqtDot BothSides = empty
+
+instance ParseDot ArrowSide where
+ parseUnqt = getSideType <$> optional (oneOf $ map character ['l', 'r'])
+ where
+ getSideType = maybe BothSides
+ (bool RightSide LeftSide . (==) 'l')
+
+ -- Not used individually
+ parse = parseUnqt
diff --git a/Data/GraphViz/Attributes/Colors.hs b/Data/GraphViz/Attributes/Colors.hs
--- a/Data/GraphViz/Attributes/Colors.hs
+++ b/Data/GraphViz/Attributes/Colors.hs
@@ -36,27 +36,28 @@
, fromAColour
) where
+import Data.GraphViz.Attributes.Colors.Brewer (BrewerColor (..))
+import Data.GraphViz.Attributes.Colors.SVG (SVGColor, svgColour)
+import Data.GraphViz.Attributes.Colors.X11 (X11Color (Transparent),
+ x11Colour)
+import Data.GraphViz.Attributes.ColorScheme (ColorScheme (..))
+import Data.GraphViz.Exception
+import Data.GraphViz.Internal.State
+import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Parsing
import Data.GraphViz.Printing
-import Data.GraphViz.State
-import Data.GraphViz.Attributes.ColorScheme(ColorScheme(..))
-import Data.GraphViz.Attributes.Colors.X11(X11Color(Transparent), x11Colour)
-import Data.GraphViz.Attributes.Colors.SVG(SVGColor, svgColour)
-import Data.GraphViz.Attributes.Colors.Brewer(BrewerColor(..))
-import Data.GraphViz.Util(bool)
-import Data.GraphViz.Exception
-import Data.Colour( AlphaColour, opaque, withOpacity
- , over, black, alphaChannel, darken)
-import Data.Colour.SRGB(Colour, sRGB, sRGB24, toSRGB24)
-import Data.Colour.RGBSpace(uncurryRGB)
-import Data.Colour.RGBSpace.HSV(hsv)
+import Data.Colour (AlphaColour, alphaChannel, black, darken,
+ opaque, over, withOpacity)
+import Data.Colour.RGBSpace (uncurryRGB)
+import Data.Colour.RGBSpace.HSV (hsv)
+import Data.Colour.SRGB (Colour, sRGB, sRGB24, toSRGB24)
-import Data.Char(isHexDigit)
-import Numeric(showHex, readHex)
-import Data.Maybe(isJust)
-import Data.Word(Word8)
+import Data.Char (isHexDigit)
+import Data.Maybe (isJust)
import qualified Data.Text.Lazy as T
+import Data.Word (Word8)
+import Numeric (readHex, showHex)
-- -----------------------------------------------------------------------------
@@ -130,22 +131,21 @@
fail "Could not parse Color"
where
parseHexBased
- = do character '#'
- cs <- many1 parse2Hex
+ = character '#' *>
+ do cs <- many1 parse2Hex
return $ case cs of
[r,g,b] -> RGB r g b
[r,g,b,a] -> RGBA r g b a
_ -> throw . NotDotCode
$ "Not a valid hex Color specification: "
++ show cs
- parseHSV = HSV <$> parse
+ parseHSV = HSV <$> parseUnqt
<* parseSep
- <*> parse
+ <*> parseUnqt
<* parseSep
- <*> parse
- parseSep = oneOf [ string "," *> whitespace
- , whitespace1
- ]
+ <*> parseUnqt
+ parseSep = character ',' *> whitespace <|> whitespace1
+
parse2Hex = do c1 <- satisfy isHexDigit
c2 <- satisfy isHexDigit
let [(n, [])] = readHex [c1, c2]
@@ -184,7 +184,7 @@
type ColorList = [WeightedColor]
-- | A 'Color' tagged with an optional weighting.
-data WeightedColor = WC { wColor :: Color
+data WeightedColor = WC { wColor :: Color
-- | Must be in range @0 <= W <= 1@.
, weighting :: Maybe Double
}
@@ -226,10 +226,10 @@
failBad $ "Error parsing a ColorList with color scheme of "
++ show cs
- parseList = ((:[]) . toWC <$> parse)
- -- Potentially unquoted un-weighted single color
+ parseList = quotedParse parseUnqtList
`onFail`
- quotedParse parseUnqtList
+ ((:[]) . toWC <$> parse)
+ -- Potentially unquoted un-weighted single color
`onFail`
do cs <- getColorScheme
failBad $ "Error parsing ColorList with color scheme of "
diff --git a/Data/GraphViz/Attributes/Complete.hs b/Data/GraphViz/Attributes/Complete.hs
--- a/Data/GraphViz/Attributes/Complete.hs
+++ b/Data/GraphViz/Attributes/Complete.hs
@@ -42,3192 +42,1554 @@
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. Furthermore,
- the ability to specify an integer prefix for use with the fdp layout
- is /not/ supported.
-
- * The global @Orientation@ attribute is not defined, as it is
- difficult to distinguish from the node-based 'Orientation'
- 'Attribute'; also, its behaviour is duplicated by 'Rotate'.
-
- * The @charset@ attribute is not available, as graphviz only
- supports UTF-8 encoding (as it is not currently feasible nor needed to
- also support Latin1 encoding).
-
- * In Graphviz, when a node or edge has a list of attributes, the
- colorscheme which is used to identify a color can be set /after/
- that color (e.g. @[colorscheme=x11,color=grey,colorscheme=svg]@
- uses the svg colorscheme's definition of grey, which is different
- from the x11 one. Instead, graphviz parses them in order.
-
- -}
-module Data.GraphViz.Attributes.Complete
- ( -- * The actual /Dot/ attributes.
- -- $attributes
- Attribute(..)
- , Attributes
- , sameAttribute
- , defaultAttributeValue
- , rmUnwantedAttributes
- -- ** Validity functions on @Attribute@ values.
- , usedByGraphs
- , usedBySubGraphs
- , usedByClusters
- , usedByNodes
- , usedByEdges
- , validUnknown
-
- -- ** Custom attributes.
- , AttributeName
- , CustomAttribute
- , customAttribute
- , isCustom
- , isSpecifiedCustom
- , customValue
- , customName
- , findCustoms
- , findSpecifiedCustom
- , deleteCustomAttributes
- , deleteSpecifiedCustom
-
- -- * Value types for @Attribute@s.
- , module Data.GraphViz.Attributes.Colors
-
- -- ** Labels
- , EscString
- , Label(..)
- , VerticalPlacement(..)
- , LabelScheme(..)
- , SVGFontNames(..)
- -- *** Types representing the Dot grammar for records.
- , RecordFields
- , RecordField(..)
- , Rect(..)
- , Justification(..)
-
- -- ** Nodes
- , Shape(..)
- , Paths(..)
- , ScaleType(..)
-
- -- ** Edges
- , DirType(..)
- , EdgeType(..)
- -- *** Modifying where edges point
- , PortName(..)
- , PortPos(..)
- , CompassPoint(..)
- -- *** Arrows
- , ArrowType(..)
- , ArrowShape(..)
- , ArrowModifier(..)
- , ArrowFill(..)
- , ArrowSide(..)
- -- **** @ArrowModifier@ values
- , noMods
- , openMod
-
- -- ** Positioning
- , Point(..)
- , createPoint
- , Pos(..)
- , Spline(..)
- , DPoint(..)
-
- -- ** Layout
- , GraphvizCommand(..)
- , GraphSize(..)
- , AspectType(..)
- , ClusterMode(..)
- , Model(..)
- , Overlap(..)
- , Root(..)
- , Order(..)
- , OutputMode(..)
- , Pack(..)
- , PackMode(..)
- , PageDir(..)
- , QuadType(..)
- , RankType(..)
- , RankDir(..)
- , StartType(..)
- , ViewPort(..)
- , FocusType(..)
- , Ratios(..)
-
- -- ** Modes
- , ModeType(..)
- , DEConstraints(..)
-
- -- ** Layers
- , LayerSep(..)
- , LayerListSep(..)
- , LayerRange
- , LayerRangeElem(..)
- , LayerID(..)
- , LayerList(..)
-
- -- ** Stylistic
- , SmoothType(..)
- , STStyle(..)
- , StyleItem(..)
- , StyleName(..)
- ) where
-
-import Data.GraphViz.Attributes.Colors
-import Data.GraphViz.Attributes.Colors.X11(X11Color(Black))
-import qualified Data.GraphViz.Attributes.HTML as Html
-import Data.GraphViz.Attributes.Internal
-import Data.GraphViz.Util
-import Data.GraphViz.Parsing
-import Data.GraphViz.Printing
-import Data.GraphViz.State(getLayerSep, setLayerSep, getLayerListSep, setLayerListSep)
-import Data.GraphViz.Exception(GraphvizException(NotCustomAttr), throw)
-
-import Data.List(partition, intercalate)
-import Data.Maybe(isJust, isNothing)
-import Data.Word(Word16)
-import qualified Data.Set as S
-import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import System.FilePath(searchPathSeparator, splitSearchPath)
-
--- -----------------------------------------------------------------------------
-
-{- $attributes
-
- These attributes have been implemented in a /permissive/ manner:
- that is, rather than split them up based on which type of value
- they are allowed, they have all been included in the one data type,
- with functions to determine if they are indeed valid for what
- they're being applied to.
-
- To interpret the /Valid for/ listings:
-
- [@G@] Valid for Graphs.
-
- [@C@] Valid for Clusters.
-
- [@S@] Valid for Sub-Graphs (and also Clusters).
-
- [@N@] Valid for Nodes.
-
- [@E@] Valid for Edges.
-
- The /Default/ listings are those that the various Graphviz commands
- use if that 'Attribute' isn't specified (in cases where this is
- /none/, this is equivalent to a 'Nothing' value; that is, no value
- is used). The /Parsing Default/ listings represent what value is
- used (i.e. corresponds to 'True') when the 'Attribute' name is
- listed on its own in /Dot/ source code.
-
- Please note that the 'UnknownAttribute' 'Attribute' is defined
- primarily for backwards-compatibility purposes. It is possible to use
- it directly for custom purposes; for more information, please see
- 'CustomAttribute'. The 'deleteCustomAttributes' can be used to delete
- these values.
-
- -}
-
--- | Attributes are used to customise the layout and design of Dot
--- graphs. Care must be taken to ensure that the attribute you use
--- is valid, as not all attributes can be used everywhere.
-data Attribute
- = Damping Double -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only
- | K Double -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only
- | URL EscString -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only
- | Area Double -- ^ /Valid for/: NC; /Default/: @1.0@; /Minimum/: @>0@; /Notes/: patchwork only, requires Graphviz >= 2.30.0
- | ArrowHead ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@
- | ArrowSize Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
- | ArrowTail ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@
- | Aspect AspectType -- ^ /Valid for/: G; /Notes/: dot only
- | BoundingBox Rect -- ^ /Valid for/: G; /Notes/: write only
- | BgColor ColorList -- ^ /Valid for/: GC; /Default/: @[]@
- | Center Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
- | ClusterRank ClusterMode -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only
- | Color ColorList -- ^ /Valid for/: ENC; /Default/: @['WC' ('X11Color' 'Black') Nothing]@
- | ColorScheme ColorScheme -- ^ /Valid for/: ENCG; /Default/: @'X11'@
- | Comment Text -- ^ /Valid for/: ENG; /Default/: @\"\"@
- | Compound Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only
- | Concentrate Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
- | Constraint Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: dot only
- | Decorate Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
- | DefaultDist Double -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(abs(V))@ (unable to statically define); /Minimum/: The value of 'Epsilon'.; /Notes/: neato only, only if @'Pack' 'DontPack'@
- | Dim Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: maximum of @10@; sfdp, fdp, neato only
- | Dimen Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: maximum of @10@; sfdp, fdp, neato only
- | Dir DirType -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)
- | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only
- | Distortion Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
- | DPI Double -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym
- | EdgeURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
- | EdgeTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
- | EdgeTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
- | Epsilon Double -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only
- | ESep DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 3@; /Notes/: not dot
- | FillColor ColorList -- ^ /Valid for/: NEC; /Default/: @['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters)
- | FixedSize 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 SVGFontNames -- ^ /Valid for/: G; /Default/: @'SvgNames'@; /Notes/: svg only
- | FontPath Paths -- ^ /Valid for/: G; /Default/: system dependent
- | FontSize Double -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@
- | ForceLabels Bool -- ^ /Valid for/: G; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: only for 'XLabel' attributes, requires Graphviz >= 2.29.0
- | GradientAngle Int -- ^ /Valid for/: NCG; /Default/: 0; /Notes/: requires Graphviz >= 2.29.0
- | Group Text -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only
- | HeadURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
- | Head_LP Point -- ^ /Valid for/: E; /Notes/: write only, requires Graphviz >= 2.30.0
- | HeadClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
- | HeadLabel Label -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@
- | HeadPort PortPos -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@
- | HeadTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
- | HeadTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
- | Height Double -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@
- | ID EscString -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only
- | Image Text -- ^ /Valid for/: N; /Default/: @\"\"@
- | ImagePath Paths -- ^ /Valid for/: G; /Default/: @'Paths' []@; /Notes/: Printing and parsing is OS-specific, requires Graphviz >= 2.29.0
- | ImageScale ScaleType -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'
- | Label Label -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)
- | LabelURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
- | LabelScheme LabelScheme -- ^ /Valid for/: G; /Default/: @'NotEdgeLabel'@; /Notes/: sfdp only, requires Graphviz >= 2.28.0
- | LabelAngle Double -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@
- | LabelDistance Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
- | LabelFloat Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
- | LabelFontColor Color -- ^ /Valid for/: E; /Default/: @'X11Color' 'Black'@
- | LabelFontName Text -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@
- | LabelFontSize Double -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@
- | LabelJust Justification -- ^ /Valid for/: GC; /Default/: @'JCenter'@
- | LabelLoc VerticalPlacement -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)
- | LabelTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
- | LabelTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
- | Landscape Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
- | Layer LayerRange -- ^ /Valid for/: EN; /Default/: @[]@
- | LayerListSep LayerListSep -- ^ /Valid for/: G; /Default/: @'LLSep' \",\"@; /Notes/: requires Graphviz >= 2.30.0
- | Layers LayerList -- ^ /Valid for/: G; /Default/: @'LL' []@
- | LayerSelect LayerRange -- ^ /Valid for/: G; /Default/: @[]@
- | LayerSep LayerSep -- ^ /Valid for/: G; /Default/: @'LSep' \" :\t\"@
- | Layout GraphvizCommand -- ^ /Valid for/: G
- | Len Double -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only
- | Levels Int -- ^ /Valid for/: G; /Default/: @'maxBound'@; /Minimum/: @0@; /Notes/: sfdp only
- | LevelsGap Double -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only
- | LHead Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
- | LHeight Double -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0
- | LPos Point -- ^ /Valid for/: EGC; /Notes/: write only
- | LTail Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
- | LWidth Double -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0
- | Margin DPoint -- ^ /Valid for/: NG; /Default/: device dependent
- | MaxIter Int -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp); /Notes/: fdp, neato only
- | MCLimit Double -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: dot only
- | MinDist Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: circo only
- | MinLen Int -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: dot only
- | Mode ModeType -- ^ /Valid for/: G; /Default/: @'Major'@; /Notes/: neato only
- | Model Model -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only
- | Mosek Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: neato only; requires the Mosek software
- | NodeSep Double -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@; /Notes/: dot only
- | NoJustify Bool -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True'
- | Normalize Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: not dot
- | Nslimit Double -- ^ /Valid for/: G; /Notes/: dot only
- | Nslimit1 Double -- ^ /Valid for/: G; /Notes/: dot only
- | Ordering Order -- ^ /Valid for/: GN; /Default/: none; /Notes/: dot only
- | Orientation Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@
- | OutputOrder OutputMode -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@
- | Overlap Overlap -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot
- | OverlapScaling Double -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only
- | Pack Pack -- ^ /Valid for/: G; /Default/: @'DontPack'@; /Parsing Default/: 'DoPack'; /Notes/: not dot
- | PackMode PackMode -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot
- | Pad DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)
- | Page Point -- ^ /Valid for/: G
- | PageDir PageDir -- ^ /Valid for/: G; /Default/: @'Bl'@
- | PenColor Color -- ^ /Valid for/: C; /Default/: @'X11Color' 'Black'@
- | PenWidth Double -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@
- | Peripheries Int -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0
- | Pin Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only
- | Pos Pos -- ^ /Valid for/: EN
- | QuadTree QuadType -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only
- | Quantum Double -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@
- | Rank RankType -- ^ /Valid for/: S; /Notes/: dot only
- | RankDir RankDir -- ^ /Valid for/: G; /Default/: @'FromTop'@; /Notes/: dot only
- | RankSep [Double] -- ^ /Valid for/: G; /Default/: @[0.5]@ (dot), @[1.0]@ (twopi); /Minimum/: [0.02]; /Notes/: twopi, dot only
- | Ratio Ratios -- ^ /Valid for/: G
- | Rects [Rect] -- ^ /Valid for/: N; /Notes/: write only
- | Regular Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'
- | ReMinCross Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only
- | RepulsiveForce Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: sfdp only
- | Root Root -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: circo, twopi only
- | Rotate Int -- ^ /Valid for/: G; /Default/: @0@
- | Rotation Double -- ^ /Valid for/: G; /Default/: @0@; /Notes/: sfdp only, requires Graphviz >= 2.28.0
- | SameHead Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
- | SameTail Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
- | SamplePoints Int -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)
- | Scale DPoint -- ^ /Valid for/: G; /Notes/: twopi only, requires Graphviz >= 2.28.0
- | SearchSize Int -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only
- | Sep DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 4@; /Notes/: not dot
- | Shape Shape -- ^ /Valid for/: N; /Default/: @'Ellipse'@
- | ShowBoxes Int -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only; used for debugging by printing PostScript guide boxes
- | Sides Int -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@
- | Size GraphSize -- ^ /Valid for/: G
- | Skew Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
- | Smoothing SmoothType -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only
- | SortV Word16 -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@
- | Splines EdgeType -- ^ /Valid for/: G; /Default/: @'SplineEdges'@ (dot), @'LineEdges'@ (other); /Parsing Default/: 'SplineEdges'
- | Start StartType -- ^ /Valid for/: G; /Default/: @'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed.; /Notes/: fdp, neato only
- | Style [StyleItem] -- ^ /Valid for/: ENC
- | StyleSheet Text -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only
- | TailURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
- | Tail_LP Point -- ^ /Valid for/: E; /Notes/: write only
- | TailClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
- | TailLabel Label -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@
- | TailPort PortPos -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@
- | TailTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
- | TailTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
- | Target EscString -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only
- | Tooltip EscString -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only
- | TrueColor Bool -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only
- | Vertices [Point] -- ^ /Valid for/: N; /Notes/: write only
- | ViewPort ViewPort -- ^ /Valid for/: G; /Default/: none
- | VoroMargin Double -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not dot
- | Weight Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0@ (dot), @1@ (neato,fdp,sfdp)
- | Width Double -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@
- | XLabel Label -- ^ /Valid for/: EN; /Default/: @'StrLabel' \"\"@; /Notes/: requires Graphviz >= 2.29.0
- | XLP Point -- ^ /Valid for/: EN; /Notes/: write only, requires Graphviz >= 2.29.0
- | UnknownAttribute AttributeName Text -- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively.
- deriving (Eq, Ord, Show, Read)
-
-type Attributes = [Attribute]
-
--- | The name for an UnknownAttribute; must satisfy 'validUnknown'.
-type AttributeName = Text
-
-instance PrintDot Attribute where
- unqtDot (Damping v) = printField "Damping" v
- unqtDot (K v) = printField "K" v
- unqtDot (URL v) = printField "URL" v
- unqtDot (Area v) = printField "area" v
- unqtDot (ArrowHead v) = printField "arrowhead" v
- unqtDot (ArrowSize v) = printField "arrowsize" v
- unqtDot (ArrowTail v) = printField "arrowtail" v
- unqtDot (Aspect v) = printField "aspect" v
- unqtDot (BoundingBox v) = printField "bb" v
- unqtDot (BgColor v) = printField "bgcolor" v
- unqtDot (Center v) = printField "center" v
- unqtDot (ClusterRank v) = printField "clusterrank" v
- unqtDot (Color v) = printField "color" v
- unqtDot (ColorScheme v) = printField "colorscheme" v
- unqtDot (Comment v) = printField "comment" v
- unqtDot (Compound v) = printField "compound" v
- unqtDot (Concentrate v) = printField "concentrate" v
- unqtDot (Constraint v) = printField "constraint" v
- unqtDot (Decorate v) = printField "decorate" v
- unqtDot (DefaultDist v) = printField "defaultdist" v
- unqtDot (Dim v) = printField "dim" v
- unqtDot (Dimen v) = printField "dimen" v
- unqtDot (Dir v) = printField "dir" v
- unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v
- unqtDot (Distortion v) = printField "distortion" v
- unqtDot (DPI v) = printField "dpi" v
- unqtDot (EdgeURL v) = printField "edgeURL" v
- unqtDot (EdgeTarget v) = printField "edgetarget" v
- unqtDot (EdgeTooltip v) = printField "edgetooltip" v
- unqtDot (Epsilon v) = printField "epsilon" v
- unqtDot (ESep v) = printField "esep" v
- unqtDot (FillColor v) = printField "fillcolor" v
- unqtDot (FixedSize v) = printField "fixedsize" v
- unqtDot (FontColor v) = printField "fontcolor" v
- unqtDot (FontName v) = printField "fontname" v
- unqtDot (FontNames v) = printField "fontnames" v
- unqtDot (FontPath v) = printField "fontpath" v
- unqtDot (FontSize v) = printField "fontsize" v
- unqtDot (ForceLabels v) = printField "forcelabels" v
- unqtDot (GradientAngle v) = printField "gradientangle" v
- unqtDot (Group v) = printField "group" v
- unqtDot (HeadURL v) = printField "headURL" v
- unqtDot (Head_LP v) = printField "head_lp" v
- unqtDot (HeadClip v) = printField "headclip" v
- unqtDot (HeadLabel v) = printField "headlabel" v
- unqtDot (HeadPort v) = printField "headport" v
- unqtDot (HeadTarget v) = printField "headtarget" v
- unqtDot (HeadTooltip v) = printField "headtooltip" v
- unqtDot (Height v) = printField "height" v
- unqtDot (ID v) = printField "id" v
- unqtDot (Image v) = printField "image" v
- unqtDot (ImagePath v) = printField "imagepath" v
- unqtDot (ImageScale v) = printField "imagescale" v
- unqtDot (Label v) = printField "label" v
- unqtDot (LabelURL v) = printField "labelURL" v
- unqtDot (LabelScheme v) = printField "label_scheme" v
- unqtDot (LabelAngle v) = printField "labelangle" v
- unqtDot (LabelDistance v) = printField "labeldistance" v
- unqtDot (LabelFloat v) = printField "labelfloat" v
- unqtDot (LabelFontColor v) = printField "labelfontcolor" v
- unqtDot (LabelFontName v) = printField "labelfontname" v
- unqtDot (LabelFontSize v) = printField "labelfontsize" v
- unqtDot (LabelJust v) = printField "labeljust" v
- unqtDot (LabelLoc v) = printField "labelloc" v
- unqtDot (LabelTarget v) = printField "labeltarget" v
- unqtDot (LabelTooltip v) = printField "labeltooltip" v
- unqtDot (Landscape v) = printField "landscape" v
- unqtDot (Layer v) = printField "layer" v
- unqtDot (LayerListSep v) = printField "layerlistsep" v
- unqtDot (Layers v) = printField "layers" v
- unqtDot (LayerSelect v) = printField "layerselect" v
- unqtDot (LayerSep v) = printField "layersep" v
- unqtDot (Layout v) = printField "layout" v
- unqtDot (Len v) = printField "len" v
- unqtDot (Levels v) = printField "levels" v
- unqtDot (LevelsGap v) = printField "levelsgap" v
- unqtDot (LHead v) = printField "lhead" v
- unqtDot (LHeight v) = printField "LHeight" v
- unqtDot (LPos v) = printField "lp" v
- unqtDot (LTail v) = printField "ltail" v
- unqtDot (LWidth v) = printField "lwidth" v
- unqtDot (Margin v) = printField "margin" v
- unqtDot (MaxIter v) = printField "maxiter" v
- unqtDot (MCLimit v) = printField "mclimit" v
- unqtDot (MinDist v) = printField "mindist" v
- unqtDot (MinLen v) = printField "minlen" v
- unqtDot (Mode v) = printField "mode" v
- unqtDot (Model v) = printField "model" v
- unqtDot (Mosek v) = printField "mosek" v
- unqtDot (NodeSep v) = printField "nodesep" v
- unqtDot (NoJustify v) = printField "nojustify" v
- unqtDot (Normalize v) = printField "normalize" v
- unqtDot (Nslimit v) = printField "nslimit" v
- unqtDot (Nslimit1 v) = printField "nslimit1" v
- unqtDot (Ordering v) = printField "ordering" v
- unqtDot (Orientation v) = printField "orientation" v
- unqtDot (OutputOrder v) = printField "outputorder" v
- unqtDot (Overlap v) = printField "overlap" v
- unqtDot (OverlapScaling v) = printField "overlap_scaling" v
- unqtDot (Pack v) = printField "pack" v
- unqtDot (PackMode v) = printField "packmode" v
- unqtDot (Pad v) = printField "pad" v
- unqtDot (Page v) = printField "page" v
- unqtDot (PageDir v) = printField "pagedir" v
- unqtDot (PenColor v) = printField "pencolor" v
- unqtDot (PenWidth v) = printField "penwidth" v
- unqtDot (Peripheries v) = printField "peripheries" v
- unqtDot (Pin v) = printField "pin" v
- unqtDot (Pos v) = printField "pos" v
- unqtDot (QuadTree v) = printField "quadtree" v
- unqtDot (Quantum v) = printField "quantum" v
- unqtDot (Rank v) = printField "rank" v
- unqtDot (RankDir v) = printField "rankdir" v
- unqtDot (RankSep v) = printField "ranksep" v
- unqtDot (Ratio v) = printField "ratio" v
- unqtDot (Rects v) = printField "rects" v
- unqtDot (Regular v) = printField "regular" v
- unqtDot (ReMinCross v) = printField "remincross" v
- unqtDot (RepulsiveForce v) = printField "repulsiveforce" v
- unqtDot (Root v) = printField "root" v
- unqtDot (Rotate v) = printField "rotate" v
- unqtDot (Rotation v) = printField "rotation" v
- unqtDot (SameHead v) = printField "samehead" v
- unqtDot (SameTail v) = printField "sametail" v
- unqtDot (SamplePoints v) = printField "samplepoints" v
- unqtDot (Scale v) = printField "scale" v
- unqtDot (SearchSize v) = printField "searchsize" v
- unqtDot (Sep v) = printField "sep" v
- unqtDot (Shape v) = printField "shape" v
- unqtDot (ShowBoxes v) = printField "showboxes" v
- unqtDot (Sides v) = printField "sides" v
- unqtDot (Size v) = printField "size" v
- unqtDot (Skew v) = printField "skew" v
- unqtDot (Smoothing v) = printField "smoothing" v
- unqtDot (SortV v) = printField "sortv" v
- unqtDot (Splines v) = printField "splines" v
- unqtDot (Start v) = printField "start" v
- unqtDot (Style v) = printField "style" v
- unqtDot (StyleSheet v) = printField "stylesheet" v
- unqtDot (TailURL v) = printField "tailURL" v
- unqtDot (Tail_LP v) = printField "tail_lp" v
- unqtDot (TailClip v) = printField "tailclip" v
- unqtDot (TailLabel v) = printField "taillabel" v
- unqtDot (TailPort v) = printField "tailport" v
- unqtDot (TailTarget v) = printField "tailtarget" v
- unqtDot (TailTooltip v) = printField "tailtooltip" v
- unqtDot (Target v) = printField "target" v
- unqtDot (Tooltip v) = printField "tooltip" v
- unqtDot (TrueColor v) = printField "truecolor" v
- unqtDot (Vertices v) = printField "vertices" v
- unqtDot (ViewPort v) = printField "viewport" v
- unqtDot (VoroMargin v) = printField "voro_margin" v
- unqtDot (Weight v) = printField "weight" v
- unqtDot (Width v) = printField "width" v
- unqtDot (XLabel v) = printField "xlabel" v
- unqtDot (XLP v) = printField "xlp" v
- unqtDot (UnknownAttribute a v) = toDot a <> equals <> toDot v
-
- listToDot = unqtListToDot
-
-instance ParseDot Attribute where
- parseUnqt = stringParse (concat [ parseField Damping "Damping"
- , parseField K "K"
- , parseFields URL ["URL", "href"]
- , parseField Area "area"
- , parseField ArrowHead "arrowhead"
- , parseField ArrowSize "arrowsize"
- , parseField ArrowTail "arrowtail"
- , parseField Aspect "aspect"
- , parseField BoundingBox "bb"
- , parseField BgColor "bgcolor"
- , parseFieldBool Center "center"
- , parseField ClusterRank "clusterrank"
- , parseField Color "color"
- , parseField ColorScheme "colorscheme"
- , parseField Comment "comment"
- , parseFieldBool Compound "compound"
- , parseFieldBool Concentrate "concentrate"
- , parseFieldBool Constraint "constraint"
- , parseFieldBool Decorate "decorate"
- , parseField DefaultDist "defaultdist"
- , parseField Dim "dim"
- , parseField Dimen "dimen"
- , parseField Dir "dir"
- , parseFieldDef DirEdgeConstraints EdgeConstraints "diredgeconstraints"
- , parseField Distortion "distortion"
- , parseFields DPI ["dpi", "resolution"]
- , parseFields EdgeURL ["edgeURL", "edgehref"]
- , parseField EdgeTarget "edgetarget"
- , parseField EdgeTooltip "edgetooltip"
- , parseField Epsilon "epsilon"
- , parseField ESep "esep"
- , parseField FillColor "fillcolor"
- , parseFieldBool FixedSize "fixedsize"
- , parseField FontColor "fontcolor"
- , parseField FontName "fontname"
- , parseField FontNames "fontnames"
- , parseField FontPath "fontpath"
- , parseField FontSize "fontsize"
- , parseFieldBool ForceLabels "forcelabels"
- , parseField GradientAngle "gradientangle"
- , parseField Group "group"
- , parseFields HeadURL ["headURL", "headhref"]
- , parseField Head_LP "head_lp"
- , parseFieldBool HeadClip "headclip"
- , parseField HeadLabel "headlabel"
- , parseField HeadPort "headport"
- , parseField HeadTarget "headtarget"
- , parseField HeadTooltip "headtooltip"
- , parseField Height "height"
- , parseField ID "id"
- , parseField Image "image"
- , parseField ImagePath "imagepath"
- , parseFieldDef ImageScale UniformScale "imagescale"
- , parseField Label "label"
- , parseFields LabelURL ["labelURL", "labelhref"]
- , parseField LabelScheme "label_scheme"
- , parseField LabelAngle "labelangle"
- , parseField LabelDistance "labeldistance"
- , parseFieldBool LabelFloat "labelfloat"
- , parseField LabelFontColor "labelfontcolor"
- , parseField LabelFontName "labelfontname"
- , parseField LabelFontSize "labelfontsize"
- , parseField LabelJust "labeljust"
- , parseField LabelLoc "labelloc"
- , parseField LabelTarget "labeltarget"
- , parseField LabelTooltip "labeltooltip"
- , parseFieldBool Landscape "landscape"
- , parseField Layer "layer"
- , parseField LayerListSep "layerlistsep"
- , parseField Layers "layers"
- , parseField LayerSelect "layerselect"
- , parseField LayerSep "layersep"
- , parseField Layout "layout"
- , parseField Len "len"
- , parseField Levels "levels"
- , parseField LevelsGap "levelsgap"
- , parseField LHead "lhead"
- , parseField LHeight "LHeight"
- , parseField LPos "lp"
- , parseField LTail "ltail"
- , parseField LWidth "lwidth"
- , parseField Margin "margin"
- , parseField MaxIter "maxiter"
- , parseField MCLimit "mclimit"
- , parseField MinDist "mindist"
- , parseField MinLen "minlen"
- , parseField Mode "mode"
- , parseField Model "model"
- , parseFieldBool Mosek "mosek"
- , parseField NodeSep "nodesep"
- , parseFieldBool NoJustify "nojustify"
- , parseFieldBool Normalize "normalize"
- , parseField Nslimit "nslimit"
- , parseField Nslimit1 "nslimit1"
- , parseField Ordering "ordering"
- , parseField Orientation "orientation"
- , parseField OutputOrder "outputorder"
- , parseFieldDef Overlap KeepOverlaps "overlap"
- , parseField OverlapScaling "overlap_scaling"
- , parseFieldDef Pack DoPack "pack"
- , parseField PackMode "packmode"
- , parseField Pad "pad"
- , parseField Page "page"
- , parseField PageDir "pagedir"
- , parseField PenColor "pencolor"
- , parseField PenWidth "penwidth"
- , parseField Peripheries "peripheries"
- , parseFieldBool Pin "pin"
- , parseField Pos "pos"
- , parseFieldDef QuadTree NormalQT "quadtree"
- , parseField Quantum "quantum"
- , parseField Rank "rank"
- , parseField RankDir "rankdir"
- , parseField RankSep "ranksep"
- , parseField Ratio "ratio"
- , parseField Rects "rects"
- , parseFieldBool Regular "regular"
- , parseFieldBool ReMinCross "remincross"
- , parseField RepulsiveForce "repulsiveforce"
- , parseFieldDef Root IsCentral "root"
- , parseField Rotate "rotate"
- , parseField Rotation "rotation"
- , parseField SameHead "samehead"
- , parseField SameTail "sametail"
- , parseField SamplePoints "samplepoints"
- , parseField Scale "scale"
- , parseField SearchSize "searchsize"
- , parseField Sep "sep"
- , parseField Shape "shape"
- , parseField ShowBoxes "showboxes"
- , parseField Sides "sides"
- , parseField Size "size"
- , parseField Skew "skew"
- , parseField Smoothing "smoothing"
- , parseField SortV "sortv"
- , parseFieldDef Splines SplineEdges "splines"
- , parseField Start "start"
- , parseField Style "style"
- , parseField StyleSheet "stylesheet"
- , parseFields TailURL ["tailURL", "tailhref"]
- , parseField Tail_LP "tail_lp"
- , parseFieldBool TailClip "tailclip"
- , parseField TailLabel "taillabel"
- , parseField TailPort "tailport"
- , parseField TailTarget "tailtarget"
- , parseField TailTooltip "tailtooltip"
- , parseField Target "target"
- , parseField Tooltip "tooltip"
- , parseFieldBool TrueColor "truecolor"
- , parseField Vertices "vertices"
- , parseField ViewPort "viewport"
- , parseField VoroMargin "voro_margin"
- , parseField Weight "weight"
- , parseField Width "width"
- , parseField XLabel "xlabel"
- , parseField XLP "xlp"
- ])
- `onFail`
- do attrName <- stringBlock
- liftEqParse ("UnknownAttribute (" ++ T.unpack attrName ++ ")")
- (UnknownAttribute attrName)
-
- parse = parseUnqt
-
- parseList = parseUnqtList
-
--- | Determine if this 'Attribute' is valid for use with Graphs.
-usedByGraphs :: Attribute -> Bool
-usedByGraphs Damping{} = True
-usedByGraphs K{} = True
-usedByGraphs URL{} = True
-usedByGraphs Aspect{} = True
-usedByGraphs BoundingBox{} = True
-usedByGraphs BgColor{} = True
-usedByGraphs Center{} = True
-usedByGraphs ClusterRank{} = True
-usedByGraphs ColorScheme{} = True
-usedByGraphs Comment{} = True
-usedByGraphs Compound{} = True
-usedByGraphs Concentrate{} = True
-usedByGraphs DefaultDist{} = True
-usedByGraphs Dim{} = True
-usedByGraphs Dimen{} = True
-usedByGraphs DirEdgeConstraints{} = True
-usedByGraphs DPI{} = True
-usedByGraphs Epsilon{} = True
-usedByGraphs ESep{} = True
-usedByGraphs FontColor{} = True
-usedByGraphs FontName{} = True
-usedByGraphs FontNames{} = True
-usedByGraphs FontPath{} = True
-usedByGraphs FontSize{} = True
-usedByGraphs ForceLabels{} = True
-usedByGraphs GradientAngle{} = True
-usedByGraphs ID{} = True
-usedByGraphs ImagePath{} = True
-usedByGraphs Label{} = True
-usedByGraphs LabelScheme{} = True
-usedByGraphs LabelJust{} = True
-usedByGraphs LabelLoc{} = True
-usedByGraphs Landscape{} = True
-usedByGraphs LayerListSep{} = True
-usedByGraphs Layers{} = True
-usedByGraphs LayerSelect{} = True
-usedByGraphs LayerSep{} = True
-usedByGraphs Layout{} = True
-usedByGraphs Levels{} = True
-usedByGraphs LevelsGap{} = True
-usedByGraphs LHeight{} = True
-usedByGraphs LPos{} = True
-usedByGraphs LWidth{} = True
-usedByGraphs Margin{} = True
-usedByGraphs MaxIter{} = True
-usedByGraphs MCLimit{} = True
-usedByGraphs MinDist{} = True
-usedByGraphs Mode{} = True
-usedByGraphs Model{} = True
-usedByGraphs Mosek{} = True
-usedByGraphs NodeSep{} = True
-usedByGraphs NoJustify{} = True
-usedByGraphs Normalize{} = True
-usedByGraphs Nslimit{} = True
-usedByGraphs Nslimit1{} = True
-usedByGraphs Ordering{} = True
-usedByGraphs OutputOrder{} = True
-usedByGraphs Overlap{} = True
-usedByGraphs OverlapScaling{} = True
-usedByGraphs Pack{} = True
-usedByGraphs PackMode{} = True
-usedByGraphs Pad{} = True
-usedByGraphs Page{} = True
-usedByGraphs PageDir{} = True
-usedByGraphs QuadTree{} = True
-usedByGraphs Quantum{} = True
-usedByGraphs RankDir{} = True
-usedByGraphs RankSep{} = True
-usedByGraphs Ratio{} = True
-usedByGraphs ReMinCross{} = True
-usedByGraphs RepulsiveForce{} = True
-usedByGraphs Root{} = True
-usedByGraphs Rotate{} = True
-usedByGraphs Rotation{} = True
-usedByGraphs Scale{} = True
-usedByGraphs SearchSize{} = True
-usedByGraphs Sep{} = True
-usedByGraphs ShowBoxes{} = True
-usedByGraphs Size{} = True
-usedByGraphs Smoothing{} = True
-usedByGraphs SortV{} = True
-usedByGraphs Splines{} = True
-usedByGraphs Start{} = True
-usedByGraphs StyleSheet{} = True
-usedByGraphs Target{} = True
-usedByGraphs TrueColor{} = True
-usedByGraphs ViewPort{} = True
-usedByGraphs VoroMargin{} = True
-usedByGraphs UnknownAttribute{} = True
-usedByGraphs _ = False
-
--- | Determine if this 'Attribute' is valid for use with Clusters.
-usedByClusters :: Attribute -> Bool
-usedByClusters K{} = True
-usedByClusters URL{} = True
-usedByClusters Area{} = True
-usedByClusters BgColor{} = True
-usedByClusters Color{} = True
-usedByClusters ColorScheme{} = True
-usedByClusters FillColor{} = True
-usedByClusters FontColor{} = True
-usedByClusters FontName{} = True
-usedByClusters FontSize{} = True
-usedByClusters GradientAngle{} = True
-usedByClusters Label{} = True
-usedByClusters LabelJust{} = True
-usedByClusters LabelLoc{} = True
-usedByClusters LHeight{} = True
-usedByClusters LPos{} = True
-usedByClusters LWidth{} = True
-usedByClusters NoJustify{} = True
-usedByClusters PenColor{} = True
-usedByClusters PenWidth{} = True
-usedByClusters Peripheries{} = True
-usedByClusters Rank{} = True
-usedByClusters SortV{} = True
-usedByClusters Style{} = True
-usedByClusters Target{} = True
-usedByClusters Tooltip{} = True
-usedByClusters UnknownAttribute{} = True
-usedByClusters _ = False
-
--- | Determine if this 'Attribute' is valid for use with SubGraphs.
-usedBySubGraphs :: Attribute -> Bool
-usedBySubGraphs Rank{} = True
-usedBySubGraphs UnknownAttribute{} = True
-usedBySubGraphs _ = False
-
--- | Determine if this 'Attribute' is valid for use with Nodes.
-usedByNodes :: Attribute -> Bool
-usedByNodes URL{} = True
-usedByNodes Area{} = True
-usedByNodes Color{} = True
-usedByNodes ColorScheme{} = True
-usedByNodes Comment{} = True
-usedByNodes Distortion{} = True
-usedByNodes FillColor{} = True
-usedByNodes FixedSize{} = True
-usedByNodes FontColor{} = True
-usedByNodes FontName{} = True
-usedByNodes FontSize{} = True
-usedByNodes GradientAngle{} = True
-usedByNodes Group{} = True
-usedByNodes Height{} = True
-usedByNodes ID{} = True
-usedByNodes Image{} = True
-usedByNodes ImageScale{} = True
-usedByNodes Label{} = True
-usedByNodes LabelLoc{} = True
-usedByNodes Layer{} = True
-usedByNodes Margin{} = True
-usedByNodes NoJustify{} = True
-usedByNodes Ordering{} = True
-usedByNodes Orientation{} = True
-usedByNodes PenWidth{} = True
-usedByNodes Peripheries{} = True
-usedByNodes Pin{} = True
-usedByNodes Pos{} = True
-usedByNodes Rects{} = True
-usedByNodes Regular{} = True
-usedByNodes Root{} = True
-usedByNodes SamplePoints{} = True
-usedByNodes Shape{} = True
-usedByNodes ShowBoxes{} = True
-usedByNodes Sides{} = True
-usedByNodes Skew{} = True
-usedByNodes SortV{} = True
-usedByNodes Style{} = True
-usedByNodes Target{} = True
-usedByNodes Tooltip{} = True
-usedByNodes Vertices{} = True
-usedByNodes Width{} = True
-usedByNodes XLabel{} = True
-usedByNodes XLP{} = True
-usedByNodes UnknownAttribute{} = True
-usedByNodes _ = False
-
--- | Determine if this 'Attribute' is valid for use with Edges.
-usedByEdges :: Attribute -> Bool
-usedByEdges URL{} = True
-usedByEdges ArrowHead{} = True
-usedByEdges ArrowSize{} = True
-usedByEdges ArrowTail{} = True
-usedByEdges Color{} = True
-usedByEdges ColorScheme{} = True
-usedByEdges Comment{} = True
-usedByEdges Constraint{} = True
-usedByEdges Decorate{} = True
-usedByEdges Dir{} = True
-usedByEdges EdgeURL{} = True
-usedByEdges EdgeTarget{} = True
-usedByEdges EdgeTooltip{} = True
-usedByEdges FillColor{} = True
-usedByEdges FontColor{} = True
-usedByEdges FontName{} = True
-usedByEdges FontSize{} = True
-usedByEdges HeadURL{} = True
-usedByEdges Head_LP{} = True
-usedByEdges HeadClip{} = True
-usedByEdges HeadLabel{} = True
-usedByEdges HeadPort{} = True
-usedByEdges HeadTarget{} = True
-usedByEdges HeadTooltip{} = True
-usedByEdges ID{} = True
-usedByEdges Label{} = True
-usedByEdges LabelURL{} = True
-usedByEdges LabelAngle{} = True
-usedByEdges LabelDistance{} = True
-usedByEdges LabelFloat{} = True
-usedByEdges LabelFontColor{} = True
-usedByEdges LabelFontName{} = True
-usedByEdges LabelFontSize{} = True
-usedByEdges LabelTarget{} = True
-usedByEdges LabelTooltip{} = True
-usedByEdges Layer{} = True
-usedByEdges Len{} = True
-usedByEdges LHead{} = True
-usedByEdges LPos{} = True
-usedByEdges LTail{} = True
-usedByEdges MinLen{} = True
-usedByEdges NoJustify{} = True
-usedByEdges PenWidth{} = True
-usedByEdges Pos{} = True
-usedByEdges SameHead{} = True
-usedByEdges SameTail{} = True
-usedByEdges ShowBoxes{} = True
-usedByEdges Style{} = True
-usedByEdges TailURL{} = True
-usedByEdges Tail_LP{} = True
-usedByEdges TailClip{} = True
-usedByEdges TailLabel{} = True
-usedByEdges TailPort{} = True
-usedByEdges TailTarget{} = True
-usedByEdges TailTooltip{} = True
-usedByEdges Target{} = True
-usedByEdges Tooltip{} = True
-usedByEdges Weight{} = True
-usedByEdges XLabel{} = True
-usedByEdges XLP{} = True
-usedByEdges UnknownAttribute{} = True
-usedByEdges _ = False
-
--- | Determine if two 'Attributes' are the same type of 'Attribute'.
-sameAttribute :: Attribute -> Attribute -> Bool
-sameAttribute Damping{} Damping{} = True
-sameAttribute K{} K{} = True
-sameAttribute URL{} URL{} = True
-sameAttribute Area{} Area{} = True
-sameAttribute ArrowHead{} ArrowHead{} = True
-sameAttribute ArrowSize{} ArrowSize{} = True
-sameAttribute ArrowTail{} ArrowTail{} = True
-sameAttribute Aspect{} Aspect{} = True
-sameAttribute BoundingBox{} BoundingBox{} = True
-sameAttribute BgColor{} BgColor{} = True
-sameAttribute Center{} Center{} = True
-sameAttribute ClusterRank{} ClusterRank{} = True
-sameAttribute Color{} Color{} = True
-sameAttribute ColorScheme{} ColorScheme{} = True
-sameAttribute Comment{} Comment{} = True
-sameAttribute Compound{} Compound{} = True
-sameAttribute Concentrate{} Concentrate{} = True
-sameAttribute Constraint{} Constraint{} = True
-sameAttribute Decorate{} Decorate{} = True
-sameAttribute DefaultDist{} DefaultDist{} = True
-sameAttribute Dim{} Dim{} = True
-sameAttribute Dimen{} Dimen{} = True
-sameAttribute Dir{} Dir{} = True
-sameAttribute DirEdgeConstraints{} DirEdgeConstraints{} = True
-sameAttribute Distortion{} Distortion{} = True
-sameAttribute DPI{} DPI{} = True
-sameAttribute EdgeURL{} EdgeURL{} = True
-sameAttribute EdgeTarget{} EdgeTarget{} = True
-sameAttribute EdgeTooltip{} EdgeTooltip{} = True
-sameAttribute Epsilon{} Epsilon{} = True
-sameAttribute ESep{} ESep{} = True
-sameAttribute FillColor{} FillColor{} = True
-sameAttribute FixedSize{} FixedSize{} = True
-sameAttribute FontColor{} FontColor{} = True
-sameAttribute FontName{} FontName{} = True
-sameAttribute FontNames{} FontNames{} = True
-sameAttribute FontPath{} FontPath{} = True
-sameAttribute FontSize{} FontSize{} = True
-sameAttribute ForceLabels{} ForceLabels{} = True
-sameAttribute GradientAngle{} GradientAngle{} = True
-sameAttribute Group{} Group{} = True
-sameAttribute HeadURL{} HeadURL{} = True
-sameAttribute Head_LP{} Head_LP{} = True
-sameAttribute HeadClip{} HeadClip{} = True
-sameAttribute HeadLabel{} HeadLabel{} = True
-sameAttribute HeadPort{} HeadPort{} = True
-sameAttribute HeadTarget{} HeadTarget{} = True
-sameAttribute HeadTooltip{} HeadTooltip{} = True
-sameAttribute Height{} Height{} = True
-sameAttribute ID{} ID{} = True
-sameAttribute Image{} Image{} = True
-sameAttribute ImagePath{} ImagePath{} = True
-sameAttribute ImageScale{} ImageScale{} = True
-sameAttribute Label{} Label{} = True
-sameAttribute LabelURL{} LabelURL{} = True
-sameAttribute LabelScheme{} LabelScheme{} = True
-sameAttribute LabelAngle{} LabelAngle{} = True
-sameAttribute LabelDistance{} LabelDistance{} = True
-sameAttribute LabelFloat{} LabelFloat{} = True
-sameAttribute LabelFontColor{} LabelFontColor{} = True
-sameAttribute LabelFontName{} LabelFontName{} = True
-sameAttribute LabelFontSize{} LabelFontSize{} = True
-sameAttribute LabelJust{} LabelJust{} = True
-sameAttribute LabelLoc{} LabelLoc{} = True
-sameAttribute LabelTarget{} LabelTarget{} = True
-sameAttribute LabelTooltip{} LabelTooltip{} = True
-sameAttribute Landscape{} Landscape{} = True
-sameAttribute Layer{} Layer{} = True
-sameAttribute LayerListSep{} LayerListSep{} = True
-sameAttribute Layers{} Layers{} = True
-sameAttribute LayerSelect{} LayerSelect{} = True
-sameAttribute LayerSep{} LayerSep{} = True
-sameAttribute Layout{} Layout{} = True
-sameAttribute Len{} Len{} = True
-sameAttribute Levels{} Levels{} = True
-sameAttribute LevelsGap{} LevelsGap{} = True
-sameAttribute LHead{} LHead{} = True
-sameAttribute LHeight{} LHeight{} = True
-sameAttribute LPos{} LPos{} = True
-sameAttribute LTail{} LTail{} = True
-sameAttribute LWidth{} LWidth{} = True
-sameAttribute Margin{} Margin{} = True
-sameAttribute MaxIter{} MaxIter{} = True
-sameAttribute MCLimit{} MCLimit{} = True
-sameAttribute MinDist{} MinDist{} = True
-sameAttribute MinLen{} MinLen{} = True
-sameAttribute Mode{} Mode{} = True
-sameAttribute Model{} Model{} = True
-sameAttribute Mosek{} Mosek{} = True
-sameAttribute NodeSep{} NodeSep{} = True
-sameAttribute NoJustify{} NoJustify{} = True
-sameAttribute Normalize{} Normalize{} = True
-sameAttribute Nslimit{} Nslimit{} = True
-sameAttribute Nslimit1{} Nslimit1{} = True
-sameAttribute Ordering{} Ordering{} = True
-sameAttribute Orientation{} Orientation{} = True
-sameAttribute OutputOrder{} OutputOrder{} = True
-sameAttribute Overlap{} Overlap{} = True
-sameAttribute OverlapScaling{} OverlapScaling{} = True
-sameAttribute Pack{} Pack{} = True
-sameAttribute PackMode{} PackMode{} = True
-sameAttribute Pad{} Pad{} = True
-sameAttribute Page{} Page{} = True
-sameAttribute PageDir{} PageDir{} = True
-sameAttribute PenColor{} PenColor{} = True
-sameAttribute PenWidth{} PenWidth{} = True
-sameAttribute Peripheries{} Peripheries{} = True
-sameAttribute Pin{} Pin{} = True
-sameAttribute Pos{} Pos{} = True
-sameAttribute QuadTree{} QuadTree{} = True
-sameAttribute Quantum{} Quantum{} = True
-sameAttribute Rank{} Rank{} = True
-sameAttribute RankDir{} RankDir{} = True
-sameAttribute RankSep{} RankSep{} = True
-sameAttribute Ratio{} Ratio{} = True
-sameAttribute Rects{} Rects{} = True
-sameAttribute Regular{} Regular{} = True
-sameAttribute ReMinCross{} ReMinCross{} = True
-sameAttribute RepulsiveForce{} RepulsiveForce{} = True
-sameAttribute Root{} Root{} = True
-sameAttribute Rotate{} Rotate{} = True
-sameAttribute Rotation{} Rotation{} = True
-sameAttribute SameHead{} SameHead{} = True
-sameAttribute SameTail{} SameTail{} = True
-sameAttribute SamplePoints{} SamplePoints{} = True
-sameAttribute Scale{} Scale{} = True
-sameAttribute SearchSize{} SearchSize{} = True
-sameAttribute Sep{} Sep{} = True
-sameAttribute Shape{} Shape{} = True
-sameAttribute ShowBoxes{} ShowBoxes{} = True
-sameAttribute Sides{} Sides{} = True
-sameAttribute Size{} Size{} = True
-sameAttribute Skew{} Skew{} = True
-sameAttribute Smoothing{} Smoothing{} = True
-sameAttribute SortV{} SortV{} = True
-sameAttribute Splines{} Splines{} = True
-sameAttribute Start{} Start{} = True
-sameAttribute Style{} Style{} = True
-sameAttribute StyleSheet{} StyleSheet{} = True
-sameAttribute TailURL{} TailURL{} = True
-sameAttribute Tail_LP{} Tail_LP{} = True
-sameAttribute TailClip{} TailClip{} = True
-sameAttribute TailLabel{} TailLabel{} = True
-sameAttribute TailPort{} TailPort{} = True
-sameAttribute TailTarget{} TailTarget{} = True
-sameAttribute TailTooltip{} TailTooltip{} = True
-sameAttribute Target{} Target{} = True
-sameAttribute Tooltip{} Tooltip{} = True
-sameAttribute TrueColor{} TrueColor{} = True
-sameAttribute Vertices{} Vertices{} = True
-sameAttribute ViewPort{} ViewPort{} = True
-sameAttribute VoroMargin{} VoroMargin{} = True
-sameAttribute Weight{} Weight{} = True
-sameAttribute Width{} Width{} = True
-sameAttribute XLabel{} XLabel{} = True
-sameAttribute XLP{} XLP{} = True
-sameAttribute (UnknownAttribute a1 _) (UnknownAttribute a2 _) = a1 == a2
-sameAttribute _ _ = False
-
--- | Return the default value for a specific 'Attribute' if possible; graph/cluster values are preferred over node/edge values.
-defaultAttributeValue :: Attribute -> Maybe Attribute
-defaultAttributeValue Damping{} = Just $ Damping 0.99
-defaultAttributeValue K{} = Just $ K 0.3
-defaultAttributeValue URL{} = Just $ URL ""
-defaultAttributeValue Area{} = Just $ Area 1.0
-defaultAttributeValue ArrowHead{} = Just $ ArrowHead normal
-defaultAttributeValue ArrowSize{} = Just $ ArrowSize 1.0
-defaultAttributeValue ArrowTail{} = Just $ ArrowTail normal
-defaultAttributeValue BgColor{} = Just $ BgColor []
-defaultAttributeValue Center{} = Just $ Center False
-defaultAttributeValue ClusterRank{} = Just $ ClusterRank Local
-defaultAttributeValue Color{} = Just $ Color [toWColor Black]
-defaultAttributeValue ColorScheme{} = Just $ ColorScheme X11
-defaultAttributeValue Comment{} = Just $ Comment ""
-defaultAttributeValue Compound{} = Just $ Compound False
-defaultAttributeValue Concentrate{} = Just $ Concentrate False
-defaultAttributeValue Constraint{} = Just $ Constraint True
-defaultAttributeValue Decorate{} = Just $ Decorate False
-defaultAttributeValue Dim{} = Just $ Dim 2
-defaultAttributeValue Dimen{} = Just $ Dimen 2
-defaultAttributeValue DirEdgeConstraints{} = Just $ DirEdgeConstraints NoConstraints
-defaultAttributeValue Distortion{} = Just $ Distortion 0.0
-defaultAttributeValue DPI{} = Just $ DPI 96.0
-defaultAttributeValue EdgeURL{} = Just $ EdgeURL ""
-defaultAttributeValue EdgeTooltip{} = Just $ EdgeTooltip ""
-defaultAttributeValue ESep{} = Just $ ESep (DVal 3)
-defaultAttributeValue FillColor{} = Just $ FillColor [toWColor Black]
-defaultAttributeValue FixedSize{} = Just $ FixedSize False
-defaultAttributeValue FontColor{} = Just $ FontColor (X11Color Black)
-defaultAttributeValue FontName{} = Just $ FontName "Times-Roman"
-defaultAttributeValue FontNames{} = Just $ FontNames SvgNames
-defaultAttributeValue FontSize{} = Just $ FontSize 14.0
-defaultAttributeValue ForceLabels{} = Just $ ForceLabels True
-defaultAttributeValue GradientAngle{} = Just $ GradientAngle 0
-defaultAttributeValue Group{} = Just $ Group ""
-defaultAttributeValue HeadURL{} = Just $ HeadURL ""
-defaultAttributeValue HeadClip{} = Just $ HeadClip True
-defaultAttributeValue HeadLabel{} = Just $ HeadLabel (StrLabel "")
-defaultAttributeValue HeadPort{} = Just $ HeadPort (CompassPoint CenterPoint)
-defaultAttributeValue HeadTarget{} = Just $ HeadTarget ""
-defaultAttributeValue HeadTooltip{} = Just $ HeadTooltip ""
-defaultAttributeValue Height{} = Just $ Height 0.5
-defaultAttributeValue ID{} = Just $ ID ""
-defaultAttributeValue Image{} = Just $ Image ""
-defaultAttributeValue ImagePath{} = Just $ ImagePath (Paths [])
-defaultAttributeValue ImageScale{} = Just $ ImageScale NoScale
-defaultAttributeValue Label{} = Just $ Label (StrLabel "")
-defaultAttributeValue LabelURL{} = Just $ LabelURL ""
-defaultAttributeValue LabelScheme{} = Just $ LabelScheme NotEdgeLabel
-defaultAttributeValue LabelAngle{} = Just $ LabelAngle (-25.0)
-defaultAttributeValue LabelDistance{} = Just $ LabelDistance 1.0
-defaultAttributeValue LabelFloat{} = Just $ LabelFloat False
-defaultAttributeValue LabelFontColor{} = Just $ LabelFontColor (X11Color Black)
-defaultAttributeValue LabelFontName{} = Just $ LabelFontName "Times-Roman"
-defaultAttributeValue LabelFontSize{} = Just $ LabelFontSize 14.0
-defaultAttributeValue LabelJust{} = Just $ LabelJust JCenter
-defaultAttributeValue LabelLoc{} = Just $ LabelLoc VTop
-defaultAttributeValue LabelTarget{} = Just $ LabelTarget ""
-defaultAttributeValue LabelTooltip{} = Just $ LabelTooltip ""
-defaultAttributeValue Landscape{} = Just $ Landscape False
-defaultAttributeValue Layer{} = Just $ Layer []
-defaultAttributeValue LayerListSep{} = Just $ LayerListSep (LLSep ",")
-defaultAttributeValue Layers{} = Just $ Layers (LL [])
-defaultAttributeValue LayerSelect{} = Just $ LayerSelect []
-defaultAttributeValue LayerSep{} = Just $ LayerSep (LSep " :\t")
-defaultAttributeValue Levels{} = Just $ Levels maxBound
-defaultAttributeValue LevelsGap{} = Just $ LevelsGap 0.0
-defaultAttributeValue LHead{} = Just $ LHead ""
-defaultAttributeValue LTail{} = Just $ LTail ""
-defaultAttributeValue MCLimit{} = Just $ MCLimit 1.0
-defaultAttributeValue MinDist{} = Just $ MinDist 1.0
-defaultAttributeValue MinLen{} = Just $ MinLen 1
-defaultAttributeValue Mode{} = Just $ Mode Major
-defaultAttributeValue Model{} = Just $ Model ShortPath
-defaultAttributeValue Mosek{} = Just $ Mosek False
-defaultAttributeValue NodeSep{} = Just $ NodeSep 0.25
-defaultAttributeValue NoJustify{} = Just $ NoJustify False
-defaultAttributeValue Normalize{} = Just $ Normalize False
-defaultAttributeValue Orientation{} = Just $ Orientation 0.0
-defaultAttributeValue OutputOrder{} = Just $ OutputOrder BreadthFirst
-defaultAttributeValue Overlap{} = Just $ Overlap KeepOverlaps
-defaultAttributeValue OverlapScaling{} = Just $ OverlapScaling (-4)
-defaultAttributeValue Pack{} = Just $ Pack DontPack
-defaultAttributeValue PackMode{} = Just $ PackMode PackNode
-defaultAttributeValue Pad{} = Just $ Pad (DVal 0.0555)
-defaultAttributeValue PageDir{} = Just $ PageDir Bl
-defaultAttributeValue PenColor{} = Just $ PenColor (X11Color Black)
-defaultAttributeValue PenWidth{} = Just $ PenWidth 1.0
-defaultAttributeValue Peripheries{} = Just $ Peripheries 1
-defaultAttributeValue Pin{} = Just $ Pin False
-defaultAttributeValue QuadTree{} = Just $ QuadTree NormalQT
-defaultAttributeValue Quantum{} = Just $ Quantum 0
-defaultAttributeValue RankDir{} = Just $ RankDir FromTop
-defaultAttributeValue Regular{} = Just $ Regular False
-defaultAttributeValue ReMinCross{} = Just $ ReMinCross False
-defaultAttributeValue RepulsiveForce{} = Just $ RepulsiveForce 1.0
-defaultAttributeValue Root{} = Just $ Root (NodeName "")
-defaultAttributeValue Rotate{} = Just $ Rotate 0
-defaultAttributeValue Rotation{} = Just $ Rotation 0
-defaultAttributeValue SameHead{} = Just $ SameHead ""
-defaultAttributeValue SameTail{} = Just $ SameTail ""
-defaultAttributeValue SearchSize{} = Just $ SearchSize 30
-defaultAttributeValue Sep{} = Just $ Sep (DVal 4)
-defaultAttributeValue Shape{} = Just $ Shape Ellipse
-defaultAttributeValue ShowBoxes{} = Just $ ShowBoxes 0
-defaultAttributeValue Sides{} = Just $ Sides 4
-defaultAttributeValue Skew{} = Just $ Skew 0.0
-defaultAttributeValue Smoothing{} = Just $ Smoothing NoSmooth
-defaultAttributeValue SortV{} = Just $ SortV 0
-defaultAttributeValue StyleSheet{} = Just $ StyleSheet ""
-defaultAttributeValue TailURL{} = Just $ TailURL ""
-defaultAttributeValue TailClip{} = Just $ TailClip True
-defaultAttributeValue TailLabel{} = Just $ TailLabel (StrLabel "")
-defaultAttributeValue TailPort{} = Just $ TailPort (CompassPoint CenterPoint)
-defaultAttributeValue TailTarget{} = Just $ TailTarget ""
-defaultAttributeValue TailTooltip{} = Just $ TailTooltip ""
-defaultAttributeValue Target{} = Just $ Target ""
-defaultAttributeValue Tooltip{} = Just $ Tooltip ""
-defaultAttributeValue VoroMargin{} = Just $ VoroMargin 0.05
-defaultAttributeValue Weight{} = Just $ Weight 1.0
-defaultAttributeValue Width{} = Just $ Width 0.75
-defaultAttributeValue XLabel{} = Just $ XLabel (StrLabel "")
-defaultAttributeValue _ = Nothing
-
--- | Determine if the provided 'Text' value is a valid name for an 'UnknownAttribute'.
-validUnknown :: AttributeName -> Bool
-validUnknown txt = T.toLower txt `S.notMember` names
- && isIDString txt
- where
- names = (S.fromList . map T.toLower
- $ [ "Damping"
- , "K"
- , "URL"
- , "href"
- , "area"
- , "arrowhead"
- , "arrowsize"
- , "arrowtail"
- , "aspect"
- , "bb"
- , "bgcolor"
- , "center"
- , "clusterrank"
- , "color"
- , "colorscheme"
- , "comment"
- , "compound"
- , "concentrate"
- , "constraint"
- , "decorate"
- , "defaultdist"
- , "dim"
- , "dimen"
- , "dir"
- , "diredgeconstraints"
- , "distortion"
- , "dpi"
- , "resolution"
- , "edgeURL"
- , "edgehref"
- , "edgetarget"
- , "edgetooltip"
- , "epsilon"
- , "esep"
- , "fillcolor"
- , "fixedsize"
- , "fontcolor"
- , "fontname"
- , "fontnames"
- , "fontpath"
- , "fontsize"
- , "forcelabels"
- , "gradientangle"
- , "group"
- , "headURL"
- , "headhref"
- , "head_lp"
- , "headclip"
- , "headlabel"
- , "headport"
- , "headtarget"
- , "headtooltip"
- , "height"
- , "id"
- , "image"
- , "imagepath"
- , "imagescale"
- , "label"
- , "labelURL"
- , "labelhref"
- , "label_scheme"
- , "labelangle"
- , "labeldistance"
- , "labelfloat"
- , "labelfontcolor"
- , "labelfontname"
- , "labelfontsize"
- , "labeljust"
- , "labelloc"
- , "labeltarget"
- , "labeltooltip"
- , "landscape"
- , "layer"
- , "layerlistsep"
- , "layers"
- , "layerselect"
- , "layersep"
- , "layout"
- , "len"
- , "levels"
- , "levelsgap"
- , "lhead"
- , "LHeight"
- , "lp"
- , "ltail"
- , "lwidth"
- , "margin"
- , "maxiter"
- , "mclimit"
- , "mindist"
- , "minlen"
- , "mode"
- , "model"
- , "mosek"
- , "nodesep"
- , "nojustify"
- , "normalize"
- , "nslimit"
- , "nslimit1"
- , "ordering"
- , "orientation"
- , "outputorder"
- , "overlap"
- , "overlap_scaling"
- , "pack"
- , "packmode"
- , "pad"
- , "page"
- , "pagedir"
- , "pencolor"
- , "penwidth"
- , "peripheries"
- , "pin"
- , "pos"
- , "quadtree"
- , "quantum"
- , "rank"
- , "rankdir"
- , "ranksep"
- , "ratio"
- , "rects"
- , "regular"
- , "remincross"
- , "repulsiveforce"
- , "root"
- , "rotate"
- , "rotation"
- , "samehead"
- , "sametail"
- , "samplepoints"
- , "scale"
- , "searchsize"
- , "sep"
- , "shape"
- , "showboxes"
- , "sides"
- , "size"
- , "skew"
- , "smoothing"
- , "sortv"
- , "splines"
- , "start"
- , "style"
- , "stylesheet"
- , "tailURL"
- , "tailhref"
- , "tail_lp"
- , "tailclip"
- , "taillabel"
- , "tailport"
- , "tailtarget"
- , "tailtooltip"
- , "target"
- , "tooltip"
- , "truecolor"
- , "vertices"
- , "viewport"
- , "voro_margin"
- , "weight"
- , "width"
- , "xlabel"
- , "xlp"
- , "charset" -- Defined upstream, just not used here.
- ])
- `S.union`
- keywords
-{- Delete to here -}
-
--- | Remove attributes that we don't want to consider:
---
--- * Those that are defaults
--- * colorscheme (as the colors embed it anyway)
-rmUnwantedAttributes :: Attributes -> Attributes
-rmUnwantedAttributes = filter (not . (`any` tests) . flip ($))
- where
- tests = [isDefault, isColorScheme]
-
- isDefault a = maybe False (a==) $ defaultAttributeValue a
-
- isColorScheme ColorScheme{} = True
- isColorScheme _ = False
-
--- -----------------------------------------------------------------------------
--- These parsing combinators are defined here for customisation purposes.
-
-parseField :: (ParseDot a) => (a -> Attribute) -> String
- -> [(String, Parse Attribute)]
-parseField c fld = [(fld, liftEqParse fld c)]
-
-parseFields :: (ParseDot a) => (a -> Attribute) -> [String]
- -> [(String, Parse Attribute)]
-parseFields c = concatMap (parseField c)
-
-parseFieldBool :: (Bool -> Attribute) -> String -> [(String, Parse Attribute)]
-parseFieldBool = (`parseFieldDef` True)
-
--- | For 'Bool'-like data structures where the presence of the field
--- name without a value implies a default value.
-parseFieldDef :: (ParseDot a) => (a -> Attribute) -> a -> String
- -> [(String, Parse Attribute)]
-parseFieldDef c d fld = [(fld, p)]
- where
- p = liftEqParse fld c
- `onFail`
- do nxt <- optional $ satisfy restIDString
- bool (fail "Not actually the field you were after")
- (return $ c d)
- (isNothing nxt)
-
--- | Attempt to parse the @\"=value\"@ part of a @key=value@ pair. If
--- there is an equal sign but the @value@ part doesn't parse, throw
--- an un-recoverable error.
-liftEqParse :: (ParseDot a) => String -> (a -> Attribute) -> Parse Attribute
-liftEqParse k c = parseEq
- *> ( hasDef (fmap c parse)
- `adjustErrBad`
- (("Unable to parse key=value with key of " ++ k
- ++ "\n\t") ++)
- )
- where
- hasDef p = maybe p (onFail p . (`stringRep` "\"\""))
- . defaultAttributeValue $ c undefined
-
--- -----------------------------------------------------------------------------
-
-{- | If performing any custom pre-/post-processing on Dot code, you
- may wish to utilise some custom 'Attributes'. These are wrappers
- around the 'UnknownAttribute' constructor (and thus 'CustomAttribute'
- is just an alias for 'Attribute').
-
- You should ensure that 'validUnknown' is 'True' for any potential
- custom attribute name.
-
--}
-type CustomAttribute = Attribute
-
--- | Create a custom attribute.
-customAttribute :: AttributeName -> Text -> CustomAttribute
-customAttribute = UnknownAttribute
-
--- | Determines whether or not this is a custom attribute.
-isCustom :: Attribute -> Bool
-isCustom UnknownAttribute{} = True
-isCustom _ = False
-
-isSpecifiedCustom :: AttributeName -> Attribute -> Bool
-isSpecifiedCustom nm (UnknownAttribute nm' _) = nm == nm'
-isSpecifiedCustom _ _ = False
-
--- | The value of a custom attribute. Will throw a
--- 'GraphvizException' if the provided 'Attribute' isn't a custom
--- one.
-customValue :: CustomAttribute -> Text
-customValue (UnknownAttribute _ v) = v
-customValue attr = throw . NotCustomAttr . T.unpack
- $ printIt attr
-
--- | The name of a custom attribute. Will throw a
--- 'GraphvizException' if the provided 'Attribute' isn't a custom
--- one.
-customName :: CustomAttribute -> AttributeName
-customName (UnknownAttribute nm _) = nm
-customName attr = throw . NotCustomAttr . T.unpack
- $ printIt attr
-
--- | Returns all custom attributes and the list of non-custom Attributes.
-findCustoms :: Attributes -> ([CustomAttribute], Attributes)
-findCustoms = partition isCustom
-
--- | Find the (first instance of the) specified custom attribute and
--- returns it along with all other Attributes.
-findSpecifiedCustom :: AttributeName -> Attributes
- -> Maybe (CustomAttribute, Attributes)
-findSpecifiedCustom nm attrs
- = case break (isSpecifiedCustom nm) attrs of
- (bf,cust:aft) -> Just (cust, bf ++ aft)
- _ -> Nothing
-
--- | Delete all custom attributes (actually, this will delete all
--- 'UnknownAttribute' values; as such it can also be used to remove
--- legacy attributes).
-deleteCustomAttributes :: Attributes -> Attributes
-deleteCustomAttributes = filter (not . isCustom)
-
--- | Removes all instances of the specified custom attribute.
-deleteSpecifiedCustom :: AttributeName -> Attributes -> Attributes
-deleteSpecifiedCustom nm = filter (not . isSpecifiedCustom nm)
-
--- -----------------------------------------------------------------------------
-
--- | The available Graphviz commands. The following directions are
--- based upon those in the Graphviz man page (available online at
--- , or if installed on your
--- system @man graphviz@). Note that any command can be used on
--- both directed and undirected graphs.
---
--- When used with the 'Layout' attribute, it overrides any actual
--- command called on the dot graph.
-data GraphvizCommand = Dot -- ^ For hierachical graphs (ideal for
- -- directed graphs).
- | Neato -- ^ For symmetric layouts of graphs
- -- (ideal for undirected graphs).
- | TwoPi -- ^ For radial layout of graphs.
- | Circo -- ^ For circular layout of graphs.
- | Fdp -- ^ Spring-model approach for
- -- undirected graphs.
- | Sfdp -- ^ As with Fdp, but ideal for large
- -- graphs.
- | Osage -- ^ Filter for drawing clustered graphs,
- -- requires Graphviz >= 2.28.0.
- | Patchwork -- ^ Draw clustered graphs as treemaps,
- -- requires Graphviz >= 2.28.0.
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot GraphvizCommand where
- unqtDot Dot = text "dot"
- unqtDot Neato = text "neato"
- unqtDot TwoPi = text "twopi"
- unqtDot Circo = text "circo"
- unqtDot Fdp = text "fdp"
- unqtDot Sfdp = text "sfdp"
- unqtDot Osage = text "osage"
- unqtDot Patchwork = text "patchwork"
-
-instance ParseDot GraphvizCommand where
- parseUnqt = stringValue [ ("dot", Dot)
- , ("neato", Neato)
- , ("twopi", TwoPi)
- , ("circo", Circo)
- , ("fdp", Fdp)
- , ("sfdp", Sfdp)
- , ("osage", Osage)
- , ("patchwork", Patchwork)
- ]
-
--- -----------------------------------------------------------------------------
-
-{- |
-
- 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:
---
--- The 19 basic arrows shown on the overall attributes page have
--- been defined below as a convenience. Parsing of the 5
--- backward-compatible special cases is also supported.
-newtype ArrowType = AType [(ArrowModifier, ArrowShape)]
- deriving (Eq, Ord, Show, Read)
-
--- Used for default
-normal :: ArrowType
-normal = AType [(noMods, Normal)]
-
--- Used for backward-compatible parsing
-eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType
-
-eDiamond = AType [(openMod, Diamond)]
-openArr = AType [(noMods, Vee)]
-halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]
-emptyArr = AType [(openMod, Normal)]
-invEmpty = AType [ (noMods, Inv)
- , (openMod, Normal)]
-
-instance PrintDot ArrowType where
- unqtDot (AType mas) = hcat $ mapM appMod mas
- where
- appMod (m, a) = unqtDot m <> unqtDot a
-
-instance ParseDot ArrowType where
- parseUnqt = specialArrowParse
- `onFail`
- (AType <$> many1 (liftA2 (,) parseUnqt parseUnqt))
-
-specialArrowParse :: Parse ArrowType
-specialArrowParse = stringValue [ ("ediamond", eDiamond)
- , ("open", openArr)
- , ("halfopen", halfOpen)
- , ("empty", emptyArr)
- , ("invempty", invEmpty)
- ]
-
-data ArrowShape = Box
- | Crow
- | Diamond
- | DotArrow
- | Inv
- | NoArrow
- | Normal
- | Tee
- | Vee
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot ArrowShape where
- unqtDot Box = text "box"
- unqtDot Crow = text "crow"
- unqtDot Diamond = text "diamond"
- unqtDot DotArrow = text "dot"
- unqtDot Inv = text "inv"
- unqtDot NoArrow = text "none"
- unqtDot Normal = text "normal"
- unqtDot Tee = text "tee"
- unqtDot Vee = text "vee"
-
-instance ParseDot ArrowShape where
- parseUnqt = stringValue [ ("box", Box)
- , ("crow", Crow)
- , ("diamond", Diamond)
- , ("dot", DotArrow)
- , ("inv", Inv)
- , ("none", NoArrow)
- , ("normal", Normal)
- , ("tee", Tee)
- , ("vee", Vee)
- ]
-
--- | What modifications to apply to an 'ArrowShape'.
-data ArrowModifier = ArrMod { arrowFill :: ArrowFill
- , arrowSide :: ArrowSide
- }
- deriving (Eq, Ord, Show, Read)
-
--- | Apply no modifications to an 'ArrowShape'.
-noMods :: ArrowModifier
-noMods = ArrMod FilledArrow BothSides
-
--- | 'OpenArrow' and 'BothSides'
-openMod :: ArrowModifier
-openMod = ArrMod OpenArrow BothSides
-
-instance PrintDot ArrowModifier where
- unqtDot (ArrMod f s) = unqtDot f <> unqtDot s
-
-instance ParseDot ArrowModifier where
- parseUnqt = liftA2 ArrMod parseUnqt parseUnqt
-
-data ArrowFill = OpenArrow
- | FilledArrow
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot ArrowFill where
- unqtDot OpenArrow = char 'o'
- unqtDot FilledArrow = empty
-
-instance ParseDot ArrowFill where
- parseUnqt = bool FilledArrow OpenArrow . isJust <$> optional (character 'o')
-
- -- Not used individually
- parse = parseUnqt
-
--- | Represents which side (when looking towards the node the arrow is
--- pointing to) is drawn.
-data ArrowSide = LeftSide
- | RightSide
- | BothSides
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot ArrowSide where
- unqtDot LeftSide = char 'l'
- unqtDot RightSide = char 'r'
- unqtDot BothSides = empty
-
-instance ParseDot ArrowSide where
- parseUnqt = getSideType <$> optional (oneOf $ map character ['l', 'r'])
- where
- getSideType = maybe BothSides
- (bool RightSide LeftSide . (==) 'l')
-
- -- Not used individually
- parse = parseUnqt
-
--- -----------------------------------------------------------------------------
-
-data AspectType = RatioOnly Double
- | RatioPassCount Double Int
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot AspectType where
- unqtDot (RatioOnly r) = unqtDot r
- unqtDot (RatioPassCount r p) = commaDel r p
-
- toDot at@RatioOnly{} = unqtDot at
- toDot at@RatioPassCount{} = dquotes $ unqtDot at
-
-instance ParseDot AspectType where
- parseUnqt = fmap (uncurry RatioPassCount) commaSepUnqt
- `onFail`
- fmap RatioOnly parseUnqt
-
-
- parse = quotedParse (uncurry RatioPassCount <$> commaSepUnqt)
- `onFail`
- fmap RatioOnly parse
-
--- -----------------------------------------------------------------------------
-
--- | Should only have 2D points (i.e. created with 'createPoint').
-data Rect = Rect Point Point
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Rect where
- unqtDot (Rect p1 p2) = printPoint2DUnqt p1 <> comma <> printPoint2DUnqt p2
-
- toDot = dquotes . unqtDot
-
- unqtListToDot = hsep . mapM unqtDot
-
-instance ParseDot Rect where
- parseUnqt = uncurry Rect <$> commaSep' parsePoint2D parsePoint2D
-
- parse = quotedParse parseUnqt
-
- parseUnqtList = sepBy1 parseUnqt whitespace1
-
--- -----------------------------------------------------------------------------
-
--- | If 'Local', then sub-graphs that are clusters are given special
--- treatment. 'Global' and 'NoCluster' currently appear to be
--- identical and turn off the special cluster processing.
-data ClusterMode = Local
- | Global
- | NoCluster
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot ClusterMode where
- unqtDot Local = text "local"
- unqtDot Global = text "global"
- unqtDot NoCluster = text "none"
-
-instance ParseDot ClusterMode where
- parseUnqt = oneOf [ stringRep Local "local"
- , stringRep Global "global"
- , stringRep NoCluster "none"
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Specify where to place arrow heads on an edge.
-data DirType = Forward -- ^ Draw a directed edge with an arrow to the
- -- node it's pointing go.
- | Back -- ^ Draw a reverse directed edge with an arrow
- -- to the node it's coming from.
- | Both -- ^ Draw arrows on both ends of the edge.
- | NoDir -- ^ Draw an undirected edge.
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot DirType where
- unqtDot Forward = text "forward"
- unqtDot Back = text "back"
- unqtDot Both = text "both"
- unqtDot NoDir = text "none"
-
-instance ParseDot DirType where
- parseUnqt = oneOf [ stringRep Forward "forward"
- , stringRep Back "back"
- , stringRep Both "both"
- , stringRep NoDir "none"
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Only when @mode == 'IpSep'@.
-data DEConstraints = EdgeConstraints
- | NoConstraints
- | HierConstraints
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot DEConstraints where
- unqtDot EdgeConstraints = unqtDot True
- unqtDot NoConstraints = unqtDot False
- unqtDot HierConstraints = text "hier"
-
-instance ParseDot DEConstraints where
- parseUnqt = fmap (bool NoConstraints EdgeConstraints) parse
- `onFail`
- stringRep HierConstraints "hier"
-
--- -----------------------------------------------------------------------------
-
--- | Either a 'Double' or a (2D) 'Point' (i.e. created with
--- 'createPoint').
---
--- Whilst it is possible to create a 'Point' value with either a
--- third co-ordinate or a forced position, these are ignored for
--- printing/parsing.
---
--- An optional prefix of @\'+\'@ is allowed when parsing.
-data DPoint = DVal Double
- | PVal Point
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot DPoint where
- unqtDot (DVal d) = unqtDot d
- unqtDot (PVal p) = printPoint2DUnqt p
-
- toDot (DVal d) = toDot d
- toDot (PVal p) = printPoint2D p
-
-instance ParseDot DPoint where
- parseUnqt = optional (character '+')
- *> oneOf [ PVal <$> parsePoint2D
- , DVal <$> parseUnqt
- ]
-
- parse = quotedParse parseUnqt -- A `+' would need to be quoted.
- `onFail`
- fmap DVal parseUnqt
-
--- -----------------------------------------------------------------------------
-
--- | The mapping used for 'FontName' values in SVG output.
---
--- More information can be found at .
-data SVGFontNames = SvgNames -- ^ Use the legal generic SVG font names.
- | PostScriptNames -- ^ Use PostScript font names.
- | FontConfigNames -- ^ Use fontconfig font conventions.
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot SVGFontNames where
- unqtDot SvgNames = text "svg"
- unqtDot PostScriptNames = text "ps"
- unqtDot FontConfigNames = text "gd"
-
-instance ParseDot SVGFontNames where
- parseUnqt = oneOf [ stringRep SvgNames "svg"
- , stringRep PostScriptNames "ps"
- , stringRep FontConfigNames "gd"
- ]
-
- parse = stringRep SvgNames "\"\""
- `onFail`
- optionalQuoted parseUnqt
-
--- -----------------------------------------------------------------------------
-
--- | Maximum width and height of drawing in inches.
-data GraphSize = GSize { width :: Double
- -- | If @Nothing@, then the height is the
- -- same as the width.
- , height :: Maybe Double
- -- | If drawing is smaller than specified
- -- size, this value determines whether it
- -- is scaled up.
- , desiredSize :: Bool
- }
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot GraphSize where
- unqtDot (GSize w mh ds) = bool id (<> char '!') ds
- . maybe id (\h -> (<> unqtDot h) . (<> comma)) mh
- $ unqtDot w
-
- toDot (GSize w Nothing False) = toDot w
- toDot gs = dquotes $ unqtDot gs
-
-instance ParseDot GraphSize where
- parseUnqt = GSize <$> parseUnqt
- <*> optional (parseComma *> whitespace *> parseUnqt)
- <*> (isJust <$> optional (character '!'))
-
- parse = quotedParse parseUnqt
- `onFail`
- fmap (\ w -> GSize w Nothing False) 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
- | MDS
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot Model where
- unqtDot ShortPath = text "shortpath"
- unqtDot SubSet = text "subset"
- unqtDot Circuit = text "circuit"
- unqtDot MDS = text "mds"
-
-instance ParseDot Model where
- parseUnqt = oneOf [ stringRep ShortPath "shortpath"
- , stringRep SubSet "subset"
- , stringRep Circuit "circuit"
- , stringRep MDS "mds"
- ]
-
--- -----------------------------------------------------------------------------
-
-data Label = StrLabel EscString
- | HtmlLabel Html.Label -- ^ If 'PlainText' is used, the
- -- 'Html.Label' value is the entire
- -- \"shape\"; if anything else
- -- except 'PointShape' is used then
- -- the 'Html.Label' is embedded
- -- within the shape.
- | RecordLabel RecordFields -- ^ For nodes only; requires
- -- either 'Record' or
- -- 'MRecord' as the shape.
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Label where
- unqtDot (StrLabel s) = unqtDot s
- unqtDot (HtmlLabel h) = angled $ unqtDot h
- unqtDot (RecordLabel fs) = unqtDot fs
-
- toDot (StrLabel s) = toDot s
- toDot h@HtmlLabel{} = unqtDot h
- toDot (RecordLabel fs) = toDot fs
-
-instance ParseDot Label where
- -- Don't have to worry about being able to tell the difference
- -- between an HtmlLabel and a RecordLabel starting with a PortPos,
- -- since the latter will be in quotes and the former won't.
-
- parseUnqt = oneOf [ HtmlLabel <$> parseAngled parseUnqt
- , RecordLabel <$> parseUnqt
- , StrLabel <$> parseUnqt
- ]
-
- parse = oneOf [ HtmlLabel <$> parseAngled parse
- , RecordLabel <$> parse
- , StrLabel <$> parse
- ]
-
--- -----------------------------------------------------------------------------
-
--- | A RecordFields value should never be empty.
-type RecordFields = [RecordField]
-
--- | Specifies the sub-values of a record-based label. By default,
--- the cells are laid out horizontally; use 'FlipFields' to change
--- the orientation of the fields (can be applied recursively). To
--- change the default orientation, use 'RankDir'.
-data RecordField = LabelledTarget PortName EscString
- | PortName PortName -- ^ Will result in no label for
- -- that cell.
- | FieldLabel EscString
- | FlipFields RecordFields
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot RecordField where
- -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.
- unqtDot (LabelledTarget t s) = printPortName t <+> unqtRecordString s
- unqtDot (PortName t) = printPortName t
- unqtDot (FieldLabel s) = unqtRecordString s
- unqtDot (FlipFields rs) = braces $ unqtDot rs
-
- toDot (FieldLabel s) = printEscaped recordEscChars s
- toDot rf = dquotes $ unqtDot rf
-
- unqtListToDot [f] = unqtDot f
- unqtListToDot fs = hcat . punctuate (char '|') $ mapM unqtDot fs
-
- listToDot [f] = toDot f
- listToDot fs = dquotes $ unqtListToDot fs
-
-instance ParseDot RecordField where
- parseUnqt = (liftA2 maybe PortName LabelledTarget
- <$> (PN <$> parseAngled parseRecord)
- <*> optional (whitespace1 *> parseRecord)
- )
- `onFail`
- fmap FieldLabel parseRecord
- `onFail`
- fmap FlipFields (parseBraced parseUnqt)
- `onFail`
- fail "Unable to parse RecordField"
-
- parse = quotedParse parseUnqt
-
- parseUnqtList = wrapWhitespace $ sepBy1 parseUnqt (wrapWhitespace $ character '|')
-
- -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it
- -- will cause parsing problems for other 'Label' types.
- parseList = do rfs <- quotedParse parseUnqtList
- if validRFs rfs
- then return rfs
- else fail "This is a StrLabel, not a RecordLabel"
- where
- validRFs [FieldLabel str] = T.any (`elem` recordEscChars) str
- validRFs _ = True
-
--- | Print a 'PortName' value as expected within a Record data
--- structure.
-printPortName :: PortName -> DotCode
-printPortName = angled . unqtRecordString . portName
-
-parseRecord :: Parse Text
-parseRecord = parseEscaped False recordEscChars []
-
-unqtRecordString :: Text -> DotCode
-unqtRecordString = unqtEscaped recordEscChars
-
-recordEscChars :: [Char]
-recordEscChars = ['{', '}', '|', ' ', '<', '>']
-
--- -----------------------------------------------------------------------------
-
--- | How to treat a node whose name is of the form \"@|edgelabel|*@\"
--- as a special node representing an edge label.
-data LabelScheme = NotEdgeLabel -- ^ No effect
- | CloseToCenter -- ^ Make node close to center of neighbor
- | CloseToOldCenter -- ^ Make node close to old center of neighbor
- | RemoveAndStraighten -- ^ Use a two-step process.
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot LabelScheme where
- unqtDot NotEdgeLabel = int 0
- unqtDot CloseToCenter = int 1
- unqtDot CloseToOldCenter = int 2
- unqtDot RemoveAndStraighten = int 3
-
-instance ParseDot LabelScheme where
- -- Use string-based parsing rather than parsing an integer just to make it easier
- parseUnqt = stringValue [ ("0", NotEdgeLabel)
- , ("1", CloseToCenter)
- , ("2", CloseToOldCenter)
- , ("3", RemoveAndStraighten)
- ]
-
--- -----------------------------------------------------------------------------
-
-data Point = Point { xCoord :: Double
- , yCoord :: Double
- -- | Can only be 'Just' for @'Dim' 3@ or greater.
- , zCoord :: Maybe Double
- -- | Input to Graphviz only: specify that the
- -- node position should not change.
- , forcePos :: Bool
- }
- deriving (Eq, Ord, Show, Read)
-
--- | Create a point with only @x@ and @y@ values.
-createPoint :: Double -> Double -> Point
-createPoint x y = Point x y Nothing False
-
-printPoint2DUnqt :: Point -> DotCode
-printPoint2DUnqt p = commaDel (xCoord p) (yCoord p)
-
-printPoint2D :: Point -> DotCode
-printPoint2D = dquotes . printPoint2DUnqt
-
-parsePoint2D :: Parse Point
-parsePoint2D = uncurry createPoint <$> commaSepUnqt
-
-instance PrintDot Point where
- unqtDot (Point x y mz frs) = bool id (<> char '!') frs
- . maybe id (\ z -> (<> unqtDot z) . (<> comma)) mz
- $ commaDel x y
-
- toDot = dquotes . unqtDot
-
- unqtListToDot = hsep . mapM unqtDot
-
- listToDot = dquotes . unqtListToDot
-
-instance ParseDot Point where
- parseUnqt = uncurry Point
- <$> commaSepUnqt
- <*> optional (parseComma *> parseUnqt)
- <*> (isJust <$> optional (character '!'))
-
- parse = quotedParse parseUnqt
-
- parseUnqtList = sepBy1 parseUnqt whitespace1
-
--- -----------------------------------------------------------------------------
-
--- | How to deal with node overlaps.
---
--- Defaults to 'KeepOverlaps' /except/ for fdp and sfdp.
---
--- The ability to specify the number of tries for fdp's initial
--- force-directed technique is /not/ supported (by default, fdp uses
--- @9@ passes of its in-built technique, and then @'PrismOverlap'
--- Nothing@).
---
--- For sfdp, the default is @'PrismOverlap' (Just 0)@.
-data Overlap = KeepOverlaps
- | ScaleOverlaps -- ^ Remove overlaps by uniformly scaling in x and y.
- | ScaleXYOverlaps -- ^ Remove overlaps by separately scaling x and y.
- | PrismOverlap (Maybe Word16) -- ^ Requires the Prism
- -- library to be
- -- available (if not,
- -- this is equivalent to
- -- 'VoronoiOverlap'). @'Nothing'@
- -- is equivalent to
- -- @'Just' 1000@.
- -- Influenced by
- -- 'OverlapScaling'.
- | VoronoiOverlap -- ^ Requires Graphviz >= 2.30.0.
- | CompressOverlap -- ^ Scale layout down as much as
- -- possible without introducing
- -- overlaps, assuming none to begin
- -- with.
- | VpscOverlap -- ^ Uses quadratic optimization to
- -- minimize node displacement.
- | IpsepOverlap -- ^ Only when @mode == 'IpSep'@
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Overlap where
- unqtDot KeepOverlaps = unqtDot True
- unqtDot ScaleOverlaps = text "scale"
- unqtDot ScaleXYOverlaps = text "scalexy"
- unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism"
- unqtDot VoronoiOverlap = text "voronoi"
- unqtDot CompressOverlap = text "compress"
- unqtDot VpscOverlap = text "vpsc"
- unqtDot IpsepOverlap = text "ipsep"
-
--- | Note that @overlap=false@ defaults to @'PrismOverlap' Nothing@,
--- but if the Prism library isn't available then it is equivalent to
--- 'VoronoiOverlap'.
-instance ParseDot Overlap where
- parseUnqt = oneOf [ stringRep KeepOverlaps "true"
- , stringRep ScaleXYOverlaps "scalexy"
- , stringRep ScaleOverlaps "scale"
- , string "prism" *> fmap PrismOverlap (optional parse)
- , stringRep (PrismOverlap Nothing) "false"
- , stringRep VoronoiOverlap "voronoi"
- , stringRep CompressOverlap "compress"
- , stringRep VpscOverlap "vpsc"
- , stringRep IpsepOverlap "ipsep"
- ]
-
--- -----------------------------------------------------------------------------
-
-newtype LayerSep = LSep Text
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot LayerSep where
- unqtDot (LSep ls) = setLayerSep (T.unpack ls) *> unqtDot ls
-
- toDot (LSep ls) = setLayerSep (T.unpack ls) *> toDot ls
-
-instance ParseDot LayerSep where
- parseUnqt = do ls <- parseUnqt
- setLayerSep $ T.unpack ls
- return $ LSep ls
-
- parse = do ls <- parse
- setLayerSep $ T.unpack ls
- return $ LSep ls
-
-newtype LayerListSep = LLSep Text
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot LayerListSep where
- unqtDot (LLSep ls) = setLayerListSep (T.unpack ls) *> unqtDot ls
-
- toDot (LLSep ls) = setLayerListSep (T.unpack ls) *> toDot ls
-
-instance ParseDot LayerListSep where
- parseUnqt = do ls <- parseUnqt
- setLayerListSep $ T.unpack ls
- return $ LLSep ls
-
- parse = do ls <- parse
- setLayerListSep $ T.unpack ls
- return $ LLSep ls
-
-type LayerRange = [LayerRangeElem]
-
-data LayerRangeElem = LRID LayerID
- | LRS LayerID LayerID
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot LayerRangeElem where
- unqtDot (LRID lid) = unqtDot lid
- unqtDot (LRS id1 id2) = do ls <- getLayerSep
- let s = unqtDot $ head ls
- unqtDot id1 <> s <> unqtDot id2
-
- toDot (LRID lid) = toDot lid
- toDot lrs = dquotes $ unqtDot lrs
-
- unqtListToDot lr = do lls <- getLayerListSep
- let s = unqtDot $ head lls
- hcat . punctuate s $ mapM unqtDot lr
-
- listToDot [lre] = toDot lre
- listToDot lrs = dquotes $ unqtListToDot lrs
-
-instance ParseDot LayerRangeElem where
- parseUnqt = ignoreSep LRS parseUnqt parseLayerSep parseUnqt
- `onFail`
- fmap LRID parseUnqt
-
- parse = quotedParse (ignoreSep LRS parseUnqt parseLayerSep parseUnqt)
- `onFail`
- fmap LRID parse
-
- parseUnqtList = sepBy parseUnqt parseLayerListSep
-
- parseList = quotedParse parseUnqtList
- `onFail`
- fmap ((:[]) . LRID) parse
-
-parseLayerSep :: Parse ()
-parseLayerSep = do ls <- getLayerSep
- many1Satisfy (`elem` ls) *> return ()
-
-parseLayerName :: Parse Text
-parseLayerName = parseEscaped False [] =<< liftA2 (++) getLayerSep getLayerListSep
-
-parseLayerName' :: Parse Text
-parseLayerName' = stringBlock
- `onFail`
- quotedParse parseLayerName
-
-parseLayerListSep :: Parse ()
-parseLayerListSep = do lls <- getLayerListSep
- many1Satisfy (`elem` lls) *> return ()
-
--- | You should not have any layer separator characters for the
--- 'LRName' option, as they won't be parseable.
-data LayerID = AllLayers
- | LRInt Int
- | LRName Text -- ^ Should not be a number or @"all"@.
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot LayerID where
- unqtDot AllLayers = text "all"
- unqtDot (LRInt n) = unqtDot n
- unqtDot (LRName nm) = unqtDot nm
-
- toDot (LRName nm) = toDot nm
- -- Other two don't need quotes
- toDot li = unqtDot li
-
- unqtListToDot ll = do ls <- getLayerSep
- let s = unqtDot $ head ls
- hcat . punctuate s $ mapM unqtDot ll
-
- listToDot [l] = toDot l
- -- Might not need quotes, but probably will. Can't tell either
- -- way since we don't know what the separator character will be.
- listToDot ll = dquotes $ unqtDot ll
-
-instance ParseDot LayerID where
- parseUnqt = checkLayerName <$> parseLayerName -- tests for Int and All
-
- parse = oneOf [ checkLayerName <$> parseLayerName'
- , LRInt <$> parse -- Mainly for unquoted case.
- ]
-
-checkLayerName :: Text -> LayerID
-checkLayerName str = maybe checkAll LRInt $ stringToInt str
- where
- checkAll = if T.toLower str == "all"
- then AllLayers
- else LRName str
-
--- Remember: this /must/ be a newtype as we can't use arbitrary
--- LayerID values!
-
--- | A list of layer names. The names should all be unique 'LRName'
--- values, and when printed will use an arbitrary character from
--- 'defLayerSep'. The values in the list are implicitly numbered
--- @1, 2, ...@.
-newtype LayerList = LL [LayerID]
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot LayerList where
- unqtDot (LL ll) = unqtDot ll
-
- toDot (LL ll) = toDot ll
-
-instance ParseDot LayerList where
- parseUnqt = LL <$> sepBy1 parseUnqt parseLayerSep
-
- parse = quotedParse parseUnqt
- `onFail`
- fmap (LL . (:[]) . LRName) stringBlock
- `onFail`
- quotedParse (stringRep (LL []) "")
-
--- -----------------------------------------------------------------------------
-
-data Order = OutEdges -- ^ Draw outgoing edges in order specified.
- | InEdges -- ^ Draw incoming edges in order specified.
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot Order where
- unqtDot OutEdges = text "out"
- unqtDot InEdges = text "in"
-
-instance ParseDot Order where
- parseUnqt = oneOf [ stringRep OutEdges "out"
- , stringRep InEdges "in"
- ]
-
--- -----------------------------------------------------------------------------
-
-data OutputMode = BreadthFirst | NodesFirst | EdgesFirst
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot OutputMode where
- unqtDot BreadthFirst = text "breadthfirst"
- unqtDot NodesFirst = text "nodesfirst"
- unqtDot EdgesFirst = text "edgesfirst"
-
-instance ParseDot OutputMode where
- parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"
- , stringRep NodesFirst "nodesfirst"
- , stringRep EdgesFirst "edgesfirst"
- ]
-
--- -----------------------------------------------------------------------------
-
-data Pack = DoPack
- | DontPack
- | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Pack where
- unqtDot DoPack = unqtDot True
- unqtDot DontPack = unqtDot False
- unqtDot (PackMargin m) = unqtDot m
-
-instance ParseDot Pack where
- -- What happens if it parses 0? It's non-negative, but parses as False
- parseUnqt = oneOf [ PackMargin <$> parseUnqt
- , bool DontPack DoPack <$> onlyBool
- ]
-
--- -----------------------------------------------------------------------------
-
-data PackMode = PackNode
- | PackClust
- | PackGraph
- | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort
- -- by user, number of
- -- rows/cols
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot PackMode where
- unqtDot PackNode = text "node"
- unqtDot PackClust = text "clust"
- unqtDot PackGraph = text "graph"
- unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder
- $ text "array"
- where
- addNum = maybe id (flip (<>) . unqtDot) mi
- isUnder = if c || u
- then (<> char '_')
- else id
- isC = if c
- then (<> char 'c')
- else id
- isU = if u
- then (<> char 'u')
- else id
-
-instance ParseDot PackMode where
- parseUnqt = oneOf [ stringRep PackNode "node"
- , stringRep PackClust "clust"
- , stringRep PackGraph "graph"
- , do string "array"
- mcu <- optional $ character '_' *> many1 (satisfy isCU)
- let c = hasCharacter mcu 'c'
- u = hasCharacter mcu 'u'
- mi <- optional parseUnqt
- return $ PackArray c u mi
- ]
- where
- hasCharacter ms c = maybe False (elem c) ms
- -- Also checks and removes quote characters
- isCU = (`elem` ['c', 'u'])
-
--- -----------------------------------------------------------------------------
-
-data Pos = PointPos Point
- | SplinePos [Spline]
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Pos where
- unqtDot (PointPos p) = unqtDot p
- unqtDot (SplinePos ss) = unqtDot ss
-
- toDot (PointPos p) = toDot p
- toDot (SplinePos ss) = toDot ss
-
-instance ParseDot Pos where
- -- Have to be careful with this: if we try to parse points first,
- -- then a spline with no start and end points will erroneously get
- -- parsed as a point and then the parser will crash as it expects a
- -- closing quote character...
- parseUnqt = do splns <- parseUnqt
- case splns of
- [Spline Nothing Nothing [p]] -> return $ PointPos p
- _ -> return $ SplinePos splns
-
- parse = quotedParse parseUnqt
-
--- -----------------------------------------------------------------------------
-
--- | Controls how (and if) edges are represented.
---
--- For @dot@, the default is 'SplineEdges'; for all other layouts
--- the default is 'LineEdges'.
-data EdgeType = SplineEdges -- ^ Except for dot, requires
- -- non-overlapping nodes (see
- -- 'Overlap').
- | LineEdges
- | NoEdges
- | PolyLine
- | Ortho -- ^ Does not handle ports or edge labels in dot.
- | Curved -- ^ Requires Graphviz >= 2.30.0.
- | CompoundEdge -- ^ fdp only
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot EdgeType where
- unqtDot SplineEdges = text "spline"
- unqtDot LineEdges = text "line"
- unqtDot NoEdges = empty
- unqtDot PolyLine = text "polyline"
- unqtDot Ortho = text "ortho"
- unqtDot Curved = text "curved"
- unqtDot CompoundEdge = text "compound"
-
- toDot NoEdges = dquotes empty
- toDot et = unqtDot et
-
-instance ParseDot EdgeType where
- -- Can't parse NoEdges without quotes.
- parseUnqt = oneOf [ bool LineEdges SplineEdges <$> parse
- , stringRep SplineEdges "spline"
- , stringRep LineEdges "line"
- , stringRep NoEdges "none"
- , stringRep PolyLine "polyline"
- , stringRep Ortho "ortho"
- , stringRep Curved "curved"
- , stringRep CompoundEdge "compound"
- ]
-
- parse = stringRep NoEdges "\"\""
- `onFail`
- optionalQuoted parseUnqt
-
--- -----------------------------------------------------------------------------
-
--- | Upper-case first character is major order;
--- lower-case second character is minor order.
-data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot PageDir where
- unqtDot Bl = text "BL"
- unqtDot Br = text "BR"
- unqtDot Tl = text "TL"
- unqtDot Tr = text "TR"
- unqtDot Rb = text "RB"
- unqtDot Rt = text "RT"
- unqtDot Lb = text "LB"
- unqtDot Lt = text "LT"
-
-instance ParseDot PageDir where
- parseUnqt = stringValue [ ("BL", Bl)
- , ("BR", Br)
- , ("TL", Tl)
- , ("TR", Tr)
- , ("RB", Rb)
- , ("RT", Rt)
- , ("LB", Lb)
- , ("LT", Lt)
- ]
-
--- -----------------------------------------------------------------------------
-
--- | The number of points in the list must be equivalent to 1 mod 3;
--- note that this is not checked.
-data Spline = Spline { endPoint :: Maybe Point
- , startPoint :: Maybe Point
- , splinePoints :: [Point]
- }
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Spline where
- unqtDot (Spline me ms ps) = addE . addS
- . hsep
- $ mapM unqtDot ps
- where
- addP t = maybe id ((<+>) . commaDel t)
- addS = addP 's' ms
- addE = addP 'e' me
-
- toDot = dquotes . unqtDot
-
- unqtListToDot = hcat . punctuate semi . mapM unqtDot
-
- listToDot = dquotes . unqtListToDot
-
-instance ParseDot Spline where
- parseUnqt = Spline <$> parseP 'e' <*> parseP 's'
- <*> sepBy1 parseUnqt whitespace1
- where
- parseP t = optional (character t *> parseComma *> parseUnqt <* whitespace1)
-
- parse = quotedParse parseUnqt
-
- parseUnqtList = sepBy1 parseUnqt (character ';')
-
--- -----------------------------------------------------------------------------
-
-data QuadType = NormalQT
- | FastQT
- | NoQT
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot QuadType where
- unqtDot NormalQT = text "normal"
- unqtDot FastQT = text "fast"
- unqtDot NoQT = text "none"
-
-instance ParseDot QuadType where
- -- Have to take into account the slightly different interpretation
- -- of Bool used as an option for parsing QuadType
- parseUnqt = oneOf [ stringRep NormalQT "normal"
- , stringRep FastQT "fast"
- , stringRep NoQT "none"
- , character '2' *> return FastQT -- weird bool
- , bool NoQT NormalQT <$> parse
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Specify the root node either as a Node attribute or a Graph attribute.
-data Root = IsCentral -- ^ For Nodes only
- | NotCentral -- ^ For Nodes only
- | NodeName Text -- ^ For Graphs only
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Root where
- unqtDot IsCentral = unqtDot True
- unqtDot NotCentral = unqtDot False
- unqtDot (NodeName n) = unqtDot n
-
- toDot (NodeName n) = toDot n
- toDot r = unqtDot r
-
-instance ParseDot Root where
- parseUnqt = fmap (bool NotCentral IsCentral) onlyBool
- `onFail`
- fmap NodeName parseUnqt
-
- parse = optionalQuoted (bool NotCentral IsCentral <$> onlyBool)
- `onFail`
- fmap NodeName parse
-
--- -----------------------------------------------------------------------------
-
-data RankType = SameRank
- | MinRank
- | SourceRank
- | MaxRank
- | SinkRank
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot RankType where
- unqtDot SameRank = text "same"
- unqtDot MinRank = text "min"
- unqtDot SourceRank = text "source"
- unqtDot MaxRank = text "max"
- unqtDot SinkRank = text "sink"
-
-instance ParseDot RankType where
- parseUnqt = stringValue [ ("same", SameRank)
- , ("min", MinRank)
- , ("source", SourceRank)
- , ("max", MaxRank)
- , ("sink", SinkRank)
- ]
-
--- -----------------------------------------------------------------------------
-
-data RankDir = FromTop
- | FromLeft
- | FromBottom
- | FromRight
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot RankDir where
- unqtDot FromTop = text "TB"
- unqtDot FromLeft = text "LR"
- unqtDot FromBottom = text "BT"
- unqtDot FromRight = text "RL"
-
-instance ParseDot RankDir where
- parseUnqt = oneOf [ stringRep FromTop "TB"
- , stringRep FromLeft "LR"
- , stringRep FromBottom "BT"
- , stringRep FromRight "RL"
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Geometries of shapes are affected by the attributes 'Regular',
--- 'Peripheries' and 'Orientation'.
-data Shape
- = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.
- | Polygon -- ^ Also affected by 'Sides', 'Skew' and 'Distortion'.
- | Ellipse -- ^ Has synonym of /oval/.
- | Circle
- | PointShape -- ^ Only affected by 'Peripheries', 'Width' and
- -- 'Height'.
- | Egg
- | Triangle
- | PlainText -- ^ Has synonym of /none/. Recommended for
- -- 'HtmlLabel's.
- | DiamondShape
- | Trapezium
- | Parallelogram
- | House
- | Pentagon
- | Hexagon
- | Septagon
- | Octagon
- | DoubleCircle
- | DoubleOctagon
- | TripleOctagon
- | InvTriangle
- | InvTrapezium
- | InvHouse
- | MDiamond
- | MSquare
- | MCircle
- | Note
- | Tab
- | Folder
- | Box3D
- | Component
- | Promoter
- | CDS
- | Terminator
- | UTR
- | PrimerSite
- | RestrictionSite
- | FivePovOverhang
- | ThreePovOverhang
- | NoOverhang
- | Assembly
- | Signature
- | Insulator
- | Ribosite
- | RNAStab
- | ProteaseSite
- | ProteinStab
- | RPromoter
- | RArrow
- | LArrow
- | LPromoter
- | 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 Promoter = text "promoter"
- unqtDot CDS = text "cds"
- unqtDot Terminator = text "terminator"
- unqtDot UTR = text "utr"
- unqtDot PrimerSite = text "primersite"
- unqtDot RestrictionSite = text "restrictionsite"
- unqtDot FivePovOverhang = text "fivepovoverhang"
- unqtDot ThreePovOverhang = text "threepovoverhang"
- unqtDot NoOverhang = text "nooverhang"
- unqtDot Assembly = text "assembly"
- unqtDot Signature = text "signature"
- unqtDot Insulator = text "insulator"
- unqtDot Ribosite = text "ribosite"
- unqtDot RNAStab = text "rnastab"
- unqtDot ProteaseSite = text "proteasesite"
- unqtDot ProteinStab = text "proteinstab"
- unqtDot RPromoter = text "rpromoter"
- unqtDot RArrow = text "rarrow"
- unqtDot LArrow = text "larrow"
- unqtDot LPromoter = text "lpromoter"
- unqtDot Record = text "record"
- unqtDot MRecord = text "Mrecord"
-
-instance ParseDot Shape where
- parseUnqt = stringValue [ ("box3d", Box3D)
- , ("box", BoxShape)
- , ("rectangle", BoxShape)
- , ("rect", BoxShape)
- , ("polygon", Polygon)
- , ("ellipse", Ellipse)
- , ("oval", Ellipse)
- , ("circle", Circle)
- , ("point", PointShape)
- , ("egg", Egg)
- , ("triangle", Triangle)
- , ("plaintext", PlainText)
- , ("none", PlainText)
- , ("diamond", DiamondShape)
- , ("trapezium", Trapezium)
- , ("parallelogram", Parallelogram)
- , ("house", House)
- , ("pentagon", Pentagon)
- , ("hexagon", Hexagon)
- , ("septagon", Septagon)
- , ("octagon", Octagon)
- , ("doublecircle", DoubleCircle)
- , ("doubleoctagon", DoubleOctagon)
- , ("tripleoctagon", TripleOctagon)
- , ("invtriangle", InvTriangle)
- , ("invtrapezium", InvTrapezium)
- , ("invhouse", InvHouse)
- , ("Mdiamond", MDiamond)
- , ("Msquare", MSquare)
- , ("Mcircle", MCircle)
- , ("note", Note)
- , ("tab", Tab)
- , ("folder", Folder)
- , ("component", Component)
- , ("promoter", Promoter)
- , ("cds", CDS)
- , ("terminator", Terminator)
- , ("utr", UTR)
- , ("primersite", PrimerSite)
- , ("restrictionsite", RestrictionSite)
- , ("fivepovoverhang", FivePovOverhang)
- , ("threepovoverhang", ThreePovOverhang)
- , ("nooverhang", NoOverhang)
- , ("assembly", Assembly)
- , ("signature", Signature)
- , ("insulator", Insulator)
- , ("ribosite", Ribosite)
- , ("rnastab", RNAStab)
- , ("proteasesite", ProteaseSite)
- , ("proteinstab", ProteinStab)
- , ("rpromoter", RPromoter)
- , ("rarrow", RArrow)
- , ("larrow", LArrow)
- , ("lpromoter", LPromoter)
- , ("record", Record)
- , ("Mrecord", MRecord)
- ]
-
--- -----------------------------------------------------------------------------
-
-data SmoothType = NoSmooth
- | AvgDist
- | GraphDist
- | PowerDist
- | RNG
- | Spring
- | TriangleSmooth
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot SmoothType where
- unqtDot NoSmooth = text "none"
- unqtDot AvgDist = text "avg_dist"
- unqtDot GraphDist = text "graph_dist"
- unqtDot PowerDist = text "power_dist"
- unqtDot RNG = text "rng"
- unqtDot Spring = text "spring"
- unqtDot TriangleSmooth = text "triangle"
-
-instance ParseDot SmoothType where
- parseUnqt = oneOf [ stringRep NoSmooth "none"
- , stringRep AvgDist "avg_dist"
- , stringRep GraphDist "graph_dist"
- , stringRep PowerDist "power_dist"
- , stringRep RNG "rng"
- , stringRep Spring "spring"
- , stringRep TriangleSmooth "triangle"
- ]
-
--- -----------------------------------------------------------------------------
-
-data StartType = StartStyle STStyle
- | StartSeed Int
- | StartStyleSeed STStyle Int
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot StartType where
- unqtDot (StartStyle ss) = unqtDot ss
- unqtDot (StartSeed s) = unqtDot s
- unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s
-
-instance ParseDot StartType where
- parseUnqt = oneOf [ liftA2 StartStyleSeed parseUnqt parseUnqt
- , StartStyle <$> parseUnqt
- , StartSeed <$> parseUnqt
- ]
-
-data STStyle = RegularStyle
- | SelfStyle
- | RandomStyle
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot STStyle where
- unqtDot RegularStyle = text "regular"
- unqtDot SelfStyle = text "self"
- unqtDot RandomStyle = text "random"
-
-instance ParseDot STStyle where
- parseUnqt = oneOf [ stringRep RegularStyle "regular"
- , stringRep SelfStyle "self"
- , stringRep RandomStyle "random"
- ]
-
--- -----------------------------------------------------------------------------
-
--- | An individual style item. Except for 'DD', the @['String']@
--- should be empty.
-data StyleItem = SItem StyleName [Text]
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot StyleItem where
- unqtDot (SItem nm args)
- | null args = dnm
- | otherwise = dnm <> parens args'
- where
- dnm = unqtDot nm
- args' = hcat . punctuate comma $ mapM unqtDot args
-
- toDot si@(SItem nm args)
- | null args = toDot nm
- | otherwise = dquotes $ unqtDot si
-
- unqtListToDot = hcat . punctuate comma . mapM unqtDot
-
- listToDot [SItem nm []] = toDot nm
- listToDot sis = dquotes $ unqtListToDot sis
-
-instance ParseDot StyleItem where
- parseUnqt = liftA2 SItem parseUnqt (tryParseList' parseArgs)
-
- parse = quotedParse (liftA2 SItem parseUnqt parseArgs)
- `onFail`
- fmap (`SItem` []) parse
-
- parseUnqtList = sepBy1 parseUnqt parseComma
-
- parseList = quotedParse parseUnqtList
- `onFail`
- -- Might not necessarily need to be quoted if a singleton...
- fmap return parse
-
-parseArgs :: Parse [Text]
-parseArgs = bracketSep (character '(')
- parseComma
- (character ')')
- parseStyleName
-
-data StyleName = Dashed -- ^ Nodes and Edges
- | Dotted -- ^ Nodes and Edges
- | Solid -- ^ Nodes and Edges
- | Bold -- ^ Nodes and Edges
- | Invisible -- ^ Nodes and Edges
- | Filled -- ^ Nodes and Clusters
- | Striped -- ^ Rectangularly-shaped Nodes and
- -- Clusters; requires Graphviz >= 2.30.0
- | Wedged -- ^ Elliptically-shaped Nodes only;
- -- requires Graphviz >= 2.30.0
- | Diagonals -- ^ Nodes only
- | Rounded -- ^ Nodes and Clusters
- | Tapered -- ^ Edges only; requires Graphviz >=
- -- 2.29.0
- | Radial -- ^ Nodes, Clusters and Graphs, for use
- -- with 'GradientAngle'; requires
- -- Graphviz >= 2.29.0
- | DD Text -- ^ Device Dependent
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot StyleName where
- unqtDot Dashed = text "dashed"
- unqtDot Dotted = text "dotted"
- unqtDot Solid = text "solid"
- unqtDot Bold = text "bold"
- unqtDot Invisible = text "invis"
- unqtDot Filled = text "filled"
- unqtDot Striped = text "striped"
- unqtDot Wedged = text "wedged"
- unqtDot Diagonals = text "diagonals"
- unqtDot Rounded = text "rounded"
- unqtDot Tapered = text "tapered"
- unqtDot Radial = text "radial"
- unqtDot (DD nm) = unqtDot nm
-
- toDot (DD nm) = toDot nm
- toDot sn = unqtDot sn
-
-instance ParseDot StyleName where
- parseUnqt = checkDD <$> parseStyleName
-
- parse = quotedParse parseUnqt
- `onFail`
- fmap checkDD quotelessString
-
-checkDD :: Text -> StyleName
-checkDD str = case T.toLower str of
- "dashed" -> Dashed
- "dotted" -> Dotted
- "solid" -> Solid
- "bold" -> Bold
- "invis" -> Invisible
- "filled" -> Filled
- "striped" -> Striped
- "wedged" -> Wedged
- "diagonals" -> Diagonals
- "rounded" -> Rounded
- "tapered" -> Tapered
- "radial" -> Radial
- _ -> DD str
-
-parseStyleName :: Parse Text
-parseStyleName = liftA2 T.cons (orEscaped . noneOf $ ' ' : disallowedChars)
- (parseEscaped True [] disallowedChars)
- where
- disallowedChars = [quoteChar, '(', ')', ',']
- -- Used because the first character has slightly stricter requirements than the rest.
- orSlash p = stringRep '\\' "\\\\" `onFail` p
- orEscaped = orQuote . orSlash
-
--- -----------------------------------------------------------------------------
-
-data ViewPort = VP { wVal :: Double
- , hVal :: Double
- , zVal :: Double
- , focus :: Maybe FocusType
- }
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot ViewPort where
- unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)
- $ focus vp
- where
- vs = hcat . punctuate comma
- $ mapM (unqtDot . ($vp)) [wVal, hVal, zVal]
-
- toDot = dquotes . unqtDot
-
-instance ParseDot ViewPort where
- parseUnqt = VP <$> parseUnqt
- <* parseComma
- <*> parseUnqt
- <* parseComma
- <*> parseUnqt
- <*> optional (parseComma *> parseUnqt)
-
- parse = quotedParse parseUnqt
-
--- | For use with 'ViewPort'.
-data FocusType = XY Point
- | NodeFocus Text
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot FocusType where
- unqtDot (XY p) = unqtDot p
- unqtDot (NodeFocus nm) = unqtDot nm
-
- toDot (XY p) = toDot p
- toDot (NodeFocus nm) = toDot nm
-
-instance ParseDot FocusType where
- parseUnqt = fmap XY parseUnqt
- `onFail`
- fmap NodeFocus parseUnqt
-
- parse = fmap XY parse
- `onFail`
- fmap NodeFocus parse
-
--- -----------------------------------------------------------------------------
-
-data VerticalPlacement = VTop
- | VCenter -- ^ Only valid for Nodes.
- | VBottom
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot VerticalPlacement where
- unqtDot VTop = char 't'
- unqtDot VCenter = char 'c'
- unqtDot VBottom = char 'b'
-
-instance ParseDot VerticalPlacement where
- parseUnqt = oneOf [ stringRep VTop "t"
- , stringRep VCenter "c"
- , stringRep VBottom "b"
- ]
-
--- -----------------------------------------------------------------------------
-
--- | A list of search paths.
-newtype Paths = Paths { paths :: [FilePath] }
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot Paths where
- unqtDot = unqtDot . intercalate [searchPathSeparator] . paths
-
- toDot (Paths [p]) = toDot p
- toDot ps = dquotes $ unqtDot ps
-
-instance ParseDot Paths where
- parseUnqt = Paths . splitSearchPath <$> parseUnqt
-
- parse = quotedParse parseUnqt
- `onFail`
- fmap (Paths . (:[]) . T.unpack) quotelessString
-
--- -----------------------------------------------------------------------------
-
-data ScaleType = UniformScale
- | NoScale
- | FillWidth
- | FillHeight
- | FillBoth
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot ScaleType where
- unqtDot UniformScale = unqtDot True
- unqtDot NoScale = unqtDot False
- unqtDot FillWidth = text "width"
- unqtDot FillHeight = text "height"
- unqtDot FillBoth = text "both"
-
-instance ParseDot ScaleType where
- parseUnqt = oneOf [ stringRep UniformScale "true"
- , stringRep NoScale "false"
- , stringRep FillWidth "width"
- , stringRep FillHeight "height"
- , stringRep FillBoth "both"
- ]
-
--- -----------------------------------------------------------------------------
-
-data Justification = JLeft
- | JRight
- | JCenter
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
-
-instance PrintDot Justification where
- unqtDot JLeft = char 'l'
- unqtDot JRight = char 'r'
- unqtDot JCenter = char 'c'
-
-instance ParseDot Justification where
- parseUnqt = oneOf [ 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 [ AspectRatio <$> parseUnqt
- , stringRep FillRatio "fill"
- , stringRep CompressRatio "compress"
- , stringRep ExpandRatio "expand"
- , stringRep AutoRatio "auto"
- ]
+ * 'Rect' uses two 'Point' values to denote the lower-left and
+ top-right corners.
+
+ * The two 'LabelLoc' attributes have been combined.
+
+ * @SplineType@ has been replaced with @['Spline']@.
+
+ * Only polygon-based 'Shape's are available.
+
+ * Not every 'Attribute' is fully documented/described. However,
+ all those which have specific allowed values should be covered.
+
+ * Deprecated 'Overlap' algorithms are not defined. Furthermore,
+ the ability to specify an integer prefix for use with the fdp layout
+ is /not/ supported.
+
+ * The global @Orientation@ attribute is not defined, as it is
+ difficult to distinguish from the node-based 'Orientation'
+ 'Attribute'; also, its behaviour is duplicated by 'Rotate'.
+
+ * The @charset@ attribute is not available, as graphviz only
+ supports UTF-8 encoding (as it is not currently feasible nor needed to
+ also support Latin1 encoding).
+
+ * In Graphviz, when a node or edge has a list of attributes, the
+ colorscheme which is used to identify a color can be set /after/
+ that color (e.g. @[colorscheme=x11,color=grey,colorscheme=svg]@
+ uses the svg colorscheme's definition of grey, which is different
+ from the x11 one. Instead, graphviz parses them in order.
+
+ -}
+module Data.GraphViz.Attributes.Complete
+ ( -- * The actual /Dot/ attributes.
+ -- $attributes
+ Attribute(..)
+ , Attributes
+ , sameAttribute
+ , defaultAttributeValue
+ , rmUnwantedAttributes
+ -- ** Validity functions on @Attribute@ values.
+ , usedByGraphs
+ , usedBySubGraphs
+ , usedByClusters
+ , usedByNodes
+ , usedByEdges
+ , validUnknown
+
+ -- ** Custom attributes.
+ , AttributeName
+ , CustomAttribute
+ , customAttribute
+ , isCustom
+ , isSpecifiedCustom
+ , customValue
+ , customName
+ , findCustoms
+ , findSpecifiedCustom
+ , deleteCustomAttributes
+ , deleteSpecifiedCustom
+
+ -- * Value types for @Attribute@s.
+ , module Data.GraphViz.Attributes.Colors
+
+ -- ** Generic types
+ , Number (..)
+
+ -- ** Labels
+ , EscString
+ , Label(..)
+ , VerticalPlacement(..)
+ , LabelScheme(..)
+ , SVGFontNames(..)
+ -- *** Types representing the Dot grammar for records.
+ , RecordFields
+ , RecordField(..)
+ , Rect(..)
+ , Justification(..)
+
+ -- ** Nodes
+ , Shape(..)
+ , Paths(..)
+ , ScaleType(..)
+ , NodeSize(..)
+
+ -- ** Edges
+ , DirType(..)
+ , EdgeType(..)
+ -- *** Modifying where edges point
+ , PortName(..)
+ , PortPos(..)
+ , CompassPoint(..)
+ -- *** Arrows
+ , ArrowType(..)
+ , ArrowShape(..)
+ , ArrowModifier(..)
+ , ArrowFill(..)
+ , ArrowSide(..)
+ -- **** @ArrowModifier@ values
+ , noMods
+ , openMod
+
+ -- ** Positioning
+ , Point(..)
+ , createPoint
+ , Pos(..)
+ , Spline(..)
+ , DPoint(..)
+ , Normalized (..)
+
+ -- ** Layout
+ , GraphvizCommand(..)
+ , GraphSize(..)
+ , ClusterMode(..)
+ , Model(..)
+ , Overlap(..)
+ , Root(..)
+ , Order(..)
+ , OutputMode(..)
+ , Pack(..)
+ , PackMode(..)
+ , PageDir(..)
+ , QuadType(..)
+ , RankType(..)
+ , RankDir(..)
+ , StartType(..)
+ , ViewPort(..)
+ , FocusType(..)
+ , Ratios(..)
+
+ -- ** Modes
+ , ModeType(..)
+ , DEConstraints(..)
+
+ -- ** Layers
+ , LayerSep(..)
+ , LayerListSep(..)
+ , LayerRange
+ , LayerRangeElem(..)
+ , LayerID(..)
+ , LayerList(..)
+
+ -- ** Stylistic
+ , SmoothType(..)
+ , STStyle(..)
+ , StyleItem(..)
+ , StyleName(..)
+ ) where
+
+import Data.GraphViz.Attributes.Arrows
+import Data.GraphViz.Attributes.Colors
+import Data.GraphViz.Attributes.Colors.X11 (X11Color (Black))
+import Data.GraphViz.Attributes.Internal
+import Data.GraphViz.Attributes.Values
+import Data.GraphViz.Commands.Available
+import Data.GraphViz.Exception (GraphvizException (NotCustomAttr),
+ throw)
+import Data.GraphViz.Internal.State (getsGS, parseStrictly)
+import Data.GraphViz.Internal.Util (bool, isIDString, keywords,
+ restIDString)
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
+
+import Data.List (partition)
+import Data.Maybe (isNothing)
+import qualified Data.Set as S
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import Data.Version (Version (..))
+import Data.Word (Word16)
+
+-- -----------------------------------------------------------------------------
+
+{- $attributes
+
+ These attributes have been implemented in a /permissive/ manner:
+ that is, rather than split them up based on which type of value
+ they are allowed, they have all been included in the one data type,
+ with functions to determine if they are indeed valid for what
+ they're being applied to.
+
+ To interpret the /Valid for/ listings:
+
+ [@G@] Valid for Graphs.
+
+ [@C@] Valid for Clusters.
+
+ [@S@] Valid for Sub-Graphs (and also Clusters).
+
+ [@N@] Valid for Nodes.
+
+ [@E@] Valid for Edges.
+
+ The /Default/ listings are those that the various Graphviz commands
+ use if that 'Attribute' isn't specified (in cases where this is
+ /none/, this is equivalent to a 'Nothing' value; that is, no value
+ is used). The /Parsing Default/ listings represent what value is
+ used (i.e. corresponds to 'True') when the 'Attribute' name is
+ listed on its own in /Dot/ source code.
+
+ Please note that the 'UnknownAttribute' 'Attribute' is defined
+ primarily for backwards-compatibility purposes. It is possible to use
+ it directly for custom purposes; for more information, please see
+ 'CustomAttribute'. The 'deleteCustomAttributes' can be used to delete
+ these values.
+
+ -}
+
+-- | Attributes are used to customise the layout and design of Dot
+-- graphs. Care must be taken to ensure that the attribute you use
+-- is valid, as not all attributes can be used everywhere.
+data Attribute
+ = Damping Double -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: 'Neato' only
+ | K Double -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: 'Sfdp', 'Fdp' only
+ | URL EscString -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only
+ | Area Double -- ^ /Valid for/: NC; /Default/: @1.0@; /Minimum/: @>0@; /Notes/: 'Patchwork' only, requires Graphviz >= 2.30.0
+ | ArrowHead ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@
+ | ArrowSize Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
+ | ArrowTail ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@
+ | Background Text -- ^ /Valid for/: G; /Default/: none; /Notes/: xdot only
+ | BoundingBox Rect -- ^ /Valid for/: G; /Notes/: write only
+ | BgColor ColorList -- ^ /Valid for/: GC; /Default/: @[]@
+ | Center Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
+ | ClusterRank ClusterMode -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: 'Dot' only
+ | Color ColorList -- ^ /Valid for/: ENC; /Default/: @['WC' ('X11Color' 'Black') Nothing]@
+ | ColorScheme ColorScheme -- ^ /Valid for/: ENCG; /Default/: @'X11'@
+ | Comment Text -- ^ /Valid for/: ENG; /Default/: @\"\"@
+ | Compound Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Dot' only
+ | Concentrate Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Constraint Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: 'Dot' only
+ | Decorate Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
+ | DefaultDist Double -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(abs(V))@ (unable to statically define); /Minimum/: The value of 'Epsilon'.; /Notes/: 'Neato' only, only if @'Pack' 'DontPack'@
+ | Dim Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only
+ | Dimen Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only
+ | Dir DirType -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)
+ | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: 'Neato' only
+ | Distortion Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
+ | DPI Double -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym
+ | EdgeURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | EdgeTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | EdgeTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Epsilon Double -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: 'Neato' only
+ | ESep DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 3@; /Notes/: not 'Dot'
+ | FillColor ColorList -- ^ /Valid for/: NEC; /Default/: @['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters)
+ | FixedSize NodeSize -- ^ /Valid for/: N; /Default/: @'GrowAsNeeded'@; /Parsing Default/: 'SetNodeSize'
+ | FontColor Color -- ^ /Valid for/: ENGC; /Default/: @'X11Color' 'Black'@
+ | FontName Text -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@
+ | FontNames SVGFontNames -- ^ /Valid for/: G; /Default/: @'SvgNames'@; /Notes/: svg only
+ | FontPath Paths -- ^ /Valid for/: G; /Default/: system dependent
+ | FontSize Double -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@
+ | ForceLabels Bool -- ^ /Valid for/: G; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: only for 'XLabel' attributes, requires Graphviz >= 2.29.0
+ | GradientAngle Int -- ^ /Valid for/: NCG; /Default/: 0; /Notes/: requires Graphviz >= 2.29.0
+ | Group Text -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: 'Dot' only
+ | HeadURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | Head_LP Point -- ^ /Valid for/: E; /Notes/: write only, requires Graphviz >= 2.30.0
+ | HeadClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
+ | HeadLabel Label -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@
+ | HeadPort PortPos -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@
+ | HeadTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | HeadTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Height Double -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@
+ | ID EscString -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only
+ | Image Text -- ^ /Valid for/: N; /Default/: @\"\"@
+ | ImagePath Paths -- ^ /Valid for/: G; /Default/: @'Paths' []@; /Notes/: Printing and parsing is OS-specific, requires Graphviz >= 2.29.0
+ | ImageScale ScaleType -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'
+ | InputScale Double -- ^ /Valid for/: N; /Default/: none; /Notes/: 'Fdp', 'Neato' only, a value of @0@ is equivalent to being @72@, requires Graphviz >= 2.36.0
+ | Label Label -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)
+ | LabelURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | LabelScheme LabelScheme -- ^ /Valid for/: G; /Default/: @'NotEdgeLabel'@; /Notes/: 'Sfdp' only, requires Graphviz >= 2.28.0
+ | LabelAngle Double -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@
+ | LabelDistance Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
+ | LabelFloat Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
+ | LabelFontColor Color -- ^ /Valid for/: E; /Default/: @'X11Color' 'Black'@
+ | LabelFontName Text -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@
+ | LabelFontSize Double -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@
+ | LabelJust Justification -- ^ /Valid for/: GC; /Default/: @'JCenter'@
+ | LabelLoc VerticalPlacement -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)
+ | LabelTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | LabelTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Landscape Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Layer LayerRange -- ^ /Valid for/: ENC; /Default/: @[]@
+ | LayerListSep LayerListSep -- ^ /Valid for/: G; /Default/: @'LLSep' \",\"@; /Notes/: requires Graphviz >= 2.30.0
+ | Layers LayerList -- ^ /Valid for/: G; /Default/: @'LL' []@
+ | LayerSelect LayerRange -- ^ /Valid for/: G; /Default/: @[]@
+ | LayerSep LayerSep -- ^ /Valid for/: G; /Default/: @'LSep' \" :\t\"@
+ | Layout GraphvizCommand -- ^ /Valid for/: G
+ | Len Double -- ^ /Valid for/: E; /Default/: @1.0@ ('Neato'), @0.3@ ('Fdp'); /Notes/: 'Fdp', 'Neato' only
+ | Levels Int -- ^ /Valid for/: G; /Default/: @'maxBound'@; /Minimum/: @0@; /Notes/: 'Sfdp' only
+ | LevelsGap Double -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: 'Neato' only
+ | LHead Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only
+ | LHeight Double -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0
+ | LPos Point -- ^ /Valid for/: EGC; /Notes/: write only
+ | LTail Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only
+ | LWidth Double -- ^ /Valid for/: GC; /Notes/: write only, requires Graphviz >= 2.28.0
+ | Margin DPoint -- ^ /Valid for/: NGC; /Default/: device dependent
+ | MaxIter Int -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ ('Fdp'); /Notes/: 'Fdp', 'Neato' only
+ | MCLimit Double -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: 'Dot' only
+ | MinDist Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: 'Circo' only
+ | MinLen Int -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: 'Dot' only
+ | Mode ModeType -- ^ /Valid for/: G; /Default/: @'Major'@ (actually @'Spring'@ for 'Sfdp', but this isn't used as a default in this library); /Notes/: 'Neato', 'Sfdp' only
+ | Model Model -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: 'Neato' only
+ | Mosek Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Neato' only; requires the Mosek software
+ | NodeSep Double -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@
+ | NoJustify Bool -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Normalize Normalized -- ^ /Valid for/: G; /Default/: @'NotNormalized'@; /Parsing Default/: 'IsNormalized'; /Notes/: not 'Dot'
+ | Nslimit Double -- ^ /Valid for/: G; /Notes/: 'Dot' only
+ | Nslimit1 Double -- ^ /Valid for/: G; /Notes/: 'Dot' only
+ | Ordering Order -- ^ /Valid for/: GN; /Default/: none; /Notes/: 'Dot' only
+ | Orientation Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@
+ | OutputOrder OutputMode -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@
+ | Overlap Overlap -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not 'Dot'
+ | OverlapScaling Double -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: 'PrismOverlap' only
+ | OverlapShrink Bool -- ^ /Valid for/: G; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: 'PrismOverlap' only, requires Graphviz >= 2.36.0
+ | Pack Pack -- ^ /Valid for/: G; /Default/: @'DontPack'@; /Parsing Default/: 'DoPack'
+ | PackMode PackMode -- ^ /Valid for/: G; /Default/: @'PackNode'@
+ | Pad DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)
+ | Page Point -- ^ /Valid for/: G
+ | PageDir PageDir -- ^ /Valid for/: G; /Default/: @'Bl'@
+ | PenColor Color -- ^ /Valid for/: C; /Default/: @'X11Color' 'Black'@
+ | PenWidth Double -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@
+ | Peripheries Int -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0
+ | Pin Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Fdp', 'Neato' only
+ | Pos Pos -- ^ /Valid for/: EN
+ | QuadTree QuadType -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: 'Sfdp' only
+ | Quantum Double -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@
+ | Rank RankType -- ^ /Valid for/: S; /Notes/: 'Dot' only
+ | RankDir RankDir -- ^ /Valid for/: G; /Default/: @'FromTop'@; /Notes/: 'Dot' only
+ | RankSep [Double] -- ^ /Valid for/: G; /Default/: @[0.5]@ ('Dot'), @[1.0]@ ('Twopi'); /Minimum/: @[0.02]@; /Notes/: 'Twopi', 'Dot' only
+ | Ratio Ratios -- ^ /Valid for/: G
+ | Rects [Rect] -- ^ /Valid for/: N; /Notes/: write only
+ | Regular Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'
+ | ReMinCross Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: 'Dot' only
+ | RepulsiveForce Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: 'Sfdp' only
+ | Root Root -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: 'Circo', 'Twopi' only
+ | Rotate Int -- ^ /Valid for/: G; /Default/: @0@
+ | Rotation Double -- ^ /Valid for/: G; /Default/: @0@; /Notes/: 'Sfdp' only, requires Graphviz >= 2.28.0
+ | SameHead Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only
+ | SameTail Text -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: 'Dot' only
+ | SamplePoints Int -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)
+ | Scale DPoint -- ^ /Valid for/: G; /Notes/: Not 'Dot', requires Graphviz >= 2.28.0 (>= 2.38.0 for anything except 'TwoPi')
+ | SearchSize Int -- ^ /Valid for/: G; /Default/: @30@; /Notes/: 'Dot' only
+ | Sep DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 4@; /Notes/: not 'Dot'
+ | Shape Shape -- ^ /Valid for/: N; /Default/: @'Ellipse'@
+ | ShowBoxes Int -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: 'Dot' only; used for debugging by printing PostScript guide boxes
+ | Sides Int -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@
+ | Size GraphSize -- ^ /Valid for/: G
+ | Skew Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
+ | Smoothing SmoothType -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: 'Sfdp' only
+ | SortV Word16 -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@
+ | Splines EdgeType -- ^ /Valid for/: G; /Default/: @'SplineEdges'@ ('Dot'), @'LineEdges'@ (other); /Parsing Default/: 'SplineEdges'
+ | Start StartType -- ^ /Valid for/: G; /Default/: @'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed.; /Notes/: 'Fdp', 'Neato' only
+ | Style [StyleItem] -- ^ /Valid for/: ENCG
+ | StyleSheet Text -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only
+ | TailURL EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | Tail_LP Point -- ^ /Valid for/: E; /Notes/: write only, requires Graphviz >= 2.30.0
+ | TailClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
+ | TailLabel Label -- ^ /Valid for/: E; /Default/: @'StrLabel' \"\"@
+ | TailPort PortPos -- ^ /Valid for/: E; /Default/: @'CompassPoint' 'CenterPoint'@
+ | TailTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | TailTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Target EscString -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only
+ | Tooltip EscString -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | TrueColor Bool -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only
+ | Vertices [Point] -- ^ /Valid for/: N; /Notes/: write only
+ | ViewPort ViewPort -- ^ /Valid for/: G; /Default/: none
+ | VoroMargin Double -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not 'Dot'
+ | Weight Number -- ^ /Valid for/: E; /Default/: @'Int' 1@; /Minimum/: @'Int' 0@ ('Dot'), @'Int' 1@ ('Neato','Fdp','Sfdp'); /Notes/: as of Graphviz 2.30: weights for dot need to be 'Int's
+ | Width Double -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@
+ | XDotVersion Version -- ^ /Valid for/: G; /Notes/: xdot only, requires Graphviz >= 2.34.0, equivalent to specifying version of xdot to be used
+ | XLabel Label -- ^ /Valid for/: EN; /Default/: @'StrLabel' \"\"@; /Notes/: requires Graphviz >= 2.29.0
+ | XLP Point -- ^ /Valid for/: EN; /Notes/: write only, requires Graphviz >= 2.29.0
+ | UnknownAttribute AttributeName Text -- ^ /Valid for/: Assumed valid for all; the fields are 'Attribute' name and value respectively.
+ deriving (Eq, Ord, Show, Read)
+
+type Attributes = [Attribute]
+
+-- | The name for an UnknownAttribute; must satisfy 'validUnknown'.
+type AttributeName = Text
+
+instance PrintDot Attribute where
+ unqtDot (Damping v) = printField "Damping" v
+ unqtDot (K v) = printField "K" v
+ unqtDot (URL v) = printField "URL" v
+ unqtDot (Area v) = printField "area" v
+ unqtDot (ArrowHead v) = printField "arrowhead" v
+ unqtDot (ArrowSize v) = printField "arrowsize" v
+ unqtDot (ArrowTail v) = printField "arrowtail" v
+ unqtDot (Background v) = printField "_background" v
+ unqtDot (BoundingBox v) = printField "bb" v
+ unqtDot (BgColor v) = printField "bgcolor" v
+ unqtDot (Center v) = printField "center" v
+ unqtDot (ClusterRank v) = printField "clusterrank" v
+ unqtDot (Color v) = printField "color" v
+ unqtDot (ColorScheme v) = printField "colorscheme" v
+ unqtDot (Comment v) = printField "comment" v
+ unqtDot (Compound v) = printField "compound" v
+ unqtDot (Concentrate v) = printField "concentrate" v
+ unqtDot (Constraint v) = printField "constraint" v
+ unqtDot (Decorate v) = printField "decorate" v
+ unqtDot (DefaultDist v) = printField "defaultdist" v
+ unqtDot (Dim v) = printField "dim" v
+ unqtDot (Dimen v) = printField "dimen" v
+ unqtDot (Dir v) = printField "dir" v
+ unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v
+ unqtDot (Distortion v) = printField "distortion" v
+ unqtDot (DPI v) = printField "dpi" v
+ unqtDot (EdgeURL v) = printField "edgeURL" v
+ unqtDot (EdgeTarget v) = printField "edgetarget" v
+ unqtDot (EdgeTooltip v) = printField "edgetooltip" v
+ unqtDot (Epsilon v) = printField "epsilon" v
+ unqtDot (ESep v) = printField "esep" v
+ unqtDot (FillColor v) = printField "fillcolor" v
+ unqtDot (FixedSize v) = printField "fixedsize" v
+ unqtDot (FontColor v) = printField "fontcolor" v
+ unqtDot (FontName v) = printField "fontname" v
+ unqtDot (FontNames v) = printField "fontnames" v
+ unqtDot (FontPath v) = printField "fontpath" v
+ unqtDot (FontSize v) = printField "fontsize" v
+ unqtDot (ForceLabels v) = printField "forcelabels" v
+ unqtDot (GradientAngle v) = printField "gradientangle" v
+ unqtDot (Group v) = printField "group" v
+ unqtDot (HeadURL v) = printField "headURL" v
+ unqtDot (Head_LP v) = printField "head_lp" v
+ unqtDot (HeadClip v) = printField "headclip" v
+ unqtDot (HeadLabel v) = printField "headlabel" v
+ unqtDot (HeadPort v) = printField "headport" v
+ unqtDot (HeadTarget v) = printField "headtarget" v
+ unqtDot (HeadTooltip v) = printField "headtooltip" v
+ unqtDot (Height v) = printField "height" v
+ unqtDot (ID v) = printField "id" v
+ unqtDot (Image v) = printField "image" v
+ unqtDot (ImagePath v) = printField "imagepath" v
+ unqtDot (ImageScale v) = printField "imagescale" v
+ unqtDot (InputScale v) = printField "inputscale" v
+ unqtDot (Label v) = printField "label" v
+ unqtDot (LabelURL v) = printField "labelURL" v
+ unqtDot (LabelScheme v) = printField "label_scheme" v
+ unqtDot (LabelAngle v) = printField "labelangle" v
+ unqtDot (LabelDistance v) = printField "labeldistance" v
+ unqtDot (LabelFloat v) = printField "labelfloat" v
+ unqtDot (LabelFontColor v) = printField "labelfontcolor" v
+ unqtDot (LabelFontName v) = printField "labelfontname" v
+ unqtDot (LabelFontSize v) = printField "labelfontsize" v
+ unqtDot (LabelJust v) = printField "labeljust" v
+ unqtDot (LabelLoc v) = printField "labelloc" v
+ unqtDot (LabelTarget v) = printField "labeltarget" v
+ unqtDot (LabelTooltip v) = printField "labeltooltip" v
+ unqtDot (Landscape v) = printField "landscape" v
+ unqtDot (Layer v) = printField "layer" v
+ unqtDot (LayerListSep v) = printField "layerlistsep" v
+ unqtDot (Layers v) = printField "layers" v
+ unqtDot (LayerSelect v) = printField "layerselect" v
+ unqtDot (LayerSep v) = printField "layersep" v
+ unqtDot (Layout v) = printField "layout" v
+ unqtDot (Len v) = printField "len" v
+ unqtDot (Levels v) = printField "levels" v
+ unqtDot (LevelsGap v) = printField "levelsgap" v
+ unqtDot (LHead v) = printField "lhead" v
+ unqtDot (LHeight v) = printField "LHeight" v
+ unqtDot (LPos v) = printField "lp" v
+ unqtDot (LTail v) = printField "ltail" v
+ unqtDot (LWidth v) = printField "lwidth" v
+ unqtDot (Margin v) = printField "margin" v
+ unqtDot (MaxIter v) = printField "maxiter" v
+ unqtDot (MCLimit v) = printField "mclimit" v
+ unqtDot (MinDist v) = printField "mindist" v
+ unqtDot (MinLen v) = printField "minlen" v
+ unqtDot (Mode v) = printField "mode" v
+ unqtDot (Model v) = printField "model" v
+ unqtDot (Mosek v) = printField "mosek" v
+ unqtDot (NodeSep v) = printField "nodesep" v
+ unqtDot (NoJustify v) = printField "nojustify" v
+ unqtDot (Normalize v) = printField "normalize" v
+ unqtDot (Nslimit v) = printField "nslimit" v
+ unqtDot (Nslimit1 v) = printField "nslimit1" v
+ unqtDot (Ordering v) = printField "ordering" v
+ unqtDot (Orientation v) = printField "orientation" v
+ unqtDot (OutputOrder v) = printField "outputorder" v
+ unqtDot (Overlap v) = printField "overlap" v
+ unqtDot (OverlapScaling v) = printField "overlap_scaling" v
+ unqtDot (OverlapShrink v) = printField "overlap_shrink" v
+ unqtDot (Pack v) = printField "pack" v
+ unqtDot (PackMode v) = printField "packmode" v
+ unqtDot (Pad v) = printField "pad" v
+ unqtDot (Page v) = printField "page" v
+ unqtDot (PageDir v) = printField "pagedir" v
+ unqtDot (PenColor v) = printField "pencolor" v
+ unqtDot (PenWidth v) = printField "penwidth" v
+ unqtDot (Peripheries v) = printField "peripheries" v
+ unqtDot (Pin v) = printField "pin" v
+ unqtDot (Pos v) = printField "pos" v
+ unqtDot (QuadTree v) = printField "quadtree" v
+ unqtDot (Quantum v) = printField "quantum" v
+ unqtDot (Rank v) = printField "rank" v
+ unqtDot (RankDir v) = printField "rankdir" v
+ unqtDot (RankSep v) = printField "ranksep" v
+ unqtDot (Ratio v) = printField "ratio" v
+ unqtDot (Rects v) = printField "rects" v
+ unqtDot (Regular v) = printField "regular" v
+ unqtDot (ReMinCross v) = printField "remincross" v
+ unqtDot (RepulsiveForce v) = printField "repulsiveforce" v
+ unqtDot (Root v) = printField "root" v
+ unqtDot (Rotate v) = printField "rotate" v
+ unqtDot (Rotation v) = printField "rotation" v
+ unqtDot (SameHead v) = printField "samehead" v
+ unqtDot (SameTail v) = printField "sametail" v
+ unqtDot (SamplePoints v) = printField "samplepoints" v
+ unqtDot (Scale v) = printField "scale" v
+ unqtDot (SearchSize v) = printField "searchsize" v
+ unqtDot (Sep v) = printField "sep" v
+ unqtDot (Shape v) = printField "shape" v
+ unqtDot (ShowBoxes v) = printField "showboxes" v
+ unqtDot (Sides v) = printField "sides" v
+ unqtDot (Size v) = printField "size" v
+ unqtDot (Skew v) = printField "skew" v
+ unqtDot (Smoothing v) = printField "smoothing" v
+ unqtDot (SortV v) = printField "sortv" v
+ unqtDot (Splines v) = printField "splines" v
+ unqtDot (Start v) = printField "start" v
+ unqtDot (Style v) = printField "style" v
+ unqtDot (StyleSheet v) = printField "stylesheet" v
+ unqtDot (TailURL v) = printField "tailURL" v
+ unqtDot (Tail_LP v) = printField "tail_lp" v
+ unqtDot (TailClip v) = printField "tailclip" v
+ unqtDot (TailLabel v) = printField "taillabel" v
+ unqtDot (TailPort v) = printField "tailport" v
+ unqtDot (TailTarget v) = printField "tailtarget" v
+ unqtDot (TailTooltip v) = printField "tailtooltip" v
+ unqtDot (Target v) = printField "target" v
+ unqtDot (Tooltip v) = printField "tooltip" v
+ unqtDot (TrueColor v) = printField "truecolor" v
+ unqtDot (Vertices v) = printField "vertices" v
+ unqtDot (ViewPort v) = printField "viewport" v
+ unqtDot (VoroMargin v) = printField "voro_margin" v
+ unqtDot (Weight v) = printField "weight" v
+ unqtDot (Width v) = printField "width" v
+ unqtDot (XDotVersion v) = printField "xdotversion" v
+ unqtDot (XLabel v) = printField "xlabel" v
+ unqtDot (XLP v) = printField "xlp" v
+ unqtDot (UnknownAttribute a v) = toDot a <> equals <> toDot v
+
+ listToDot = unqtListToDot
+
+instance ParseDot Attribute where
+ parseUnqt = stringParse (concat [ parseField Damping "Damping"
+ , parseField K "K"
+ , parseFields URL ["URL", "href"]
+ , parseField Area "area"
+ , parseField ArrowHead "arrowhead"
+ , parseField ArrowSize "arrowsize"
+ , parseField ArrowTail "arrowtail"
+ , parseField Background "_background"
+ , parseField BoundingBox "bb"
+ , parseField BgColor "bgcolor"
+ , parseFieldBool Center "center"
+ , parseField ClusterRank "clusterrank"
+ , parseField Color "color"
+ , parseField ColorScheme "colorscheme"
+ , parseField Comment "comment"
+ , parseFieldBool Compound "compound"
+ , parseFieldBool Concentrate "concentrate"
+ , parseFieldBool Constraint "constraint"
+ , parseFieldBool Decorate "decorate"
+ , parseField DefaultDist "defaultdist"
+ , parseField Dim "dim"
+ , parseField Dimen "dimen"
+ , parseField Dir "dir"
+ , parseFieldDef DirEdgeConstraints EdgeConstraints "diredgeconstraints"
+ , parseField Distortion "distortion"
+ , parseFields DPI ["dpi", "resolution"]
+ , parseFields EdgeURL ["edgeURL", "edgehref"]
+ , parseField EdgeTarget "edgetarget"
+ , parseField EdgeTooltip "edgetooltip"
+ , parseField Epsilon "epsilon"
+ , parseField ESep "esep"
+ , parseField FillColor "fillcolor"
+ , parseFieldDef FixedSize SetNodeSize "fixedsize"
+ , parseField FontColor "fontcolor"
+ , parseField FontName "fontname"
+ , parseField FontNames "fontnames"
+ , parseField FontPath "fontpath"
+ , parseField FontSize "fontsize"
+ , parseFieldBool ForceLabels "forcelabels"
+ , parseField GradientAngle "gradientangle"
+ , parseField Group "group"
+ , parseFields HeadURL ["headURL", "headhref"]
+ , parseField Head_LP "head_lp"
+ , parseFieldBool HeadClip "headclip"
+ , parseField HeadLabel "headlabel"
+ , parseField HeadPort "headport"
+ , parseField HeadTarget "headtarget"
+ , parseField HeadTooltip "headtooltip"
+ , parseField Height "height"
+ , parseField ID "id"
+ , parseField Image "image"
+ , parseField ImagePath "imagepath"
+ , parseFieldDef ImageScale UniformScale "imagescale"
+ , parseField InputScale "inputscale"
+ , parseField Label "label"
+ , parseFields LabelURL ["labelURL", "labelhref"]
+ , parseField LabelScheme "label_scheme"
+ , parseField LabelAngle "labelangle"
+ , parseField LabelDistance "labeldistance"
+ , parseFieldBool LabelFloat "labelfloat"
+ , parseField LabelFontColor "labelfontcolor"
+ , parseField LabelFontName "labelfontname"
+ , parseField LabelFontSize "labelfontsize"
+ , parseField LabelJust "labeljust"
+ , parseField LabelLoc "labelloc"
+ , parseField LabelTarget "labeltarget"
+ , parseField LabelTooltip "labeltooltip"
+ , parseFieldBool Landscape "landscape"
+ , parseField Layer "layer"
+ , parseField LayerListSep "layerlistsep"
+ , parseField Layers "layers"
+ , parseField LayerSelect "layerselect"
+ , parseField LayerSep "layersep"
+ , parseField Layout "layout"
+ , parseField Len "len"
+ , parseField Levels "levels"
+ , parseField LevelsGap "levelsgap"
+ , parseField LHead "lhead"
+ , parseField LHeight "LHeight"
+ , parseField LPos "lp"
+ , parseField LTail "ltail"
+ , parseField LWidth "lwidth"
+ , parseField Margin "margin"
+ , parseField MaxIter "maxiter"
+ , parseField MCLimit "mclimit"
+ , parseField MinDist "mindist"
+ , parseField MinLen "minlen"
+ , parseField Mode "mode"
+ , parseField Model "model"
+ , parseFieldBool Mosek "mosek"
+ , parseField NodeSep "nodesep"
+ , parseFieldBool NoJustify "nojustify"
+ , parseFieldDef Normalize IsNormalized "normalize"
+ , parseField Nslimit "nslimit"
+ , parseField Nslimit1 "nslimit1"
+ , parseField Ordering "ordering"
+ , parseField Orientation "orientation"
+ , parseField OutputOrder "outputorder"
+ , parseFieldDef Overlap KeepOverlaps "overlap"
+ , parseField OverlapScaling "overlap_scaling"
+ , parseFieldBool OverlapShrink "overlap_shrink"
+ , parseFieldDef Pack DoPack "pack"
+ , parseField PackMode "packmode"
+ , parseField Pad "pad"
+ , parseField Page "page"
+ , parseField PageDir "pagedir"
+ , parseField PenColor "pencolor"
+ , parseField PenWidth "penwidth"
+ , parseField Peripheries "peripheries"
+ , parseFieldBool Pin "pin"
+ , parseField Pos "pos"
+ , parseFieldDef QuadTree NormalQT "quadtree"
+ , parseField Quantum "quantum"
+ , parseField Rank "rank"
+ , parseField RankDir "rankdir"
+ , parseField RankSep "ranksep"
+ , parseField Ratio "ratio"
+ , parseField Rects "rects"
+ , parseFieldBool Regular "regular"
+ , parseFieldBool ReMinCross "remincross"
+ , parseField RepulsiveForce "repulsiveforce"
+ , parseFieldDef Root IsCentral "root"
+ , parseField Rotate "rotate"
+ , parseField Rotation "rotation"
+ , parseField SameHead "samehead"
+ , parseField SameTail "sametail"
+ , parseField SamplePoints "samplepoints"
+ , parseField Scale "scale"
+ , parseField SearchSize "searchsize"
+ , parseField Sep "sep"
+ , parseField Shape "shape"
+ , parseField ShowBoxes "showboxes"
+ , parseField Sides "sides"
+ , parseField Size "size"
+ , parseField Skew "skew"
+ , parseField Smoothing "smoothing"
+ , parseField SortV "sortv"
+ , parseFieldDef Splines SplineEdges "splines"
+ , parseField Start "start"
+ , parseField Style "style"
+ , parseField StyleSheet "stylesheet"
+ , parseFields TailURL ["tailURL", "tailhref"]
+ , parseField Tail_LP "tail_lp"
+ , parseFieldBool TailClip "tailclip"
+ , parseField TailLabel "taillabel"
+ , parseField TailPort "tailport"
+ , parseField TailTarget "tailtarget"
+ , parseField TailTooltip "tailtooltip"
+ , parseField Target "target"
+ , parseField Tooltip "tooltip"
+ , parseFieldBool TrueColor "truecolor"
+ , parseField Vertices "vertices"
+ , parseField ViewPort "viewport"
+ , parseField VoroMargin "voro_margin"
+ , parseField Weight "weight"
+ , parseField Width "width"
+ , parseField XDotVersion "xdotversion"
+ , parseField XLabel "xlabel"
+ , parseField XLP "xlp"
+ ])
+ `onFail`
+ do attrName <- stringBlock
+ liftEqParse ("UnknownAttribute (" ++ T.unpack attrName ++ ")")
+ (UnknownAttribute attrName)
+
+ parse = parseUnqt
+
+ parseList = parseUnqtList
+
+-- | Determine if this 'Attribute' is valid for use with Graphs.
+usedByGraphs :: Attribute -> Bool
+usedByGraphs Damping{} = True
+usedByGraphs K{} = True
+usedByGraphs URL{} = True
+usedByGraphs Background{} = True
+usedByGraphs BoundingBox{} = True
+usedByGraphs BgColor{} = True
+usedByGraphs Center{} = True
+usedByGraphs ClusterRank{} = True
+usedByGraphs ColorScheme{} = True
+usedByGraphs Comment{} = True
+usedByGraphs Compound{} = True
+usedByGraphs Concentrate{} = True
+usedByGraphs DefaultDist{} = True
+usedByGraphs Dim{} = True
+usedByGraphs Dimen{} = True
+usedByGraphs DirEdgeConstraints{} = True
+usedByGraphs DPI{} = True
+usedByGraphs Epsilon{} = True
+usedByGraphs ESep{} = True
+usedByGraphs FontColor{} = True
+usedByGraphs FontName{} = True
+usedByGraphs FontNames{} = True
+usedByGraphs FontPath{} = True
+usedByGraphs FontSize{} = True
+usedByGraphs ForceLabels{} = True
+usedByGraphs GradientAngle{} = True
+usedByGraphs ID{} = True
+usedByGraphs ImagePath{} = True
+usedByGraphs Label{} = True
+usedByGraphs LabelScheme{} = True
+usedByGraphs LabelJust{} = True
+usedByGraphs LabelLoc{} = True
+usedByGraphs Landscape{} = True
+usedByGraphs LayerListSep{} = True
+usedByGraphs Layers{} = True
+usedByGraphs LayerSelect{} = True
+usedByGraphs LayerSep{} = True
+usedByGraphs Layout{} = True
+usedByGraphs Levels{} = True
+usedByGraphs LevelsGap{} = True
+usedByGraphs LHeight{} = True
+usedByGraphs LPos{} = True
+usedByGraphs LWidth{} = True
+usedByGraphs Margin{} = True
+usedByGraphs MaxIter{} = True
+usedByGraphs MCLimit{} = True
+usedByGraphs MinDist{} = True
+usedByGraphs Mode{} = True
+usedByGraphs Model{} = True
+usedByGraphs Mosek{} = True
+usedByGraphs NodeSep{} = True
+usedByGraphs NoJustify{} = True
+usedByGraphs Normalize{} = True
+usedByGraphs Nslimit{} = True
+usedByGraphs Nslimit1{} = True
+usedByGraphs Ordering{} = True
+usedByGraphs OutputOrder{} = True
+usedByGraphs Overlap{} = True
+usedByGraphs OverlapScaling{} = True
+usedByGraphs OverlapShrink{} = True
+usedByGraphs Pack{} = True
+usedByGraphs PackMode{} = True
+usedByGraphs Pad{} = True
+usedByGraphs Page{} = True
+usedByGraphs PageDir{} = True
+usedByGraphs QuadTree{} = True
+usedByGraphs Quantum{} = True
+usedByGraphs RankDir{} = True
+usedByGraphs RankSep{} = True
+usedByGraphs Ratio{} = True
+usedByGraphs ReMinCross{} = True
+usedByGraphs RepulsiveForce{} = True
+usedByGraphs Root{} = True
+usedByGraphs Rotate{} = True
+usedByGraphs Rotation{} = True
+usedByGraphs Scale{} = True
+usedByGraphs SearchSize{} = True
+usedByGraphs Sep{} = True
+usedByGraphs ShowBoxes{} = True
+usedByGraphs Size{} = True
+usedByGraphs Smoothing{} = True
+usedByGraphs SortV{} = True
+usedByGraphs Splines{} = True
+usedByGraphs Start{} = True
+usedByGraphs Style{} = True
+usedByGraphs StyleSheet{} = True
+usedByGraphs Target{} = True
+usedByGraphs TrueColor{} = True
+usedByGraphs ViewPort{} = True
+usedByGraphs VoroMargin{} = True
+usedByGraphs XDotVersion{} = True
+usedByGraphs UnknownAttribute{} = True
+usedByGraphs _ = False
+
+-- | Determine if this 'Attribute' is valid for use with Clusters.
+usedByClusters :: Attribute -> Bool
+usedByClusters K{} = True
+usedByClusters URL{} = True
+usedByClusters Area{} = True
+usedByClusters BgColor{} = True
+usedByClusters Color{} = True
+usedByClusters ColorScheme{} = True
+usedByClusters FillColor{} = True
+usedByClusters FontColor{} = True
+usedByClusters FontName{} = True
+usedByClusters FontSize{} = True
+usedByClusters GradientAngle{} = True
+usedByClusters Label{} = True
+usedByClusters LabelJust{} = True
+usedByClusters LabelLoc{} = True
+usedByClusters Layer{} = True
+usedByClusters LHeight{} = True
+usedByClusters LPos{} = True
+usedByClusters LWidth{} = True
+usedByClusters Margin{} = True
+usedByClusters NoJustify{} = True
+usedByClusters PenColor{} = True
+usedByClusters PenWidth{} = True
+usedByClusters Peripheries{} = True
+usedByClusters Rank{} = True
+usedByClusters SortV{} = True
+usedByClusters Style{} = True
+usedByClusters Target{} = True
+usedByClusters Tooltip{} = True
+usedByClusters UnknownAttribute{} = True
+usedByClusters _ = False
+
+-- | Determine if this 'Attribute' is valid for use with SubGraphs.
+usedBySubGraphs :: Attribute -> Bool
+usedBySubGraphs Rank{} = True
+usedBySubGraphs UnknownAttribute{} = True
+usedBySubGraphs _ = False
+
+-- | Determine if this 'Attribute' is valid for use with Nodes.
+usedByNodes :: Attribute -> Bool
+usedByNodes URL{} = True
+usedByNodes Area{} = True
+usedByNodes Color{} = True
+usedByNodes ColorScheme{} = True
+usedByNodes Comment{} = True
+usedByNodes Distortion{} = True
+usedByNodes FillColor{} = True
+usedByNodes FixedSize{} = True
+usedByNodes FontColor{} = True
+usedByNodes FontName{} = True
+usedByNodes FontSize{} = True
+usedByNodes GradientAngle{} = True
+usedByNodes Group{} = True
+usedByNodes Height{} = True
+usedByNodes ID{} = True
+usedByNodes Image{} = True
+usedByNodes ImageScale{} = True
+usedByNodes InputScale{} = True
+usedByNodes Label{} = True
+usedByNodes LabelLoc{} = True
+usedByNodes Layer{} = True
+usedByNodes Margin{} = True
+usedByNodes NoJustify{} = True
+usedByNodes Ordering{} = True
+usedByNodes Orientation{} = True
+usedByNodes PenWidth{} = True
+usedByNodes Peripheries{} = True
+usedByNodes Pin{} = True
+usedByNodes Pos{} = True
+usedByNodes Rects{} = True
+usedByNodes Regular{} = True
+usedByNodes Root{} = True
+usedByNodes SamplePoints{} = True
+usedByNodes Shape{} = True
+usedByNodes ShowBoxes{} = True
+usedByNodes Sides{} = True
+usedByNodes Skew{} = True
+usedByNodes SortV{} = True
+usedByNodes Style{} = True
+usedByNodes Target{} = True
+usedByNodes Tooltip{} = True
+usedByNodes Vertices{} = True
+usedByNodes Width{} = True
+usedByNodes XLabel{} = True
+usedByNodes XLP{} = True
+usedByNodes UnknownAttribute{} = True
+usedByNodes _ = False
+
+-- | Determine if this 'Attribute' is valid for use with Edges.
+usedByEdges :: Attribute -> Bool
+usedByEdges URL{} = True
+usedByEdges ArrowHead{} = True
+usedByEdges ArrowSize{} = True
+usedByEdges ArrowTail{} = True
+usedByEdges Color{} = True
+usedByEdges ColorScheme{} = True
+usedByEdges Comment{} = True
+usedByEdges Constraint{} = True
+usedByEdges Decorate{} = True
+usedByEdges Dir{} = True
+usedByEdges EdgeURL{} = True
+usedByEdges EdgeTarget{} = True
+usedByEdges EdgeTooltip{} = True
+usedByEdges FillColor{} = True
+usedByEdges FontColor{} = True
+usedByEdges FontName{} = True
+usedByEdges FontSize{} = True
+usedByEdges HeadURL{} = True
+usedByEdges Head_LP{} = True
+usedByEdges HeadClip{} = True
+usedByEdges HeadLabel{} = True
+usedByEdges HeadPort{} = True
+usedByEdges HeadTarget{} = True
+usedByEdges HeadTooltip{} = True
+usedByEdges ID{} = True
+usedByEdges Label{} = True
+usedByEdges LabelURL{} = True
+usedByEdges LabelAngle{} = True
+usedByEdges LabelDistance{} = True
+usedByEdges LabelFloat{} = True
+usedByEdges LabelFontColor{} = True
+usedByEdges LabelFontName{} = True
+usedByEdges LabelFontSize{} = True
+usedByEdges LabelTarget{} = True
+usedByEdges LabelTooltip{} = True
+usedByEdges Layer{} = True
+usedByEdges Len{} = True
+usedByEdges LHead{} = True
+usedByEdges LPos{} = True
+usedByEdges LTail{} = True
+usedByEdges MinLen{} = True
+usedByEdges NoJustify{} = True
+usedByEdges PenWidth{} = True
+usedByEdges Pos{} = True
+usedByEdges SameHead{} = True
+usedByEdges SameTail{} = True
+usedByEdges ShowBoxes{} = True
+usedByEdges Style{} = True
+usedByEdges TailURL{} = True
+usedByEdges Tail_LP{} = True
+usedByEdges TailClip{} = True
+usedByEdges TailLabel{} = True
+usedByEdges TailPort{} = True
+usedByEdges TailTarget{} = True
+usedByEdges TailTooltip{} = True
+usedByEdges Target{} = True
+usedByEdges Tooltip{} = True
+usedByEdges Weight{} = True
+usedByEdges XLabel{} = True
+usedByEdges XLP{} = True
+usedByEdges UnknownAttribute{} = True
+usedByEdges _ = False
+
+-- | Determine if two 'Attributes' are the same type of 'Attribute'.
+sameAttribute :: Attribute -> Attribute -> Bool
+sameAttribute Damping{} Damping{} = True
+sameAttribute K{} K{} = True
+sameAttribute URL{} URL{} = True
+sameAttribute Area{} Area{} = True
+sameAttribute ArrowHead{} ArrowHead{} = True
+sameAttribute ArrowSize{} ArrowSize{} = True
+sameAttribute ArrowTail{} ArrowTail{} = True
+sameAttribute Background{} Background{} = True
+sameAttribute BoundingBox{} BoundingBox{} = True
+sameAttribute BgColor{} BgColor{} = True
+sameAttribute Center{} Center{} = True
+sameAttribute ClusterRank{} ClusterRank{} = True
+sameAttribute Color{} Color{} = True
+sameAttribute ColorScheme{} ColorScheme{} = True
+sameAttribute Comment{} Comment{} = True
+sameAttribute Compound{} Compound{} = True
+sameAttribute Concentrate{} Concentrate{} = True
+sameAttribute Constraint{} Constraint{} = True
+sameAttribute Decorate{} Decorate{} = True
+sameAttribute DefaultDist{} DefaultDist{} = True
+sameAttribute Dim{} Dim{} = True
+sameAttribute Dimen{} Dimen{} = True
+sameAttribute Dir{} Dir{} = True
+sameAttribute DirEdgeConstraints{} DirEdgeConstraints{} = True
+sameAttribute Distortion{} Distortion{} = True
+sameAttribute DPI{} DPI{} = True
+sameAttribute EdgeURL{} EdgeURL{} = True
+sameAttribute EdgeTarget{} EdgeTarget{} = True
+sameAttribute EdgeTooltip{} EdgeTooltip{} = True
+sameAttribute Epsilon{} Epsilon{} = True
+sameAttribute ESep{} ESep{} = True
+sameAttribute FillColor{} FillColor{} = True
+sameAttribute FixedSize{} FixedSize{} = True
+sameAttribute FontColor{} FontColor{} = True
+sameAttribute FontName{} FontName{} = True
+sameAttribute FontNames{} FontNames{} = True
+sameAttribute FontPath{} FontPath{} = True
+sameAttribute FontSize{} FontSize{} = True
+sameAttribute ForceLabels{} ForceLabels{} = True
+sameAttribute GradientAngle{} GradientAngle{} = True
+sameAttribute Group{} Group{} = True
+sameAttribute HeadURL{} HeadURL{} = True
+sameAttribute Head_LP{} Head_LP{} = True
+sameAttribute HeadClip{} HeadClip{} = True
+sameAttribute HeadLabel{} HeadLabel{} = True
+sameAttribute HeadPort{} HeadPort{} = True
+sameAttribute HeadTarget{} HeadTarget{} = True
+sameAttribute HeadTooltip{} HeadTooltip{} = True
+sameAttribute Height{} Height{} = True
+sameAttribute ID{} ID{} = True
+sameAttribute Image{} Image{} = True
+sameAttribute ImagePath{} ImagePath{} = True
+sameAttribute ImageScale{} ImageScale{} = True
+sameAttribute InputScale{} InputScale{} = True
+sameAttribute Label{} Label{} = True
+sameAttribute LabelURL{} LabelURL{} = True
+sameAttribute LabelScheme{} LabelScheme{} = True
+sameAttribute LabelAngle{} LabelAngle{} = True
+sameAttribute LabelDistance{} LabelDistance{} = True
+sameAttribute LabelFloat{} LabelFloat{} = True
+sameAttribute LabelFontColor{} LabelFontColor{} = True
+sameAttribute LabelFontName{} LabelFontName{} = True
+sameAttribute LabelFontSize{} LabelFontSize{} = True
+sameAttribute LabelJust{} LabelJust{} = True
+sameAttribute LabelLoc{} LabelLoc{} = True
+sameAttribute LabelTarget{} LabelTarget{} = True
+sameAttribute LabelTooltip{} LabelTooltip{} = True
+sameAttribute Landscape{} Landscape{} = True
+sameAttribute Layer{} Layer{} = True
+sameAttribute LayerListSep{} LayerListSep{} = True
+sameAttribute Layers{} Layers{} = True
+sameAttribute LayerSelect{} LayerSelect{} = True
+sameAttribute LayerSep{} LayerSep{} = True
+sameAttribute Layout{} Layout{} = True
+sameAttribute Len{} Len{} = True
+sameAttribute Levels{} Levels{} = True
+sameAttribute LevelsGap{} LevelsGap{} = True
+sameAttribute LHead{} LHead{} = True
+sameAttribute LHeight{} LHeight{} = True
+sameAttribute LPos{} LPos{} = True
+sameAttribute LTail{} LTail{} = True
+sameAttribute LWidth{} LWidth{} = True
+sameAttribute Margin{} Margin{} = True
+sameAttribute MaxIter{} MaxIter{} = True
+sameAttribute MCLimit{} MCLimit{} = True
+sameAttribute MinDist{} MinDist{} = True
+sameAttribute MinLen{} MinLen{} = True
+sameAttribute Mode{} Mode{} = True
+sameAttribute Model{} Model{} = True
+sameAttribute Mosek{} Mosek{} = True
+sameAttribute NodeSep{} NodeSep{} = True
+sameAttribute NoJustify{} NoJustify{} = True
+sameAttribute Normalize{} Normalize{} = True
+sameAttribute Nslimit{} Nslimit{} = True
+sameAttribute Nslimit1{} Nslimit1{} = True
+sameAttribute Ordering{} Ordering{} = True
+sameAttribute Orientation{} Orientation{} = True
+sameAttribute OutputOrder{} OutputOrder{} = True
+sameAttribute Overlap{} Overlap{} = True
+sameAttribute OverlapScaling{} OverlapScaling{} = True
+sameAttribute OverlapShrink{} OverlapShrink{} = True
+sameAttribute Pack{} Pack{} = True
+sameAttribute PackMode{} PackMode{} = True
+sameAttribute Pad{} Pad{} = True
+sameAttribute Page{} Page{} = True
+sameAttribute PageDir{} PageDir{} = True
+sameAttribute PenColor{} PenColor{} = True
+sameAttribute PenWidth{} PenWidth{} = True
+sameAttribute Peripheries{} Peripheries{} = True
+sameAttribute Pin{} Pin{} = True
+sameAttribute Pos{} Pos{} = True
+sameAttribute QuadTree{} QuadTree{} = True
+sameAttribute Quantum{} Quantum{} = True
+sameAttribute Rank{} Rank{} = True
+sameAttribute RankDir{} RankDir{} = True
+sameAttribute RankSep{} RankSep{} = True
+sameAttribute Ratio{} Ratio{} = True
+sameAttribute Rects{} Rects{} = True
+sameAttribute Regular{} Regular{} = True
+sameAttribute ReMinCross{} ReMinCross{} = True
+sameAttribute RepulsiveForce{} RepulsiveForce{} = True
+sameAttribute Root{} Root{} = True
+sameAttribute Rotate{} Rotate{} = True
+sameAttribute Rotation{} Rotation{} = True
+sameAttribute SameHead{} SameHead{} = True
+sameAttribute SameTail{} SameTail{} = True
+sameAttribute SamplePoints{} SamplePoints{} = True
+sameAttribute Scale{} Scale{} = True
+sameAttribute SearchSize{} SearchSize{} = True
+sameAttribute Sep{} Sep{} = True
+sameAttribute Shape{} Shape{} = True
+sameAttribute ShowBoxes{} ShowBoxes{} = True
+sameAttribute Sides{} Sides{} = True
+sameAttribute Size{} Size{} = True
+sameAttribute Skew{} Skew{} = True
+sameAttribute Smoothing{} Smoothing{} = True
+sameAttribute SortV{} SortV{} = True
+sameAttribute Splines{} Splines{} = True
+sameAttribute Start{} Start{} = True
+sameAttribute Style{} Style{} = True
+sameAttribute StyleSheet{} StyleSheet{} = True
+sameAttribute TailURL{} TailURL{} = True
+sameAttribute Tail_LP{} Tail_LP{} = True
+sameAttribute TailClip{} TailClip{} = True
+sameAttribute TailLabel{} TailLabel{} = True
+sameAttribute TailPort{} TailPort{} = True
+sameAttribute TailTarget{} TailTarget{} = True
+sameAttribute TailTooltip{} TailTooltip{} = True
+sameAttribute Target{} Target{} = True
+sameAttribute Tooltip{} Tooltip{} = True
+sameAttribute TrueColor{} TrueColor{} = True
+sameAttribute Vertices{} Vertices{} = True
+sameAttribute ViewPort{} ViewPort{} = True
+sameAttribute VoroMargin{} VoroMargin{} = True
+sameAttribute Weight{} Weight{} = True
+sameAttribute Width{} Width{} = True
+sameAttribute XDotVersion{} XDotVersion{} = True
+sameAttribute XLabel{} XLabel{} = True
+sameAttribute XLP{} XLP{} = True
+sameAttribute (UnknownAttribute a1 _) (UnknownAttribute a2 _) = a1 == a2
+sameAttribute _ _ = False
+
+-- | Return the default value for a specific 'Attribute' if possible; graph/cluster values are preferred over node/edge values.
+defaultAttributeValue :: Attribute -> Maybe Attribute
+defaultAttributeValue Damping{} = Just $ Damping 0.99
+defaultAttributeValue K{} = Just $ K 0.3
+defaultAttributeValue URL{} = Just $ URL ""
+defaultAttributeValue Area{} = Just $ Area 1.0
+defaultAttributeValue ArrowHead{} = Just $ ArrowHead normal
+defaultAttributeValue ArrowSize{} = Just $ ArrowSize 1.0
+defaultAttributeValue ArrowTail{} = Just $ ArrowTail normal
+defaultAttributeValue Background{} = Just $ Background ""
+defaultAttributeValue BgColor{} = Just $ BgColor []
+defaultAttributeValue Center{} = Just $ Center False
+defaultAttributeValue ClusterRank{} = Just $ ClusterRank Local
+defaultAttributeValue Color{} = Just $ Color [toWColor Black]
+defaultAttributeValue ColorScheme{} = Just $ ColorScheme X11
+defaultAttributeValue Comment{} = Just $ Comment ""
+defaultAttributeValue Compound{} = Just $ Compound False
+defaultAttributeValue Concentrate{} = Just $ Concentrate False
+defaultAttributeValue Constraint{} = Just $ Constraint True
+defaultAttributeValue Decorate{} = Just $ Decorate False
+defaultAttributeValue Dim{} = Just $ Dim 2
+defaultAttributeValue Dimen{} = Just $ Dimen 2
+defaultAttributeValue DirEdgeConstraints{} = Just $ DirEdgeConstraints NoConstraints
+defaultAttributeValue Distortion{} = Just $ Distortion 0.0
+defaultAttributeValue DPI{} = Just $ DPI 96.0
+defaultAttributeValue EdgeURL{} = Just $ EdgeURL ""
+defaultAttributeValue EdgeTooltip{} = Just $ EdgeTooltip ""
+defaultAttributeValue ESep{} = Just $ ESep (DVal 3)
+defaultAttributeValue FillColor{} = Just $ FillColor [toWColor Black]
+defaultAttributeValue FixedSize{} = Just $ FixedSize GrowAsNeeded
+defaultAttributeValue FontColor{} = Just $ FontColor (X11Color Black)
+defaultAttributeValue FontName{} = Just $ FontName "Times-Roman"
+defaultAttributeValue FontNames{} = Just $ FontNames SvgNames
+defaultAttributeValue FontSize{} = Just $ FontSize 14.0
+defaultAttributeValue ForceLabels{} = Just $ ForceLabels True
+defaultAttributeValue GradientAngle{} = Just $ GradientAngle 0
+defaultAttributeValue Group{} = Just $ Group ""
+defaultAttributeValue HeadURL{} = Just $ HeadURL ""
+defaultAttributeValue HeadClip{} = Just $ HeadClip True
+defaultAttributeValue HeadLabel{} = Just $ HeadLabel (StrLabel "")
+defaultAttributeValue HeadPort{} = Just $ HeadPort (CompassPoint CenterPoint)
+defaultAttributeValue HeadTarget{} = Just $ HeadTarget ""
+defaultAttributeValue HeadTooltip{} = Just $ HeadTooltip ""
+defaultAttributeValue Height{} = Just $ Height 0.5
+defaultAttributeValue ID{} = Just $ ID ""
+defaultAttributeValue Image{} = Just $ Image ""
+defaultAttributeValue ImagePath{} = Just $ ImagePath (Paths [])
+defaultAttributeValue ImageScale{} = Just $ ImageScale NoScale
+defaultAttributeValue Label{} = Just $ Label (StrLabel "")
+defaultAttributeValue LabelURL{} = Just $ LabelURL ""
+defaultAttributeValue LabelScheme{} = Just $ LabelScheme NotEdgeLabel
+defaultAttributeValue LabelAngle{} = Just $ LabelAngle (-25.0)
+defaultAttributeValue LabelDistance{} = Just $ LabelDistance 1.0
+defaultAttributeValue LabelFloat{} = Just $ LabelFloat False
+defaultAttributeValue LabelFontColor{} = Just $ LabelFontColor (X11Color Black)
+defaultAttributeValue LabelFontName{} = Just $ LabelFontName "Times-Roman"
+defaultAttributeValue LabelFontSize{} = Just $ LabelFontSize 14.0
+defaultAttributeValue LabelJust{} = Just $ LabelJust JCenter
+defaultAttributeValue LabelLoc{} = Just $ LabelLoc VTop
+defaultAttributeValue LabelTarget{} = Just $ LabelTarget ""
+defaultAttributeValue LabelTooltip{} = Just $ LabelTooltip ""
+defaultAttributeValue Landscape{} = Just $ Landscape False
+defaultAttributeValue Layer{} = Just $ Layer []
+defaultAttributeValue LayerListSep{} = Just $ LayerListSep (LLSep ",")
+defaultAttributeValue Layers{} = Just $ Layers (LL [])
+defaultAttributeValue LayerSelect{} = Just $ LayerSelect []
+defaultAttributeValue LayerSep{} = Just $ LayerSep (LSep " :\t")
+defaultAttributeValue Levels{} = Just $ Levels maxBound
+defaultAttributeValue LevelsGap{} = Just $ LevelsGap 0.0
+defaultAttributeValue LHead{} = Just $ LHead ""
+defaultAttributeValue LTail{} = Just $ LTail ""
+defaultAttributeValue MCLimit{} = Just $ MCLimit 1.0
+defaultAttributeValue MinDist{} = Just $ MinDist 1.0
+defaultAttributeValue MinLen{} = Just $ MinLen 1
+defaultAttributeValue Mode{} = Just $ Mode Major
+defaultAttributeValue Model{} = Just $ Model ShortPath
+defaultAttributeValue Mosek{} = Just $ Mosek False
+defaultAttributeValue NodeSep{} = Just $ NodeSep 0.25
+defaultAttributeValue NoJustify{} = Just $ NoJustify False
+defaultAttributeValue Normalize{} = Just $ Normalize NotNormalized
+defaultAttributeValue Orientation{} = Just $ Orientation 0.0
+defaultAttributeValue OutputOrder{} = Just $ OutputOrder BreadthFirst
+defaultAttributeValue Overlap{} = Just $ Overlap KeepOverlaps
+defaultAttributeValue OverlapScaling{} = Just $ OverlapScaling (-4)
+defaultAttributeValue OverlapShrink{} = Just $ OverlapShrink True
+defaultAttributeValue Pack{} = Just $ Pack DontPack
+defaultAttributeValue PackMode{} = Just $ PackMode PackNode
+defaultAttributeValue Pad{} = Just $ Pad (DVal 0.0555)
+defaultAttributeValue PageDir{} = Just $ PageDir Bl
+defaultAttributeValue PenColor{} = Just $ PenColor (X11Color Black)
+defaultAttributeValue PenWidth{} = Just $ PenWidth 1.0
+defaultAttributeValue Peripheries{} = Just $ Peripheries 1
+defaultAttributeValue Pin{} = Just $ Pin False
+defaultAttributeValue QuadTree{} = Just $ QuadTree NormalQT
+defaultAttributeValue Quantum{} = Just $ Quantum 0
+defaultAttributeValue RankDir{} = Just $ RankDir FromTop
+defaultAttributeValue Regular{} = Just $ Regular False
+defaultAttributeValue ReMinCross{} = Just $ ReMinCross False
+defaultAttributeValue RepulsiveForce{} = Just $ RepulsiveForce 1.0
+defaultAttributeValue Root{} = Just $ Root (NodeName "")
+defaultAttributeValue Rotate{} = Just $ Rotate 0
+defaultAttributeValue Rotation{} = Just $ Rotation 0
+defaultAttributeValue SameHead{} = Just $ SameHead ""
+defaultAttributeValue SameTail{} = Just $ SameTail ""
+defaultAttributeValue SearchSize{} = Just $ SearchSize 30
+defaultAttributeValue Sep{} = Just $ Sep (DVal 4)
+defaultAttributeValue Shape{} = Just $ Shape Ellipse
+defaultAttributeValue ShowBoxes{} = Just $ ShowBoxes 0
+defaultAttributeValue Sides{} = Just $ Sides 4
+defaultAttributeValue Skew{} = Just $ Skew 0.0
+defaultAttributeValue Smoothing{} = Just $ Smoothing NoSmooth
+defaultAttributeValue SortV{} = Just $ SortV 0
+defaultAttributeValue StyleSheet{} = Just $ StyleSheet ""
+defaultAttributeValue TailURL{} = Just $ TailURL ""
+defaultAttributeValue TailClip{} = Just $ TailClip True
+defaultAttributeValue TailLabel{} = Just $ TailLabel (StrLabel "")
+defaultAttributeValue TailPort{} = Just $ TailPort (CompassPoint CenterPoint)
+defaultAttributeValue TailTarget{} = Just $ TailTarget ""
+defaultAttributeValue TailTooltip{} = Just $ TailTooltip ""
+defaultAttributeValue Target{} = Just $ Target ""
+defaultAttributeValue Tooltip{} = Just $ Tooltip ""
+defaultAttributeValue VoroMargin{} = Just $ VoroMargin 0.05
+defaultAttributeValue Weight{} = Just $ Weight (Int 1)
+defaultAttributeValue Width{} = Just $ Width 0.75
+defaultAttributeValue XLabel{} = Just $ XLabel (StrLabel "")
+defaultAttributeValue _ = Nothing
+
+-- | Determine if the provided 'Text' value is a valid name for an 'UnknownAttribute'.
+validUnknown :: AttributeName -> Bool
+validUnknown txt = T.toLower txt `S.notMember` names
+ && isIDString txt
+ where
+ names = (S.fromList . map T.toLower
+ $ [ "Damping"
+ , "K"
+ , "URL"
+ , "href"
+ , "area"
+ , "arrowhead"
+ , "arrowsize"
+ , "arrowtail"
+ , "_background"
+ , "bb"
+ , "bgcolor"
+ , "center"
+ , "clusterrank"
+ , "color"
+ , "colorscheme"
+ , "comment"
+ , "compound"
+ , "concentrate"
+ , "constraint"
+ , "decorate"
+ , "defaultdist"
+ , "dim"
+ , "dimen"
+ , "dir"
+ , "diredgeconstraints"
+ , "distortion"
+ , "dpi"
+ , "resolution"
+ , "edgeURL"
+ , "edgehref"
+ , "edgetarget"
+ , "edgetooltip"
+ , "epsilon"
+ , "esep"
+ , "fillcolor"
+ , "fixedsize"
+ , "fontcolor"
+ , "fontname"
+ , "fontnames"
+ , "fontpath"
+ , "fontsize"
+ , "forcelabels"
+ , "gradientangle"
+ , "group"
+ , "headURL"
+ , "headhref"
+ , "head_lp"
+ , "headclip"
+ , "headlabel"
+ , "headport"
+ , "headtarget"
+ , "headtooltip"
+ , "height"
+ , "id"
+ , "image"
+ , "imagepath"
+ , "imagescale"
+ , "inputscale"
+ , "label"
+ , "labelURL"
+ , "labelhref"
+ , "label_scheme"
+ , "labelangle"
+ , "labeldistance"
+ , "labelfloat"
+ , "labelfontcolor"
+ , "labelfontname"
+ , "labelfontsize"
+ , "labeljust"
+ , "labelloc"
+ , "labeltarget"
+ , "labeltooltip"
+ , "landscape"
+ , "layer"
+ , "layerlistsep"
+ , "layers"
+ , "layerselect"
+ , "layersep"
+ , "layout"
+ , "len"
+ , "levels"
+ , "levelsgap"
+ , "lhead"
+ , "LHeight"
+ , "lp"
+ , "ltail"
+ , "lwidth"
+ , "margin"
+ , "maxiter"
+ , "mclimit"
+ , "mindist"
+ , "minlen"
+ , "mode"
+ , "model"
+ , "mosek"
+ , "nodesep"
+ , "nojustify"
+ , "normalize"
+ , "nslimit"
+ , "nslimit1"
+ , "ordering"
+ , "orientation"
+ , "outputorder"
+ , "overlap"
+ , "overlap_scaling"
+ , "overlap_shrink"
+ , "pack"
+ , "packmode"
+ , "pad"
+ , "page"
+ , "pagedir"
+ , "pencolor"
+ , "penwidth"
+ , "peripheries"
+ , "pin"
+ , "pos"
+ , "quadtree"
+ , "quantum"
+ , "rank"
+ , "rankdir"
+ , "ranksep"
+ , "ratio"
+ , "rects"
+ , "regular"
+ , "remincross"
+ , "repulsiveforce"
+ , "root"
+ , "rotate"
+ , "rotation"
+ , "samehead"
+ , "sametail"
+ , "samplepoints"
+ , "scale"
+ , "searchsize"
+ , "sep"
+ , "shape"
+ , "showboxes"
+ , "sides"
+ , "size"
+ , "skew"
+ , "smoothing"
+ , "sortv"
+ , "splines"
+ , "start"
+ , "style"
+ , "stylesheet"
+ , "tailURL"
+ , "tailhref"
+ , "tail_lp"
+ , "tailclip"
+ , "taillabel"
+ , "tailport"
+ , "tailtarget"
+ , "tailtooltip"
+ , "target"
+ , "tooltip"
+ , "truecolor"
+ , "vertices"
+ , "viewport"
+ , "voro_margin"
+ , "weight"
+ , "width"
+ , "xdotversion"
+ , "xlabel"
+ , "xlp"
+ , "charset" -- Defined upstream, just not used here.
+ ])
+ `S.union`
+ keywords
+{- Delete to here -}
+
+-- | Remove attributes that we don't want to consider:
+--
+-- * Those that are defaults
+-- * colorscheme (as the colors embed it anyway)
+rmUnwantedAttributes :: Attributes -> Attributes
+rmUnwantedAttributes = filter (not . (`any` tests) . flip ($))
+ where
+ tests = [isDefault, isColorScheme]
+
+ isDefault a = maybe False (a==) $ defaultAttributeValue a
+
+ isColorScheme ColorScheme{} = True
+ isColorScheme _ = False
+
+-- -----------------------------------------------------------------------------
+-- These parsing combinators are defined here for customisation purposes.
+
+parseField :: (ParseDot a) => (a -> Attribute) -> String
+ -> [(String, Parse Attribute)]
+parseField c fld = [(fld, liftEqParse fld c)]
+
+parseFields :: (ParseDot a) => (a -> Attribute) -> [String]
+ -> [(String, Parse Attribute)]
+parseFields c = concatMap (parseField c)
+
+parseFieldBool :: (Bool -> Attribute) -> String -> [(String, Parse Attribute)]
+parseFieldBool = (`parseFieldDef` True)
+
+-- | For 'Bool'-like data structures where the presence of the field
+-- name without a value implies a default value.
+parseFieldDef :: (ParseDot a) => (a -> Attribute) -> a -> String
+ -> [(String, Parse Attribute)]
+parseFieldDef c d fld = [(fld, p)]
+ where
+ p = liftEqParse fld c
+ `onFail`
+ do nxt <- optional $ satisfy restIDString
+ bool (fail "Not actually the field you were after")
+ (return $ c d)
+ (isNothing nxt)
+
+-- | Attempt to parse the @\"=value\"@ part of a @key=value@ pair. If
+-- there is an equal sign but the @value@ part doesn't parse, throw
+-- an un-recoverable error.
+liftEqParse :: (ParseDot a) => String -> (a -> Attribute) -> Parse Attribute
+liftEqParse k c = do pStrict <- getsGS parseStrictly
+ let adjErr = bool adjustErr adjustErrBad pStrict
+ parseEq
+ *> ( hasDef (fmap c parse)
+ `adjErr`
+ (("Unable to parse key=value with key of " ++ k
+ ++ "\n\t") ++)
+ )
+ where
+ hasDef p = maybe p (onFail p . (`stringRep` "\"\""))
+ . defaultAttributeValue $ c undefined
+
+-- -----------------------------------------------------------------------------
+
+{- | If performing any custom pre-/post-processing on Dot code, you
+ may wish to utilise some custom 'Attributes'. These are wrappers
+ around the 'UnknownAttribute' constructor (and thus 'CustomAttribute'
+ is just an alias for 'Attribute').
+
+ You should ensure that 'validUnknown' is 'True' for any potential
+ custom attribute name.
+
+-}
+type CustomAttribute = Attribute
+
+-- | Create a custom attribute.
+customAttribute :: AttributeName -> Text -> CustomAttribute
+customAttribute = UnknownAttribute
+
+-- | Determines whether or not this is a custom attribute.
+isCustom :: Attribute -> Bool
+isCustom UnknownAttribute{} = True
+isCustom _ = False
+
+isSpecifiedCustom :: AttributeName -> Attribute -> Bool
+isSpecifiedCustom nm (UnknownAttribute nm' _) = nm == nm'
+isSpecifiedCustom _ _ = False
+
+-- | The value of a custom attribute. Will throw a
+-- 'GraphvizException' if the provided 'Attribute' isn't a custom
+-- one.
+customValue :: CustomAttribute -> Text
+customValue (UnknownAttribute _ v) = v
+customValue attr = throw . NotCustomAttr . T.unpack
+ $ printIt attr
+
+-- | The name of a custom attribute. Will throw a
+-- 'GraphvizException' if the provided 'Attribute' isn't a custom
+-- one.
+customName :: CustomAttribute -> AttributeName
+customName (UnknownAttribute nm _) = nm
+customName attr = throw . NotCustomAttr . T.unpack
+ $ printIt attr
+
+-- | Returns all custom attributes and the list of non-custom Attributes.
+findCustoms :: Attributes -> ([CustomAttribute], Attributes)
+findCustoms = partition isCustom
+
+-- | Find the (first instance of the) specified custom attribute and
+-- returns it along with all other Attributes.
+findSpecifiedCustom :: AttributeName -> Attributes
+ -> Maybe (CustomAttribute, Attributes)
+findSpecifiedCustom nm attrs
+ = case break (isSpecifiedCustom nm) attrs of
+ (bf,cust:aft) -> Just (cust, bf ++ aft)
+ _ -> Nothing
+
+-- | Delete all custom attributes (actually, this will delete all
+-- 'UnknownAttribute' values; as such it can also be used to remove
+-- legacy attributes).
+deleteCustomAttributes :: Attributes -> Attributes
+deleteCustomAttributes = filter (not . isCustom)
+
+-- | Removes all instances of the specified custom attribute.
+deleteSpecifiedCustom :: AttributeName -> Attributes -> Attributes
+deleteSpecifiedCustom nm = filter (not . isSpecifiedCustom nm)
diff --git a/Data/GraphViz/Attributes/HTML.hs b/Data/GraphViz/Attributes/HTML.hs
--- a/Data/GraphViz/Attributes/HTML.hs
+++ b/Data/GraphViz/Attributes/HTML.hs
@@ -67,20 +67,20 @@
, Scale(..)
) where
-import Data.GraphViz.Parsing
-import Data.GraphViz.Printing
import Data.GraphViz.Attributes.Colors
import Data.GraphViz.Attributes.Internal
-import Data.GraphViz.Util(bool)
+import Data.GraphViz.Internal.Util (bool)
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
-import Numeric(readHex)
-import Data.Char(chr, ord, isSpace)
-import Data.Function(on)
-import Data.List(delete)
-import Data.Maybe(catMaybes, listToMaybe)
-import Data.Word(Word8, Word16)
-import qualified Data.Map as Map
+import Data.Char (chr, isSpace, ord)
+import Data.Function (on)
+import Data.List (delete)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes, listToMaybe)
import qualified Data.Text.Lazy as T
+import Data.Word (Word16, Word8)
+import Numeric (readHex)
-- -----------------------------------------------------------------------------
@@ -154,11 +154,11 @@
parseList = parseUnqtList
data Format = Italics
- | Bold
- | Underline
- | Subscript
- | Superscript
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
+ | Bold
+ | Underline
+ | Subscript
+ | Superscript
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
instance PrintDot Format where
unqtDot Italics = text "I"
@@ -263,7 +263,7 @@
instance ParseDot Cell where
parseUnqt = oneOf [ parseCell LabelCell parse
- , parseCell ImgCell $ wrapWhitespace parseUnqt
+ , parseCell ImgCell $ wrapWhitespace parse
, parseEmptyTag (const VerticalRule) "VR"
]
`adjustErr`
@@ -412,6 +412,8 @@
)
-- Can't use liftEqParse, etc. here because it causes backtracking
-- problems when the attributes could apply to multiple constructors.
+-- This includes using commit! (Example: if it starts with a FONT tag,
+-- is it a Table or Text?
-- | Specifies horizontal placement. When an object is allocated more
-- space than required, this value determines where the extra space
diff --git a/Data/GraphViz/Attributes/Internal.hs b/Data/GraphViz/Attributes/Internal.hs
--- a/Data/GraphViz/Attributes/Internal.hs
+++ b/Data/GraphViz/Attributes/Internal.hs
@@ -9,7 +9,8 @@
Maintainer : Ivan.Miljenovic@gmail.com
This module is defined so as to avoid exposing internal functions
- in the external API.
+ in the external API. These are those that are needed for the
+ testsuite.
-}
@@ -24,10 +25,10 @@
import Data.GraphViz.Parsing
import Data.GraphViz.Printing
-import Data.Maybe(isNothing)
-import qualified Data.Map as Map
-import Data.Map(Map)
-import Data.Text.Lazy(Text)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (isNothing)
+import Data.Text.Lazy (Text)
-- -----------------------------------------------------------------------------
diff --git a/Data/GraphViz/Attributes/Values.hs b/Data/GraphViz/Attributes/Values.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Attributes/Values.hs
@@ -0,0 +1,1631 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_HADDOCK hide #-}
+{- |
+ Module : Data.GraphViz.Attributes.Values
+ Description : Values for use with the Attribute data type
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ Defined to have smaller modules and thus faster compilation times.
+
+ -}
+module Data.GraphViz.Attributes.Values where
+
+import qualified Data.GraphViz.Attributes.HTML as Html
+import Data.GraphViz.Attributes.Internal
+import Data.GraphViz.Internal.State (getLayerListSep,
+ getLayerSep,
+ setLayerListSep,
+ setLayerSep)
+import Data.GraphViz.Internal.Util (bool, stringToInt)
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
+
+import Data.List (intercalate)
+import Data.Maybe (isJust)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import Data.Word (Word16)
+import System.FilePath (searchPathSeparator, splitSearchPath)
+
+-- -----------------------------------------------------------------------------
+
+{- |
+
+ Some 'Attribute's (mainly label-like ones) take a 'String' argument
+ that allows for extra escape codes. This library doesn't do any
+ extra checks or special parsing for these escape codes, but usage
+ of 'EscString' rather than 'Text' indicates that the Graphviz
+ tools will recognise these extra escape codes for these
+ 'Attribute's.
+
+ The extra escape codes include (note that these are all Strings):
+
+ [@\\N@] Replace with the name of the node (for Node 'Attribute's).
+
+ [@\\G@] Replace with the name of the graph (for Node 'Attribute's)
+ or the name of the graph or cluster, whichever is
+ applicable (for Graph, Cluster and Edge 'Attribute's).
+
+ [@\\E@] Replace with the name of the edge, formed by the two
+ adjoining nodes and the edge type (for Edge 'Attribute's).
+
+ [@\\T@] Replace with the name of the tail node (for Edge
+ 'Attribute's).
+
+ [@\\H@] Replace with the name of the head node (for Edge
+ 'Attribute's).
+
+ [@\\L@] Replace with the object's label (for all 'Attribute's).
+
+ Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or
+ 'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines
+ centered, left-justified and right-justified respectively.
+
+ -}
+type EscString = Text
+
+-- -----------------------------------------------------------------------------
+
+-- | Should only have 2D points (i.e. created with 'createPoint').
+data Rect = Rect Point Point
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Rect where
+ unqtDot (Rect p1 p2) = printPoint2DUnqt p1 <> comma <> printPoint2DUnqt p2
+
+ toDot = dquotes . unqtDot
+
+ unqtListToDot = hsep . mapM unqtDot
+
+instance ParseDot Rect where
+ parseUnqt = uncurry Rect <$> commaSep' parsePoint2D parsePoint2D
+
+ parse = quotedParse parseUnqt
+
+ parseUnqtList = sepBy1 parseUnqt whitespace1
+
+-- -----------------------------------------------------------------------------
+
+-- | If 'Local', then sub-graphs that are clusters are given special
+-- treatment. 'Global' and 'NoCluster' currently appear to be
+-- identical and turn off the special cluster processing.
+data ClusterMode = Local
+ | Global
+ | NoCluster
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot ClusterMode where
+ unqtDot Local = text "local"
+ unqtDot Global = text "global"
+ unqtDot NoCluster = text "none"
+
+instance ParseDot ClusterMode where
+ parseUnqt = oneOf [ stringRep Local "local"
+ , stringRep Global "global"
+ , stringRep NoCluster "none"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | Specify where to place arrow heads on an edge.
+data DirType = Forward -- ^ Draw a directed edge with an arrow to the
+ -- node it's pointing go.
+ | Back -- ^ Draw a reverse directed edge with an arrow
+ -- to the node it's coming from.
+ | Both -- ^ Draw arrows on both ends of the edge.
+ | NoDir -- ^ Draw an undirected edge.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot DirType where
+ unqtDot Forward = text "forward"
+ unqtDot Back = text "back"
+ unqtDot Both = text "both"
+ unqtDot NoDir = text "none"
+
+instance ParseDot DirType where
+ parseUnqt = oneOf [ stringRep Forward "forward"
+ , stringRep Back "back"
+ , stringRep Both "both"
+ , stringRep NoDir "none"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | Only when @mode == 'IpSep'@.
+data DEConstraints = EdgeConstraints
+ | NoConstraints
+ | HierConstraints
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot DEConstraints where
+ unqtDot EdgeConstraints = unqtDot True
+ unqtDot NoConstraints = unqtDot False
+ unqtDot HierConstraints = text "hier"
+
+instance ParseDot DEConstraints where
+ parseUnqt = fmap (bool NoConstraints EdgeConstraints) parse
+ `onFail`
+ stringRep HierConstraints "hier"
+
+-- -----------------------------------------------------------------------------
+
+-- | Either a 'Double' or a (2D) 'Point' (i.e. created with
+-- 'createPoint').
+--
+-- Whilst it is possible to create a 'Point' value with either a
+-- third co-ordinate or a forced position, these are ignored for
+-- printing/parsing.
+--
+-- An optional prefix of @\'+\'@ is allowed when parsing.
+data DPoint = DVal Double
+ | PVal Point
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot DPoint where
+ unqtDot (DVal d) = unqtDot d
+ unqtDot (PVal p) = printPoint2DUnqt p
+
+ toDot (DVal d) = toDot d
+ toDot (PVal p) = printPoint2D p
+
+instance ParseDot DPoint where
+ parseUnqt = optional (character '+')
+ *> oneOf [ PVal <$> parsePoint2D
+ , DVal <$> parseUnqt
+ ]
+
+ parse = quotedParse parseUnqt -- A `+' would need to be quoted.
+ `onFail`
+ fmap DVal (parseSignedFloat False) -- Don't use parseUnqt!
+
+-- -----------------------------------------------------------------------------
+
+-- | The mapping used for 'FontName' values in SVG output.
+--
+-- More information can be found at .
+data SVGFontNames = SvgNames -- ^ Use the legal generic SVG font names.
+ | PostScriptNames -- ^ Use PostScript font names.
+ | FontConfigNames -- ^ Use fontconfig font conventions.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot SVGFontNames where
+ unqtDot SvgNames = text "svg"
+ unqtDot PostScriptNames = text "ps"
+ unqtDot FontConfigNames = text "gd"
+
+instance ParseDot SVGFontNames where
+ parseUnqt = oneOf [ stringRep SvgNames "svg"
+ , stringRep PostScriptNames "ps"
+ , stringRep FontConfigNames "gd"
+ ]
+
+ parse = stringRep SvgNames "\"\""
+ `onFail`
+ optionalQuoted parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | Maximum width and height of drawing in inches.
+data GraphSize = GSize { width :: Double
+ -- | If @Nothing@, then the height is the
+ -- same as the width.
+ , height :: Maybe Double
+ -- | If drawing is smaller than specified
+ -- size, this value determines whether it
+ -- is scaled up.
+ , desiredSize :: Bool
+ }
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot GraphSize where
+ unqtDot (GSize w mh ds) = bool id (<> char '!') ds
+ . maybe id (\h -> (<> unqtDot h) . (<> comma)) mh
+ $ unqtDot w
+
+ toDot (GSize w Nothing False) = toDot w
+ toDot gs = dquotes $ unqtDot gs
+
+instance ParseDot GraphSize where
+ parseUnqt = GSize <$> parseUnqt
+ <*> optional (parseComma *> whitespace *> parseUnqt)
+ <*> (isJust <$> optional (character '!'))
+
+ parse = quotedParse parseUnqt
+ `onFail`
+ fmap (\ w -> GSize w Nothing False) (parseSignedFloat False)
+
+-- -----------------------------------------------------------------------------
+
+-- | For 'Neato' unless indicated otherwise.
+data ModeType = Major
+ | KK
+ | Hier
+ | IpSep
+ | SpringMode -- ^ For 'Sfdp', requires Graphviz >= 2.32.0.
+ | MaxEnt -- ^ For 'Sfdp', requires Graphviz >= 2.32.0.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot ModeType where
+ unqtDot Major = text "major"
+ unqtDot KK = text "KK"
+ unqtDot Hier = text "hier"
+ unqtDot IpSep = text "ipsep"
+ unqtDot SpringMode = text "spring"
+ unqtDot MaxEnt = text "maxent"
+
+instance ParseDot ModeType where
+ parseUnqt = oneOf [ stringRep Major "major"
+ , stringRep KK "KK"
+ , stringRep Hier "hier"
+ , stringRep IpSep "ipsep"
+ , stringRep SpringMode "spring"
+ , stringRep MaxEnt "maxent"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Model = ShortPath
+ | SubSet
+ | Circuit
+ | MDS
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot Model where
+ unqtDot ShortPath = text "shortpath"
+ unqtDot SubSet = text "subset"
+ unqtDot Circuit = text "circuit"
+ unqtDot MDS = text "mds"
+
+instance ParseDot Model where
+ parseUnqt = oneOf [ stringRep ShortPath "shortpath"
+ , stringRep SubSet "subset"
+ , stringRep Circuit "circuit"
+ , stringRep MDS "mds"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Label = StrLabel EscString
+ | HtmlLabel Html.Label -- ^ If 'PlainText' is used, the
+ -- 'Html.Label' value is the entire
+ -- \"shape\"; if anything else
+ -- except 'PointShape' is used then
+ -- the 'Html.Label' is embedded
+ -- within the shape.
+ | RecordLabel RecordFields -- ^ For nodes only; requires
+ -- either 'Record' or
+ -- 'MRecord' as the shape.
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Label where
+ unqtDot (StrLabel s) = unqtDot s
+ unqtDot (HtmlLabel h) = angled $ unqtDot h
+ unqtDot (RecordLabel fs) = unqtDot fs
+
+ toDot (StrLabel s) = toDot s
+ toDot h@HtmlLabel{} = unqtDot h
+ toDot (RecordLabel fs) = toDot fs
+
+instance ParseDot Label where
+ -- Don't have to worry about being able to tell the difference
+ -- between an HtmlLabel and a RecordLabel starting with a PortPos,
+ -- since the latter will be in quotes and the former won't.
+
+ parseUnqt = oneOf [ HtmlLabel <$> parseAngled parseUnqt
+ , RecordLabel <$> parseUnqt
+ , StrLabel <$> parseUnqt
+ ]
+
+ parse = oneOf [ HtmlLabel <$> parseAngled parse
+ , RecordLabel <$> parse
+ , StrLabel <$> parse
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | A RecordFields value should never be empty.
+type RecordFields = [RecordField]
+
+-- | Specifies the sub-values of a record-based label. By default,
+-- the cells are laid out horizontally; use 'FlipFields' to change
+-- the orientation of the fields (can be applied recursively). To
+-- change the default orientation, use 'RankDir'.
+data RecordField = LabelledTarget PortName EscString
+ | PortName PortName -- ^ Will result in no label for
+ -- that cell.
+ | FieldLabel EscString
+ | FlipFields RecordFields
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot RecordField where
+ -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.
+ unqtDot (LabelledTarget t s) = printPortName t <+> unqtRecordString s
+ unqtDot (PortName t) = printPortName t
+ unqtDot (FieldLabel s) = unqtRecordString s
+ unqtDot (FlipFields rs) = braces $ unqtDot rs
+
+ toDot (FieldLabel s) = printEscaped recordEscChars s
+ toDot rf = dquotes $ unqtDot rf
+
+ unqtListToDot [f] = unqtDot f
+ unqtListToDot fs = hcat . punctuate (char '|') $ mapM unqtDot fs
+
+ listToDot [f] = toDot f
+ listToDot fs = dquotes $ unqtListToDot fs
+
+instance ParseDot RecordField where
+ parseUnqt = (liftA2 maybe PortName LabelledTarget
+ <$> (PN <$> parseAngled parseRecord)
+ <*> optional (whitespace1 *> parseRecord)
+ )
+ `onFail`
+ fmap FieldLabel parseRecord
+ `onFail`
+ fmap FlipFields (parseBraced parseUnqt)
+ `onFail`
+ fail "Unable to parse RecordField"
+
+ parse = quotedParse parseUnqt
+
+ parseUnqtList = wrapWhitespace $ sepBy1 parseUnqt (wrapWhitespace $ character '|')
+
+ -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it
+ -- will cause parsing problems for other 'Label' types.
+ parseList = do rfs <- quotedParse parseUnqtList
+ if validRFs rfs
+ then return rfs
+ else fail "This is a StrLabel, not a RecordLabel"
+ where
+ validRFs [FieldLabel str] = T.any (`elem` recordEscChars) str
+ validRFs _ = True
+
+-- | Print a 'PortName' value as expected within a Record data
+-- structure.
+printPortName :: PortName -> DotCode
+printPortName = angled . unqtRecordString . portName
+
+parseRecord :: Parse Text
+parseRecord = parseEscaped False recordEscChars []
+
+unqtRecordString :: Text -> DotCode
+unqtRecordString = unqtEscaped recordEscChars
+
+recordEscChars :: [Char]
+recordEscChars = ['{', '}', '|', ' ', '<', '>']
+
+-- -----------------------------------------------------------------------------
+
+-- | How to treat a node whose name is of the form \"@|edgelabel|*@\"
+-- as a special node representing an edge label.
+data LabelScheme = NotEdgeLabel -- ^ No effect
+ | CloseToCenter -- ^ Make node close to center of neighbor
+ | CloseToOldCenter -- ^ Make node close to old center of neighbor
+ | RemoveAndStraighten -- ^ Use a two-step process.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot LabelScheme where
+ unqtDot NotEdgeLabel = int 0
+ unqtDot CloseToCenter = int 1
+ unqtDot CloseToOldCenter = int 2
+ unqtDot RemoveAndStraighten = int 3
+
+instance ParseDot LabelScheme where
+ -- Use string-based parsing rather than parsing an integer just to make it easier
+ parseUnqt = stringValue [ ("0", NotEdgeLabel)
+ , ("1", CloseToCenter)
+ , ("2", CloseToOldCenter)
+ , ("3", RemoveAndStraighten)
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Point = Point { xCoord :: Double
+ , yCoord :: Double
+ -- | Can only be 'Just' for @'Dim' 3@ or greater.
+ , zCoord :: Maybe Double
+ -- | Input to Graphviz only: specify that the
+ -- node position should not change.
+ , forcePos :: Bool
+ }
+ deriving (Eq, Ord, Show, Read)
+
+-- | Create a point with only @x@ and @y@ values.
+createPoint :: Double -> Double -> Point
+createPoint x y = Point x y Nothing False
+
+printPoint2DUnqt :: Point -> DotCode
+printPoint2DUnqt p = commaDel (xCoord p) (yCoord p)
+
+printPoint2D :: Point -> DotCode
+printPoint2D = dquotes . printPoint2DUnqt
+
+parsePoint2D :: Parse Point
+parsePoint2D = uncurry createPoint <$> commaSepUnqt
+
+instance PrintDot Point where
+ unqtDot (Point x y mz frs) = bool id (<> char '!') frs
+ . maybe id (\ z -> (<> unqtDot z) . (<> comma)) mz
+ $ commaDel x y
+
+ toDot = dquotes . unqtDot
+
+ unqtListToDot = hsep . mapM unqtDot
+
+ listToDot = dquotes . unqtListToDot
+
+instance ParseDot Point where
+ parseUnqt = uncurry Point
+ <$> commaSepUnqt
+ <*> optional (parseComma *> parseUnqt)
+ <*> (isJust <$> optional (character '!'))
+
+ parse = quotedParse parseUnqt
+
+ parseUnqtList = sepBy1 parseUnqt whitespace1
+
+-- -----------------------------------------------------------------------------
+
+-- | How to deal with node overlaps.
+--
+-- Defaults to 'KeepOverlaps' /except/ for 'Fdp' and 'Sfdp'.
+--
+-- The ability to specify the number of tries for 'Fdp''s initial
+-- force-directed technique is /not/ supported (by default, 'Fdp' uses
+-- @9@ passes of its in-built technique, and then @'PrismOverlap'
+-- Nothing@).
+--
+-- For 'Sfdp', the default is @'PrismOverlap' (Just 0)@.
+data Overlap = KeepOverlaps
+ | ScaleOverlaps -- ^ Remove overlaps by uniformly scaling in x and y.
+ | ScaleXYOverlaps -- ^ Remove overlaps by separately scaling x and y.
+ | PrismOverlap (Maybe Word16) -- ^ Requires the Prism
+ -- library to be
+ -- available (if not,
+ -- this is equivalent to
+ -- 'VoronoiOverlap'). @'Nothing'@
+ -- is equivalent to
+ -- @'Just' 1000@.
+ -- Influenced by
+ -- 'OverlapScaling'.
+ | VoronoiOverlap -- ^ Requires Graphviz >= 2.30.0.
+ | CompressOverlap -- ^ Scale layout down as much as
+ -- possible without introducing
+ -- overlaps, assuming none to begin
+ -- with.
+ | VpscOverlap -- ^ Uses quadratic optimization to
+ -- minimize node displacement.
+ | IpsepOverlap -- ^ Only when @mode == 'IpSep'@
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Overlap where
+ unqtDot KeepOverlaps = unqtDot True
+ unqtDot ScaleOverlaps = text "scale"
+ unqtDot ScaleXYOverlaps = text "scalexy"
+ unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism"
+ unqtDot VoronoiOverlap = text "voronoi"
+ unqtDot CompressOverlap = text "compress"
+ unqtDot VpscOverlap = text "vpsc"
+ unqtDot IpsepOverlap = text "ipsep"
+
+-- | Note that @overlap=false@ defaults to @'PrismOverlap' Nothing@,
+-- but if the Prism library isn't available then it is equivalent to
+-- 'VoronoiOverlap'.
+instance ParseDot Overlap where
+ parseUnqt = oneOf [ stringRep KeepOverlaps "true"
+ , stringRep ScaleXYOverlaps "scalexy"
+ , stringRep ScaleOverlaps "scale"
+ , string "prism" *> fmap PrismOverlap (optional parse)
+ , stringRep (PrismOverlap Nothing) "false"
+ , stringRep VoronoiOverlap "voronoi"
+ , stringRep CompressOverlap "compress"
+ , stringRep VpscOverlap "vpsc"
+ , stringRep IpsepOverlap "ipsep"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+newtype LayerSep = LSep Text
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot LayerSep where
+ unqtDot (LSep ls) = setLayerSep (T.unpack ls) *> unqtDot ls
+
+ toDot (LSep ls) = setLayerSep (T.unpack ls) *> toDot ls
+
+instance ParseDot LayerSep where
+ parseUnqt = do ls <- parseUnqt
+ setLayerSep $ T.unpack ls
+ return $ LSep ls
+
+ parse = do ls <- parse
+ setLayerSep $ T.unpack ls
+ return $ LSep ls
+
+newtype LayerListSep = LLSep Text
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot LayerListSep where
+ unqtDot (LLSep ls) = setLayerListSep (T.unpack ls) *> unqtDot ls
+
+ toDot (LLSep ls) = setLayerListSep (T.unpack ls) *> toDot ls
+
+instance ParseDot LayerListSep where
+ parseUnqt = do ls <- parseUnqt
+ setLayerListSep $ T.unpack ls
+ return $ LLSep ls
+
+ parse = do ls <- parse
+ setLayerListSep $ T.unpack ls
+ return $ LLSep ls
+
+type LayerRange = [LayerRangeElem]
+
+data LayerRangeElem = LRID LayerID
+ | LRS LayerID LayerID
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot LayerRangeElem where
+ unqtDot (LRID lid) = unqtDot lid
+ unqtDot (LRS id1 id2) = do ls <- getLayerSep
+ let s = unqtDot $ head ls
+ unqtDot id1 <> s <> unqtDot id2
+
+ toDot (LRID lid) = toDot lid
+ toDot lrs = dquotes $ unqtDot lrs
+
+ unqtListToDot lr = do lls <- getLayerListSep
+ let s = unqtDot $ head lls
+ hcat . punctuate s $ mapM unqtDot lr
+
+ listToDot [lre] = toDot lre
+ listToDot lrs = dquotes $ unqtListToDot lrs
+
+instance ParseDot LayerRangeElem where
+ parseUnqt = ignoreSep LRS parseUnqt parseLayerSep parseUnqt
+ `onFail`
+ fmap LRID parseUnqt
+
+ parse = quotedParse (ignoreSep LRS parseUnqt parseLayerSep parseUnqt)
+ `onFail`
+ fmap LRID parse
+
+ parseUnqtList = sepBy parseUnqt parseLayerListSep
+
+ parseList = quotedParse parseUnqtList
+ `onFail`
+ fmap ((:[]) . LRID) parse
+
+parseLayerSep :: Parse ()
+parseLayerSep = do ls <- getLayerSep
+ many1Satisfy (`elem` ls) *> return ()
+
+parseLayerName :: Parse Text
+parseLayerName = parseEscaped False [] =<< liftA2 (++) getLayerSep getLayerListSep
+
+parseLayerName' :: Parse Text
+parseLayerName' = stringBlock
+ `onFail`
+ quotedParse parseLayerName
+
+parseLayerListSep :: Parse ()
+parseLayerListSep = do lls <- getLayerListSep
+ many1Satisfy (`elem` lls) *> return ()
+
+-- | You should not have any layer separator characters for the
+-- 'LRName' option, as they won't be parseable.
+data LayerID = AllLayers
+ | LRInt Int
+ | LRName Text -- ^ Should not be a number or @"all"@.
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot LayerID where
+ unqtDot AllLayers = text "all"
+ unqtDot (LRInt n) = unqtDot n
+ unqtDot (LRName nm) = unqtDot nm
+
+ toDot (LRName nm) = toDot nm
+ -- Other two don't need quotes
+ toDot li = unqtDot li
+
+ unqtListToDot ll = do ls <- getLayerSep
+ let s = unqtDot $ head ls
+ hcat . punctuate s $ mapM unqtDot ll
+
+ listToDot [l] = toDot l
+ -- Might not need quotes, but probably will. Can't tell either
+ -- way since we don't know what the separator character will be.
+ listToDot ll = dquotes $ unqtDot ll
+
+instance ParseDot LayerID where
+ parseUnqt = checkLayerName <$> parseLayerName -- tests for Int and All
+
+ parse = oneOf [ checkLayerName <$> parseLayerName'
+ , LRInt <$> parse -- Mainly for unquoted case.
+ ]
+
+checkLayerName :: Text -> LayerID
+checkLayerName str = maybe checkAll LRInt $ stringToInt str
+ where
+ checkAll = if T.toLower str == "all"
+ then AllLayers
+ else LRName str
+
+-- Remember: this /must/ be a newtype as we can't use arbitrary
+-- LayerID values!
+
+-- | A list of layer names. The names should all be unique 'LRName'
+-- values, and when printed will use an arbitrary character from
+-- 'defLayerSep'. The values in the list are implicitly numbered
+-- @1, 2, ...@.
+newtype LayerList = LL [LayerID]
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot LayerList where
+ unqtDot (LL ll) = unqtDot ll
+
+ toDot (LL ll) = toDot ll
+
+instance ParseDot LayerList where
+ parseUnqt = LL <$> sepBy1 parseUnqt parseLayerSep
+
+ parse = quotedParse parseUnqt
+ `onFail`
+ fmap (LL . (:[]) . LRName) stringBlock
+ `onFail`
+ quotedParse (stringRep (LL []) "")
+
+-- -----------------------------------------------------------------------------
+
+data Order = OutEdges -- ^ Draw outgoing edges in order specified.
+ | InEdges -- ^ Draw incoming edges in order specified.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot Order where
+ unqtDot OutEdges = text "out"
+ unqtDot InEdges = text "in"
+
+instance ParseDot Order where
+ parseUnqt = oneOf [ stringRep OutEdges "out"
+ , stringRep InEdges "in"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data OutputMode = BreadthFirst | NodesFirst | EdgesFirst
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot OutputMode where
+ unqtDot BreadthFirst = text "breadthfirst"
+ unqtDot NodesFirst = text "nodesfirst"
+ unqtDot EdgesFirst = text "edgesfirst"
+
+instance ParseDot OutputMode where
+ parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"
+ , stringRep NodesFirst "nodesfirst"
+ , stringRep EdgesFirst "edgesfirst"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Pack = DoPack
+ | DontPack
+ | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Pack where
+ unqtDot DoPack = unqtDot True
+ unqtDot DontPack = unqtDot False
+ unqtDot (PackMargin m) = unqtDot m
+
+instance ParseDot Pack where
+ -- What happens if it parses 0? It's non-negative, but parses as False
+ parseUnqt = oneOf [ PackMargin <$> parseUnqt
+ , bool DontPack DoPack <$> onlyBool
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data PackMode = PackNode
+ | PackClust
+ | PackGraph
+ | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort
+ -- by user, number of
+ -- rows/cols
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot PackMode where
+ unqtDot PackNode = text "node"
+ unqtDot PackClust = text "clust"
+ unqtDot PackGraph = text "graph"
+ unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder
+ $ text "array"
+ where
+ addNum = maybe id (flip (<>) . unqtDot) mi
+ isUnder = if c || u
+ then (<> char '_')
+ else id
+ isC = if c
+ then (<> char 'c')
+ else id
+ isU = if u
+ then (<> char 'u')
+ else id
+
+instance ParseDot PackMode where
+ parseUnqt = oneOf [ stringRep PackNode "node"
+ , stringRep PackClust "clust"
+ , stringRep PackGraph "graph"
+ , do string "array"
+ mcu <- optional $ character '_' *> many1 (satisfy isCU)
+ let c = hasCharacter mcu 'c'
+ u = hasCharacter mcu 'u'
+ mi <- optional parseUnqt
+ return $ PackArray c u mi
+ ]
+ where
+ hasCharacter ms c = maybe False (elem c) ms
+ -- Also checks and removes quote characters
+ isCU = (`elem` ['c', 'u'])
+
+-- -----------------------------------------------------------------------------
+
+data Pos = PointPos Point
+ | SplinePos [Spline]
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Pos where
+ unqtDot (PointPos p) = unqtDot p
+ unqtDot (SplinePos ss) = unqtDot ss
+
+ toDot (PointPos p) = toDot p
+ toDot (SplinePos ss) = toDot ss
+
+instance ParseDot Pos where
+ -- Have to be careful with this: if we try to parse points first,
+ -- then a spline with no start and end points will erroneously get
+ -- parsed as a point and then the parser will crash as it expects a
+ -- closing quote character...
+ parseUnqt = do splns <- parseUnqt
+ case splns of
+ [Spline Nothing Nothing [p]] -> return $ PointPos p
+ _ -> return $ SplinePos splns
+
+ parse = quotedParse parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | Controls how (and if) edges are represented.
+--
+-- For 'Dot', the default is 'SplineEdges'; for all other layouts
+-- the default is 'LineEdges'.
+data EdgeType = SplineEdges -- ^ Except for 'Dot', requires
+ -- non-overlapping nodes (see
+ -- 'Overlap').
+ | LineEdges
+ | NoEdges
+ | PolyLine
+ | Ortho -- ^ Does not handle ports or edge labels in 'Dot'.
+ | Curved -- ^ Requires Graphviz >= 2.30.0.
+ | CompoundEdge -- ^ 'Fdp' only
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot EdgeType where
+ unqtDot SplineEdges = text "spline"
+ unqtDot LineEdges = text "line"
+ unqtDot NoEdges = empty
+ unqtDot PolyLine = text "polyline"
+ unqtDot Ortho = text "ortho"
+ unqtDot Curved = text "curved"
+ unqtDot CompoundEdge = text "compound"
+
+ toDot NoEdges = dquotes empty
+ toDot et = unqtDot et
+
+instance ParseDot EdgeType where
+ -- Can't parse NoEdges without quotes.
+ parseUnqt = oneOf [ bool LineEdges SplineEdges <$> parse
+ , stringRep SplineEdges "spline"
+ , stringRep LineEdges "line"
+ , stringRep NoEdges "none"
+ , stringRep PolyLine "polyline"
+ , stringRep Ortho "ortho"
+ , stringRep Curved "curved"
+ , stringRep CompoundEdge "compound"
+ ]
+
+ parse = stringRep NoEdges "\"\""
+ `onFail`
+ optionalQuoted parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | Upper-case first character is major order;
+-- lower-case second character is minor order.
+data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot PageDir where
+ unqtDot Bl = text "BL"
+ unqtDot Br = text "BR"
+ unqtDot Tl = text "TL"
+ unqtDot Tr = text "TR"
+ unqtDot Rb = text "RB"
+ unqtDot Rt = text "RT"
+ unqtDot Lb = text "LB"
+ unqtDot Lt = text "LT"
+
+instance ParseDot PageDir where
+ parseUnqt = stringValue [ ("BL", Bl)
+ , ("BR", Br)
+ , ("TL", Tl)
+ , ("TR", Tr)
+ , ("RB", Rb)
+ , ("RT", Rt)
+ , ("LB", Lb)
+ , ("LT", Lt)
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | The number of points in the list must be equivalent to 1 mod 3;
+-- note that this is not checked.
+data Spline = Spline { endPoint :: Maybe Point
+ , startPoint :: Maybe Point
+ , splinePoints :: [Point]
+ }
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Spline where
+ unqtDot (Spline me ms ps) = addE . addS
+ . hsep
+ $ mapM unqtDot ps
+ where
+ addP t = maybe id ((<+>) . commaDel t)
+ addS = addP 's' ms
+ addE = addP 'e' me
+
+ toDot = dquotes . unqtDot
+
+ unqtListToDot = hcat . punctuate semi . mapM unqtDot
+
+ listToDot = dquotes . unqtListToDot
+
+instance ParseDot Spline where
+ parseUnqt = Spline <$> parseP 'e' <*> parseP 's'
+ <*> sepBy1 parseUnqt whitespace1
+ where
+ parseP t = optional (character t *> parseComma *> parseUnqt <* whitespace1)
+
+ parse = quotedParse parseUnqt
+
+ parseUnqtList = sepBy1 parseUnqt (character ';')
+
+-- -----------------------------------------------------------------------------
+
+data QuadType = NormalQT
+ | FastQT
+ | NoQT
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot QuadType where
+ unqtDot NormalQT = text "normal"
+ unqtDot FastQT = text "fast"
+ unqtDot NoQT = text "none"
+
+instance ParseDot QuadType where
+ -- Have to take into account the slightly different interpretation
+ -- of Bool used as an option for parsing QuadType
+ parseUnqt = oneOf [ stringRep NormalQT "normal"
+ , stringRep FastQT "fast"
+ , stringRep NoQT "none"
+ , character '2' *> return FastQT -- weird bool
+ , bool NoQT NormalQT <$> parse
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | Specify the root node either as a Node attribute or a Graph attribute.
+data Root = IsCentral -- ^ For Nodes only
+ | NotCentral -- ^ For Nodes only
+ | NodeName Text -- ^ For Graphs only
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Root where
+ unqtDot IsCentral = unqtDot True
+ unqtDot NotCentral = unqtDot False
+ unqtDot (NodeName n) = unqtDot n
+
+ toDot (NodeName n) = toDot n
+ toDot r = unqtDot r
+
+instance ParseDot Root where
+ parseUnqt = fmap (bool NotCentral IsCentral) onlyBool
+ `onFail`
+ fmap NodeName parseUnqt
+
+ parse = optionalQuoted (bool NotCentral IsCentral <$> onlyBool)
+ `onFail`
+ fmap NodeName parse
+
+-- -----------------------------------------------------------------------------
+
+data RankType = SameRank
+ | MinRank
+ | SourceRank
+ | MaxRank
+ | SinkRank
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot RankType where
+ unqtDot SameRank = text "same"
+ unqtDot MinRank = text "min"
+ unqtDot SourceRank = text "source"
+ unqtDot MaxRank = text "max"
+ unqtDot SinkRank = text "sink"
+
+instance ParseDot RankType where
+ parseUnqt = stringValue [ ("same", SameRank)
+ , ("min", MinRank)
+ , ("source", SourceRank)
+ , ("max", MaxRank)
+ , ("sink", SinkRank)
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data RankDir = FromTop
+ | FromLeft
+ | FromBottom
+ | FromRight
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot RankDir where
+ unqtDot FromTop = text "TB"
+ unqtDot FromLeft = text "LR"
+ unqtDot FromBottom = text "BT"
+ unqtDot FromRight = text "RL"
+
+instance ParseDot RankDir where
+ parseUnqt = oneOf [ stringRep FromTop "TB"
+ , stringRep FromLeft "LR"
+ , stringRep FromBottom "BT"
+ , stringRep FromRight "RL"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | Geometries of shapes are affected by the attributes 'Regular',
+-- 'Peripheries' and 'Orientation'.
+data Shape
+ = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.
+ | Polygon -- ^ Also affected by 'Sides', 'Skew' and 'Distortion'.
+ | Ellipse -- ^ Has synonym of /oval/.
+ | Circle
+ | PointShape -- ^ Only affected by 'Peripheries', 'Width' and
+ -- 'Height'.
+ | Egg
+ | Triangle
+ | PlainText -- ^ Has synonym of /none/. Recommended for
+ -- 'HtmlLabel's.
+ | DiamondShape
+ | Trapezium
+ | Parallelogram
+ | House
+ | Pentagon
+ | Hexagon
+ | Septagon
+ | Octagon
+ | DoubleCircle
+ | DoubleOctagon
+ | TripleOctagon
+ | InvTriangle
+ | InvTrapezium
+ | InvHouse
+ | MDiamond
+ | MSquare
+ | MCircle
+ | Square
+ | Star -- ^ Requires Graphviz >= 2.32.0.
+ | Underline -- ^ Requires Graphviz >= 2.36.0.
+ | Note
+ | Tab
+ | Folder
+ | Box3D
+ | Component
+ | Promoter -- ^ Requires Graphviz >= 2.30.0.
+ | CDS -- ^ Requires Graphviz >= 2.30.0.
+ | Terminator -- ^ Requires Graphviz >= 2.30.0.
+ | UTR -- ^ Requires Graphviz >= 2.30.0.
+ | PrimerSite -- ^ Requires Graphviz >= 2.30.0.
+ | RestrictionSite -- ^ Requires Graphviz >= 2.30.0.
+ | FivePovOverhang -- ^ Requires Graphviz >= 2.30.0.
+ | ThreePovOverhang -- ^ Requires Graphviz >= 2.30.0.
+ | NoOverhang -- ^ Requires Graphviz >= 2.30.0.
+ | Assembly -- ^ Requires Graphviz >= 2.30.0.
+ | Signature -- ^ Requires Graphviz >= 2.30.0.
+ | Insulator -- ^ Requires Graphviz >= 2.30.0.
+ | Ribosite -- ^ Requires Graphviz >= 2.30.0.
+ | RNAStab -- ^ Requires Graphviz >= 2.30.0.
+ | ProteaseSite -- ^ Requires Graphviz >= 2.30.0.
+ | ProteinStab -- ^ Requires Graphviz >= 2.30.0.
+ | RPromoter -- ^ Requires Graphviz >= 2.30.0.
+ | RArrow -- ^ Requires Graphviz >= 2.30.0.
+ | LArrow -- ^ Requires Graphviz >= 2.30.0.
+ | LPromoter -- ^ Requires Graphviz >= 2.30.0.
+ | Record -- ^ Must specify the record shape with a 'Label'.
+ | MRecord -- ^ Must specify the record shape with a 'Label'.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot Shape where
+ unqtDot BoxShape = text "box"
+ unqtDot Polygon = text "polygon"
+ unqtDot Ellipse = text "ellipse"
+ unqtDot Circle = text "circle"
+ unqtDot PointShape = text "point"
+ unqtDot Egg = text "egg"
+ unqtDot Triangle = text "triangle"
+ unqtDot PlainText = text "plaintext"
+ unqtDot DiamondShape = text "diamond"
+ unqtDot Trapezium = text "trapezium"
+ unqtDot Parallelogram = text "parallelogram"
+ unqtDot House = text "house"
+ unqtDot Pentagon = text "pentagon"
+ unqtDot Hexagon = text "hexagon"
+ unqtDot Septagon = text "septagon"
+ unqtDot Octagon = text "octagon"
+ unqtDot DoubleCircle = text "doublecircle"
+ unqtDot DoubleOctagon = text "doubleoctagon"
+ unqtDot TripleOctagon = text "tripleoctagon"
+ unqtDot InvTriangle = text "invtriangle"
+ unqtDot InvTrapezium = text "invtrapezium"
+ unqtDot InvHouse = text "invhouse"
+ unqtDot MDiamond = text "Mdiamond"
+ unqtDot MSquare = text "Msquare"
+ unqtDot MCircle = text "Mcircle"
+ unqtDot Square = text "square"
+ unqtDot Star = text "star"
+ unqtDot Underline = text "underline"
+ unqtDot Note = text "note"
+ unqtDot Tab = text "tab"
+ unqtDot Folder = text "folder"
+ unqtDot Box3D = text "box3d"
+ unqtDot Component = text "component"
+ unqtDot Promoter = text "promoter"
+ unqtDot CDS = text "cds"
+ unqtDot Terminator = text "terminator"
+ unqtDot UTR = text "utr"
+ unqtDot PrimerSite = text "primersite"
+ unqtDot RestrictionSite = text "restrictionsite"
+ unqtDot FivePovOverhang = text "fivepovoverhang"
+ unqtDot ThreePovOverhang = text "threepovoverhang"
+ unqtDot NoOverhang = text "nooverhang"
+ unqtDot Assembly = text "assembly"
+ unqtDot Signature = text "signature"
+ unqtDot Insulator = text "insulator"
+ unqtDot Ribosite = text "ribosite"
+ unqtDot RNAStab = text "rnastab"
+ unqtDot ProteaseSite = text "proteasesite"
+ unqtDot ProteinStab = text "proteinstab"
+ unqtDot RPromoter = text "rpromoter"
+ unqtDot RArrow = text "rarrow"
+ unqtDot LArrow = text "larrow"
+ unqtDot LPromoter = text "lpromoter"
+ unqtDot Record = text "record"
+ unqtDot MRecord = text "Mrecord"
+
+instance ParseDot Shape where
+ parseUnqt = stringValue [ ("box3d", Box3D)
+ , ("box", BoxShape)
+ , ("rectangle", BoxShape)
+ , ("rect", BoxShape)
+ , ("polygon", Polygon)
+ , ("ellipse", Ellipse)
+ , ("oval", Ellipse)
+ , ("circle", Circle)
+ , ("point", PointShape)
+ , ("egg", Egg)
+ , ("triangle", Triangle)
+ , ("plaintext", PlainText)
+ , ("none", PlainText)
+ , ("diamond", DiamondShape)
+ , ("trapezium", Trapezium)
+ , ("parallelogram", Parallelogram)
+ , ("house", House)
+ , ("pentagon", Pentagon)
+ , ("hexagon", Hexagon)
+ , ("septagon", Septagon)
+ , ("octagon", Octagon)
+ , ("doublecircle", DoubleCircle)
+ , ("doubleoctagon", DoubleOctagon)
+ , ("tripleoctagon", TripleOctagon)
+ , ("invtriangle", InvTriangle)
+ , ("invtrapezium", InvTrapezium)
+ , ("invhouse", InvHouse)
+ , ("Mdiamond", MDiamond)
+ , ("Msquare", MSquare)
+ , ("Mcircle", MCircle)
+ , ("square", Square)
+ , ("star", Star)
+ , ("underline", Underline)
+ , ("note", Note)
+ , ("tab", Tab)
+ , ("folder", Folder)
+ , ("component", Component)
+ , ("promoter", Promoter)
+ , ("cds", CDS)
+ , ("terminator", Terminator)
+ , ("utr", UTR)
+ , ("primersite", PrimerSite)
+ , ("restrictionsite", RestrictionSite)
+ , ("fivepovoverhang", FivePovOverhang)
+ , ("threepovoverhang", ThreePovOverhang)
+ , ("nooverhang", NoOverhang)
+ , ("assembly", Assembly)
+ , ("signature", Signature)
+ , ("insulator", Insulator)
+ , ("ribosite", Ribosite)
+ , ("rnastab", RNAStab)
+ , ("proteasesite", ProteaseSite)
+ , ("proteinstab", ProteinStab)
+ , ("rpromoter", RPromoter)
+ , ("rarrow", RArrow)
+ , ("larrow", LArrow)
+ , ("lpromoter", LPromoter)
+ , ("record", Record)
+ , ("Mrecord", MRecord)
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data SmoothType = NoSmooth
+ | AvgDist
+ | GraphDist
+ | PowerDist
+ | RNG
+ | Spring
+ | TriangleSmooth
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot SmoothType where
+ unqtDot NoSmooth = text "none"
+ unqtDot AvgDist = text "avg_dist"
+ unqtDot GraphDist = text "graph_dist"
+ unqtDot PowerDist = text "power_dist"
+ unqtDot RNG = text "rng"
+ unqtDot Spring = text "spring"
+ unqtDot TriangleSmooth = text "triangle"
+
+instance ParseDot SmoothType where
+ parseUnqt = oneOf [ stringRep NoSmooth "none"
+ , stringRep AvgDist "avg_dist"
+ , stringRep GraphDist "graph_dist"
+ , stringRep PowerDist "power_dist"
+ , stringRep RNG "rng"
+ , stringRep Spring "spring"
+ , stringRep TriangleSmooth "triangle"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data StartType = StartStyle STStyle
+ | StartSeed Int
+ | StartStyleSeed STStyle Int
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot StartType where
+ unqtDot (StartStyle ss) = unqtDot ss
+ unqtDot (StartSeed s) = unqtDot s
+ unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s
+
+instance ParseDot StartType where
+ parseUnqt = oneOf [ liftA2 StartStyleSeed parseUnqt parseUnqt
+ , StartStyle <$> parseUnqt
+ , StartSeed <$> parseUnqt
+ ]
+
+data STStyle = RegularStyle
+ | SelfStyle
+ | RandomStyle
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot STStyle where
+ unqtDot RegularStyle = text "regular"
+ unqtDot SelfStyle = text "self"
+ unqtDot RandomStyle = text "random"
+
+instance ParseDot STStyle where
+ parseUnqt = oneOf [ stringRep RegularStyle "regular"
+ , stringRep SelfStyle "self"
+ , stringRep RandomStyle "random"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | An individual style item. Except for 'DD', the @['String']@
+-- should be empty.
+data StyleItem = SItem StyleName [Text]
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot StyleItem where
+ unqtDot (SItem nm args)
+ | null args = dnm
+ | otherwise = dnm <> parens args'
+ where
+ dnm = unqtDot nm
+ args' = hcat . punctuate comma $ mapM unqtDot args
+
+ toDot si@(SItem nm args)
+ | null args = toDot nm
+ | otherwise = dquotes $ unqtDot si
+
+ unqtListToDot = hcat . punctuate comma . mapM unqtDot
+
+ listToDot [SItem nm []] = toDot nm
+ listToDot sis = dquotes $ unqtListToDot sis
+
+instance ParseDot StyleItem where
+ parseUnqt = liftA2 SItem parseUnqt (tryParseList' parseArgs)
+
+ parse = quotedParse (liftA2 SItem parseUnqt parseArgs)
+ `onFail`
+ fmap (`SItem` []) parse
+
+ parseUnqtList = sepBy1 parseUnqt parseComma
+
+ parseList = quotedParse parseUnqtList
+ `onFail`
+ -- Might not necessarily need to be quoted if a singleton...
+ fmap return parse
+
+parseArgs :: Parse [Text]
+parseArgs = bracketSep (character '(')
+ parseComma
+ (character ')')
+ parseStyleName
+
+data StyleName = Dashed -- ^ Nodes and Edges
+ | Dotted -- ^ Nodes and Edges
+ | Solid -- ^ Nodes and Edges
+ | Bold -- ^ Nodes and Edges
+ | Invisible -- ^ Nodes and Edges
+ | Filled -- ^ Nodes and Clusters
+ | Striped -- ^ Rectangularly-shaped Nodes and
+ -- Clusters; requires Graphviz >= 2.30.0
+ | Wedged -- ^ Elliptically-shaped Nodes only;
+ -- requires Graphviz >= 2.30.0
+ | Diagonals -- ^ Nodes only
+ | Rounded -- ^ Nodes and Clusters
+ | Tapered -- ^ Edges only; requires Graphviz >=
+ -- 2.29.0
+ | Radial -- ^ Nodes, Clusters and Graphs, for use
+ -- with 'GradientAngle'; requires
+ -- Graphviz >= 2.29.0
+ | DD Text -- ^ Device Dependent
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot StyleName where
+ unqtDot Dashed = text "dashed"
+ unqtDot Dotted = text "dotted"
+ unqtDot Solid = text "solid"
+ unqtDot Bold = text "bold"
+ unqtDot Invisible = text "invis"
+ unqtDot Filled = text "filled"
+ unqtDot Striped = text "striped"
+ unqtDot Wedged = text "wedged"
+ unqtDot Diagonals = text "diagonals"
+ unqtDot Rounded = text "rounded"
+ unqtDot Tapered = text "tapered"
+ unqtDot Radial = text "radial"
+ unqtDot (DD nm) = unqtDot nm
+
+ toDot (DD nm) = toDot nm
+ toDot sn = unqtDot sn
+
+instance ParseDot StyleName where
+ parseUnqt = checkDD <$> parseStyleName
+
+ parse = quotedParse parseUnqt
+ `onFail`
+ fmap checkDD quotelessString
+
+checkDD :: Text -> StyleName
+checkDD str = case T.toLower str of
+ "dashed" -> Dashed
+ "dotted" -> Dotted
+ "solid" -> Solid
+ "bold" -> Bold
+ "invis" -> Invisible
+ "filled" -> Filled
+ "striped" -> Striped
+ "wedged" -> Wedged
+ "diagonals" -> Diagonals
+ "rounded" -> Rounded
+ "tapered" -> Tapered
+ "radial" -> Radial
+ _ -> DD str
+
+parseStyleName :: Parse Text
+parseStyleName = liftA2 T.cons (orEscaped . noneOf $ ' ' : disallowedChars)
+ (parseEscaped True [] disallowedChars)
+ where
+ disallowedChars = [quoteChar, '(', ')', ',']
+ -- Used because the first character has slightly stricter requirements than the rest.
+ orSlash p = stringRep '\\' "\\\\" `onFail` p
+ orEscaped = orQuote . orSlash
+
+-- -----------------------------------------------------------------------------
+
+data ViewPort = VP { wVal :: Double
+ , hVal :: Double
+ , zVal :: Double
+ , focus :: Maybe FocusType
+ }
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot ViewPort where
+ unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)
+ $ focus vp
+ where
+ vs = hcat . punctuate comma
+ $ mapM (unqtDot . ($vp)) [wVal, hVal, zVal]
+
+ toDot = dquotes . unqtDot
+
+instance ParseDot ViewPort where
+ parseUnqt = VP <$> parseUnqt
+ <* parseComma
+ <*> parseUnqt
+ <* parseComma
+ <*> parseUnqt
+ <*> optional (parseComma *> parseUnqt)
+
+ parse = quotedParse parseUnqt
+
+-- | For use with 'ViewPort'.
+data FocusType = XY Point
+ | NodeFocus Text
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot FocusType where
+ unqtDot (XY p) = unqtDot p
+ unqtDot (NodeFocus nm) = unqtDot nm
+
+ toDot (XY p) = toDot p
+ toDot (NodeFocus nm) = toDot nm
+
+instance ParseDot FocusType where
+ parseUnqt = fmap XY parseUnqt
+ `onFail`
+ fmap NodeFocus parseUnqt
+
+ parse = fmap XY parse
+ `onFail`
+ fmap NodeFocus parse
+
+-- -----------------------------------------------------------------------------
+
+data VerticalPlacement = VTop
+ | VCenter -- ^ Only valid for Nodes.
+ | VBottom
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot VerticalPlacement where
+ unqtDot VTop = char 't'
+ unqtDot VCenter = char 'c'
+ unqtDot VBottom = char 'b'
+
+instance ParseDot VerticalPlacement where
+ parseUnqt = oneOf [ stringRep VTop "t"
+ , stringRep VCenter "c"
+ , stringRep VBottom "b"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | A list of search paths.
+newtype Paths = Paths { paths :: [FilePath] }
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Paths where
+ unqtDot = unqtDot . intercalate [searchPathSeparator] . paths
+
+ toDot (Paths [p]) = toDot p
+ toDot ps = dquotes $ unqtDot ps
+
+instance ParseDot Paths where
+ parseUnqt = Paths . splitSearchPath <$> parseUnqt
+
+ parse = quotedParse parseUnqt
+ `onFail`
+ fmap (Paths . (:[]) . T.unpack) quotelessString
+
+-- -----------------------------------------------------------------------------
+
+data ScaleType = UniformScale
+ | NoScale
+ | FillWidth
+ | FillHeight
+ | FillBoth
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot ScaleType where
+ unqtDot UniformScale = unqtDot True
+ unqtDot NoScale = unqtDot False
+ unqtDot FillWidth = text "width"
+ unqtDot FillHeight = text "height"
+ unqtDot FillBoth = text "both"
+
+instance ParseDot ScaleType where
+ parseUnqt = oneOf [ stringRep UniformScale "true"
+ , stringRep NoScale "false"
+ , stringRep FillWidth "width"
+ , stringRep FillHeight "height"
+ , stringRep FillBoth "both"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Justification = JLeft
+ | JRight
+ | JCenter
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot Justification where
+ unqtDot JLeft = char 'l'
+ unqtDot JRight = char 'r'
+ unqtDot JCenter = char 'c'
+
+instance ParseDot Justification where
+ parseUnqt = oneOf [ 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"
+
+ toDot (AspectRatio r) = toDot r
+ toDot r = unqtDot r
+
+instance ParseDot Ratios where
+ parseUnqt = parseRatio True
+
+ parse = quotedParse parseUnqt <|> parseRatio False
+
+parseRatio :: Bool -> Parse Ratios
+parseRatio q = oneOf [ AspectRatio <$> parseSignedFloat q
+ , stringRep FillRatio "fill"
+ , stringRep CompressRatio "compress"
+ , stringRep ExpandRatio "expand"
+ , stringRep AutoRatio "auto"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | A numeric type with an explicit separation between integers and
+-- floating-point values.
+data Number = Int Int
+ | Dbl Double
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Number where
+ unqtDot (Int i) = unqtDot i
+ unqtDot (Dbl d) = unqtDot d
+
+ toDot (Int i) = toDot i
+ toDot (Dbl d) = toDot d
+
+instance ParseDot Number where
+ parseUnqt = parseNumber True
+
+ parse = quotedParse parseUnqt
+ <|>
+ parseNumber False
+
+parseNumber :: Bool -> Parse Number
+parseNumber q = Dbl <$> parseStrictFloat q
+ <|>
+ Int <$> parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | If set, normalizes coordinates such that the first point is at
+-- the origin and the first edge is at the angle if specified.
+data Normalized = IsNormalized -- ^ Equivalent to @'NormalizedAngle' 0@.
+ | NotNormalized
+ | NormalizedAngle Double -- ^ Angle of first edge when
+ -- normalized. Requires
+ -- Graphviz >= 2.32.0.
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot Normalized where
+ unqtDot IsNormalized = unqtDot True
+ unqtDot NotNormalized = unqtDot False
+ unqtDot (NormalizedAngle a) = unqtDot a
+
+ toDot (NormalizedAngle a) = toDot a
+ toDot norm = unqtDot norm
+
+instance ParseDot Normalized where
+ parseUnqt = parseNormalized True
+
+ parse = quotedParse parseUnqt <|> parseNormalized False
+
+parseNormalized :: Bool -> Parse Normalized
+parseNormalized q = NormalizedAngle <$> parseSignedFloat q
+ <|>
+ bool NotNormalized IsNormalized <$> onlyBool
+
+-- -----------------------------------------------------------------------------
+
+-- | Determine how the 'Width' and 'Height' attributes specify the
+-- size of nodes.
+data NodeSize = GrowAsNeeded
+ -- ^ Nodes will be the smallest width and height
+ -- needed to contain the label and any possible
+ -- image. 'Width' and 'Height' are the minimum
+ -- allowed sizes.
+ | SetNodeSize
+ -- ^ 'Width' and 'Height' dictate the size of the node
+ -- with a warning if the label cannot fit in this.
+ | SetShapeSize
+ -- ^ 'Width' and 'Height' dictate the size of the
+ -- shape only and the label can expand out of the
+ -- shape (with a warning). Requires Graphviz >=
+ -- 2.38.0.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot NodeSize where
+ unqtDot GrowAsNeeded = unqtDot False
+ unqtDot SetNodeSize = unqtDot True
+ unqtDot SetShapeSize = text "shape"
+
+instance ParseDot NodeSize where
+ parseUnqt = bool GrowAsNeeded SetNodeSize <$> parseUnqt
+ <|>
+ stringRep SetShapeSize "shape"
+
+-- -----------------------------------------------------------------------------
+
+{-
+
+As of Graphviz 2.36.0 this was commented out; as such it might come
+back, so leave this here in case we need it again.
+
+data AspectType = RatioOnly Double
+ | RatioPassCount Double Int
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot AspectType where
+ unqtDot (RatioOnly r) = unqtDot r
+ unqtDot (RatioPassCount r p) = commaDel r p
+
+ toDot at@RatioOnly{} = unqtDot at
+ toDot at@RatioPassCount{} = dquotes $ unqtDot at
+
+instance ParseDot AspectType where
+ parseUnqt = fmap (uncurry RatioPassCount) commaSepUnqt
+ `onFail`
+ fmap RatioOnly parseUnqt
+
+
+ parse = quotedParse (uncurry RatioPassCount <$> commaSepUnqt)
+ `onFail`
+ fmap RatioOnly parse
+
+-}
diff --git a/Data/GraphViz/Commands.hs b/Data/GraphViz/Commands.hs
--- a/Data/GraphViz/Commands.hs
+++ b/Data/GraphViz/Commands.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}
{- |
Module : Data.GraphViz.Commands
@@ -47,17 +47,18 @@
import Data.GraphViz.Types
-- This is here just for Haddock linking purposes.
-import Data.GraphViz.Attributes.Complete(GraphvizCommand(..))
-import Data.GraphViz.Commands.IO(runCommand)
+import Data.GraphViz.Commands.Available
+import Data.GraphViz.Commands.IO (runCommand)
import Data.GraphViz.Exception
-import qualified Data.ByteString as SB
-import Data.Maybe(isJust)
-import System.IO(Handle, hSetBinaryMode, hPutStrLn, stderr)
-import Control.Monad(liftM, unless)
-import System.FilePath((<.>))
-import System.Directory(findExecutable)
-import System.Exit(ExitCode(..), exitWith)
+import Control.Monad (liftM, unless)
+import qualified Data.ByteString as SB
+import Data.Maybe (isJust)
+import Data.Version (Version (..), showVersion)
+import System.Directory (findExecutable)
+import System.Exit (ExitCode (..), exitWith)
+import System.FilePath ((<.>))
+import System.IO (Handle, hPutStrLn, hSetBinaryMode, stderr)
-- -----------------------------------------------------------------------------
@@ -114,9 +115,11 @@
-- layout performed.
| DotOutput -- ^ Reproduces the input along with
-- layout information.
- | XDot -- ^ As with 'DotOutput', but provides
- -- even more information on how the
- -- graph is drawn.
+ | XDot (Maybe Version)
+ -- ^ As with 'DotOutput', but provides even more
+ -- information on how the graph is drawn. The
+ -- optional 'Version' is the same as
+ -- specifying the @XDotVersion@ attribute.
| Eps -- ^ Encapsulated PostScript.
| Fig -- ^ FIG graphics language.
| Gd -- ^ Internal GD library format.
@@ -157,13 +160,13 @@
-- for mobile computing devices.
| WebP -- ^ Google's WebP format; requires
-- Graphviz >= 2.29.0.
- deriving (Eq, Ord, Bounded, Enum, Show, Read)
+ deriving (Eq, Ord, Show, Read)
instance GraphvizResult GraphvizOutput where
outputCall Bmp = "bmp"
outputCall Canon = "canon"
outputCall DotOutput = "dot"
- outputCall XDot = "xdot"
+ outputCall (XDot mv) = "xdot" ++ maybe "" (showVersion . (\v -> v {versionTags = []})) mv
outputCall Eps = "eps"
outputCall Fig = "fig"
outputCall Gd = "gd"
@@ -193,9 +196,9 @@
-- | A default file extension for each 'GraphvizOutput'.
defaultExtension :: GraphvizOutput -> String
defaultExtension Bmp = "bmp"
-defaultExtension Canon = "dot"
-defaultExtension DotOutput = "dot"
-defaultExtension XDot = "dot"
+defaultExtension Canon = "gv"
+defaultExtension DotOutput = "gv"
+defaultExtension XDot{} = "gv"
defaultExtension Eps = "eps"
defaultExtension Fig = "fig"
defaultExtension Gd = "gd"
diff --git a/Data/GraphViz/Commands/Available.hs b/Data/GraphViz/Commands/Available.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Commands/Available.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_HADDOCK hide #-}
+{- |
+ Module : Data.GraphViz.Commands.Available
+ Description : Available command-line programs
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ These are the known programs that read in Dot graphs.
+
+ -}
+module Data.GraphViz.Commands.Available where
+
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
+
+-- -----------------------------------------------------------------------------
+
+-- | The available Graphviz commands. The following directions are
+-- based upon those in the Graphviz man page (available online at
+-- , or if installed on your
+-- system @man graphviz@). Note that any command can be used on
+-- both directed and undirected graphs.
+--
+-- When used with the 'Layout' attribute, it overrides any actual
+-- command called on the dot graph.
+data GraphvizCommand = Dot -- ^ For hierachical graphs (ideal for
+ -- directed graphs).
+ | Neato -- ^ For symmetric layouts of graphs
+ -- (ideal for undirected graphs).
+ | TwoPi -- ^ For radial layout of graphs.
+ | Circo -- ^ For circular layout of graphs.
+ | Fdp -- ^ Spring-model approach for
+ -- undirected graphs.
+ | Sfdp -- ^ As with Fdp, but ideal for large
+ -- graphs.
+ | Osage -- ^ Filter for drawing clustered graphs,
+ -- requires Graphviz >= 2.28.0.
+ | Patchwork -- ^ Draw clustered graphs as treemaps,
+ -- requires Graphviz >= 2.28.0.
+ deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+instance PrintDot GraphvizCommand where
+ unqtDot Dot = text "dot"
+ unqtDot Neato = text "neato"
+ unqtDot TwoPi = text "twopi"
+ unqtDot Circo = text "circo"
+ unqtDot Fdp = text "fdp"
+ unqtDot Sfdp = text "sfdp"
+ unqtDot Osage = text "osage"
+ unqtDot Patchwork = text "patchwork"
+
+instance ParseDot GraphvizCommand where
+ parseUnqt = stringValue [ ("dot", Dot)
+ , ("neato", Neato)
+ , ("twopi", TwoPi)
+ , ("circo", Circo)
+ , ("fdp", Fdp)
+ , ("sfdp", Sfdp)
+ , ("osage", Osage)
+ , ("patchwork", Patchwork)
+ ]
diff --git a/Data/GraphViz/Commands/IO.hs b/Data/GraphViz/Commands/IO.hs
--- a/Data/GraphViz/Commands/IO.hs
+++ b/Data/GraphViz/Commands/IO.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
{- |
Module : Data.GraphViz.Commands.IO
Description : IO-related functions for graphviz.
@@ -26,29 +28,33 @@
, 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, renderOneLine)
+import Data.GraphViz.Internal.State (initialState)
+import Data.GraphViz.Printing (toDot)
+import Data.GraphViz.Types (ParseDotRepr, PrintDotRepr, parseDotGraph,
+ printDotGraph)
+import Text.PrettyPrint.Leijen.Text (displayT, renderOneLine)
-import qualified Data.Text.Lazy.Encoding as T
-import Data.Text.Encoding.Error(UnicodeException)
-import Data.Text.Lazy(Text)
-import qualified Data.ByteString as SB
-import qualified Data.ByteString.Lazy as B
-import Data.ByteString.Lazy(ByteString)
-import Control.Monad(liftM)
-import Control.Monad.Trans.State
-import System.IO(Handle, IOMode(ReadMode,WriteMode)
- , withFile, stdout, stdin, hPutChar
- , hClose, hGetContents)
-import System.IO.Temp(withSystemTempFile)
-import System.Exit(ExitCode(ExitSuccess))
-import System.Process(runInteractiveProcess, waitForProcess)
-import System.FilePath((<.>))
-import Control.Exception(IOException, evaluate, finally)
-import Control.Concurrent(MVar, forkIO, newEmptyMVar, putMVar, takeMVar)
+import Control.Concurrent (MVar, forkIO, newEmptyMVar, putMVar,
+ takeMVar)
+import Control.Exception (IOException, evaluate, finally)
+import Control.Monad (liftM)
+import Control.Monad.Trans.State
+import qualified Data.ByteString as SB
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as B
+import Data.Text.Encoding.Error (UnicodeException)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy.Encoding as T
+import System.Exit (ExitCode (ExitSuccess))
+import System.FilePath ((<.>))
+import System.IO (Handle,
+ IOMode (ReadMode, WriteMode),
+ hClose, hGetContents, hPutChar,
+ stdin, stdout, withFile)
+import System.IO.Temp (withSystemTempFile)
+import System.Process (runInteractiveProcess,
+ waitForProcess)
-- -----------------------------------------------------------------------------
diff --git a/Data/GraphViz/Internal/State.hs b/Data/GraphViz/Internal/State.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Internal/State.hs
@@ -0,0 +1,138 @@
+{-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
+{- |
+ Module : Data.GraphViz.Internal.State
+ Description : Printing and parsing state.
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ When printing and parsing Dot code, some items depend on values
+ that are set earlier.
+-}
+module Data.GraphViz.Internal.State
+ ( GraphvizStateM(..)
+ , GraphvizState(..)
+ , AttributeType(..)
+ , setAttributeType
+ , getAttributeType
+ , initialState
+ , setDirectedness
+ , getDirectedness
+ , setLayerSep
+ , getLayerSep
+ , setLayerListSep
+ , getLayerListSep
+ , setColorScheme
+ , getColorScheme
+ ) where
+
+import Data.GraphViz.Attributes.ColorScheme
+
+import Control.Monad.Trans.State (State, gets, modify)
+import Text.ParserCombinators.Poly.StateText (Parser, stQuery, stUpdate)
+
+-- -----------------------------------------------------------------------------
+
+class (Monad m) => GraphvizStateM m where
+ modifyGS :: (GraphvizState -> GraphvizState) -> m ()
+
+ getsGS :: (GraphvizState -> a) -> m a
+
+instance GraphvizStateM (State GraphvizState) where
+ modifyGS = modify
+
+ getsGS = gets
+
+instance GraphvizStateM (Parser GraphvizState) where
+ modifyGS = stUpdate
+
+ getsGS = stQuery
+
+data AttributeType = GraphAttribute
+ | SubGraphAttribute
+ | ClusterAttribute
+ | NodeAttribute
+ | EdgeAttribute
+ deriving (Eq, Ord, Show, Read)
+
+-- | Several aspects of Dot code are either global or mutable state.
+data GraphvizState = GS { parseStrictly :: !Bool
+ -- ^ If 'False', allow fallbacks for
+ -- attributes that don't match known
+ -- specification when parsing.
+ , directedEdges :: !Bool
+ , layerSep :: [Char]
+ , layerListSep :: [Char]
+ , attributeType :: !AttributeType
+ , graphColor :: !ColorScheme
+ , clusterColor :: !ColorScheme
+ , nodeColor :: !ColorScheme
+ , edgeColor :: !ColorScheme
+ }
+ deriving (Eq, Ord, Show, Read)
+
+initialState :: GraphvizState
+initialState = GS { parseStrictly = True
+ , directedEdges = True
+ , layerSep = defLayerSep
+ , layerListSep = defLayerListSep
+ , attributeType = GraphAttribute
+ , graphColor = X11
+ , clusterColor = X11
+ , nodeColor = X11
+ , edgeColor = X11
+ }
+
+setDirectedness :: (GraphvizStateM m) => Bool -> m ()
+setDirectedness d = modifyGS (\ gs -> gs { directedEdges = d } )
+
+getDirectedness :: (GraphvizStateM m) => m Bool
+getDirectedness = getsGS directedEdges
+
+setAttributeType :: (GraphvizStateM m) => AttributeType -> m ()
+setAttributeType tp = modifyGS $ \ gs -> gs { attributeType = tp }
+
+getAttributeType :: (GraphvizStateM m) => m AttributeType
+getAttributeType = getsGS attributeType
+
+setLayerSep :: (GraphvizStateM m) => [Char] -> m ()
+setLayerSep sep = modifyGS (\ gs -> gs { layerSep = sep } )
+
+getLayerSep :: (GraphvizStateM m) => m [Char]
+getLayerSep = getsGS layerSep
+
+setLayerListSep :: (GraphvizStateM m) => [Char] -> m ()
+setLayerListSep sep = modifyGS (\ gs -> gs { layerListSep = sep } )
+
+getLayerListSep :: (GraphvizStateM m) => m [Char]
+getLayerListSep = getsGS layerListSep
+
+setColorScheme :: (GraphvizStateM m) => ColorScheme -> m ()
+setColorScheme cs = do tp <- getsGS attributeType
+ modifyGS $ \gs -> case tp of
+ GraphAttribute -> gs { graphColor = cs }
+ -- subgraphs don't have specified scheme
+ SubGraphAttribute -> gs { graphColor = cs }
+ ClusterAttribute -> gs { clusterColor = cs }
+ NodeAttribute -> gs { nodeColor = cs }
+ EdgeAttribute -> gs { edgeColor = cs }
+
+getColorScheme :: (GraphvizStateM m) => m ColorScheme
+getColorScheme = do tp <- getsGS attributeType
+ getsGS $ case tp of
+ GraphAttribute -> graphColor
+ -- subgraphs don't have specified scheme
+ SubGraphAttribute -> graphColor
+ ClusterAttribute -> clusterColor
+ NodeAttribute -> nodeColor
+ EdgeAttribute -> edgeColor
+
+-- | The default separators for 'LayerSep'.
+defLayerSep :: [Char]
+defLayerSep = [' ', ':', '\t']
+
+-- | The default separators for 'LayerListSep'.
+defLayerListSep :: [Char]
+defLayerListSep = [',']
diff --git a/Data/GraphViz/Internal/Util.hs b/Data/GraphViz/Internal/Util.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Internal/Util.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE OverloadedStrings, PatternGuards #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+{- |
+ Module : Data.GraphViz.Internal.Util
+ Description : Internal utility functions
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ This module defines internal utility functions.
+-}
+module Data.GraphViz.Internal.Util where
+
+import Data.Char (isAsciiLower, isAsciiUpper, isDigit, ord)
+
+import Control.Monad (liftM2)
+import Data.Function (on)
+import Data.List (groupBy, sortBy)
+import Data.Maybe (isJust)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Read as T
+import Data.Version (Version (..))
+
+-- -----------------------------------------------------------------------------
+
+isIDString :: Text -> Bool
+isIDString = maybe False (\(f,os) -> frstIDString f && T.all restIDString os)
+ . T.uncons
+
+-- | First character of a non-quoted 'String' must match this.
+frstIDString :: Char -> Bool
+frstIDString c = any ($c) [ isAsciiUpper
+ , isAsciiLower
+ , (==) '_'
+ , (\ x -> ord x >= 128)
+ ]
+
+-- | The rest of a non-quoted 'String' must match this.
+restIDString :: Char -> Bool
+restIDString c = frstIDString c || isDigit c
+
+-- | Determine if this String represents a number.
+isNumString :: Text -> Bool
+isNumString "" = False
+isNumString "-" = False
+isNumString str = case T.uncons $ T.toLower str of
+ Just ('-',str') -> go str'
+ _ -> go str
+ where
+ -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all
+ -- possible cases
+ go s = uncurry go' $ T.span isDigit s
+ go' ds nds
+ | T.null nds = True
+ | T.null ds && nds == "." = False
+ | T.null ds
+ , Just ('.',nds') <- T.uncons nds
+ , Just (d,nds'') <- T.uncons nds' = isDigit d && checkEs' nds''
+ | Just ('.',nds') <- T.uncons nds = checkEs $ T.dropWhile isDigit nds'
+ | T.null ds = False
+ | otherwise = checkEs nds
+ checkEs' s = case T.break ('e' ==) s of
+ ("", _) -> False
+ (ds,es) -> T.all isDigit ds && checkEs es
+ checkEs str' = case T.uncons str' of
+ Nothing -> True
+ Just ('e',ds) -> isIntString ds
+ _ -> False
+
+{-
+-- | This assumes that 'isNumString' is 'True'.
+toDouble :: Text -> Double
+toDouble str = case T.uncons $ T.toLower str of
+ Just ('-', str') -> toD $ '-' `T.cons` adj str'
+ _ -> toD $ adj str
+ where
+ adj s = T.cons '0'
+ $ case T.span ('.' ==) s of
+ (ds, ".") | not $ T.null ds -> s `T.snoc` '0'
+ (ds, ds') | Just ('.',es) <- T.uncons ds'
+ , Just ('e',es') <- T.uncons es
+ -> ds `T.snoc` '.' `T.snoc` '0'
+ `T.snoc` 'e' `T.snoc` '0' `T.append` es'
+ _ -> s
+ toD = either (const $ error "Not a Double") fst . T.signed T.double
+-}
+-- | This assumes that 'isNumString' is 'True'.
+toDouble :: Text -> Double
+toDouble str = case T.uncons $ T.toLower str of
+ Just ('-', str') -> toD $ '-' `T.cons` adj str'
+ _ -> toD $ adj str
+ where
+ adj s = T.cons '0'
+ $ case T.span ('.' ==) s of
+ (ds, ".") | not $ T.null ds -> s `T.snoc` '0'
+ (ds, ds') | Just ('.',es) <- T.uncons ds'
+ , Just ('e',_) <- T.uncons es
+ -> ds `T.snoc` '.' `T.snoc` '0' `T.append` es
+ _ -> s
+ toD = read . T.unpack
+
+isIntString :: Text -> Bool
+isIntString = isJust . stringToInt
+
+-- | Determine if this String represents an integer.
+stringToInt :: Text -> Maybe Int
+stringToInt str = case T.signed T.decimal str of
+ Right (n, "") -> Just n
+ _ -> Nothing
+
+-- | Graphviz requires double quotes to be explicitly escaped.
+escapeQuotes :: String -> String
+escapeQuotes [] = []
+escapeQuotes ('"':str) = '\\':'"': escapeQuotes str
+escapeQuotes (c:str) = c : escapeQuotes str
+
+-- | Remove explicit escaping of double quotes.
+descapeQuotes :: String -> String
+descapeQuotes [] = []
+descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str
+descapeQuotes (c:str) = c : descapeQuotes str
+
+isKeyword :: Text -> Bool
+isKeyword = (`Set.member` keywords) . T.toLower
+
+-- | The following are Dot keywords and are not valid as labels, etc. unquoted.
+keywords :: Set Text
+keywords = Set.fromList [ "node"
+ , "edge"
+ , "graph"
+ , "digraph"
+ , "subgraph"
+ , "strict"
+ ]
+
+createVersion :: [Int] -> Version
+createVersion bs = Version { versionBranch = bs, versionTags = []}
+
+-- -----------------------------------------------------------------------------
+
+uniq :: (Ord a) => [a] -> [a]
+uniq = uniqBy id
+
+uniqBy :: (Ord b) => (a -> b) -> [a] -> [a]
+uniqBy f = map head . groupSortBy f
+
+groupSortBy :: (Ord b) => (a -> b) -> [a] -> [[a]]
+groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)
+
+groupSortCollectBy :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]
+groupSortCollectBy f g = map (liftM2 (,) (f . head) (map g)) . groupSortBy f
+
+-- | Fold over 'Bool's; first param is for 'False', second for 'True'.
+bool :: a -> a -> Bool -> a
+bool f t b = if b
+ then t
+ else f
+
+isSingle :: [a] -> Bool
+isSingle [_] = True
+isSingle _ = False
diff --git a/Data/GraphViz/Parsing.hs b/Data/GraphViz/Parsing.hs
--- a/Data/GraphViz/Parsing.hs
+++ b/Data/GraphViz/Parsing.hs
@@ -30,9 +30,10 @@
, parseIt'
, runParser
, runParser'
+ , runParserWith
+ , parseLiberally
, checkValidParse
-- * Convenience parsing combinators.
- , bracket
, ignoreSep
, onlyBool
, quotelessString
@@ -47,6 +48,7 @@
, strings
, character
, parseStrictFloat
+ , parseSignedFloat
, noneOf
, whitespace1
, whitespace
@@ -75,31 +77,32 @@
, parseColorScheme
) where
-import Data.GraphViz.Util
-import Data.GraphViz.State
+import Data.GraphViz.Exception (GraphvizException (NotDotCode), throw)
+import Data.GraphViz.Internal.State
+import Data.GraphViz.Internal.Util
+
-- To avoid orphan instances and cyclic imports
import Data.GraphViz.Attributes.ColorScheme
-import Data.GraphViz.Exception(GraphvizException(NotDotCode), throw)
-import Text.ParserCombinators.Poly.StateText hiding (bracket, empty, indent, runParser)
+import Text.ParserCombinators.Poly.StateText hiding (empty, indent,
+ runParser)
import qualified Text.ParserCombinators.Poly.StateText as P
-import Data.Char( isDigit
- , isSpace
- , isLower
- , toLower
- , toUpper
- )
-import Data.List(groupBy, sortBy)
-import Data.Function(on)
-import Data.Maybe(fromMaybe, isJust, isNothing, listToMaybe)
-import Data.Ratio((%))
-import qualified Data.Set as Set
-import qualified Data.Text.Lazy as T
+
+import Control.Arrow (first, second)
+import Control.Monad (when)
+import Data.Char (isDigit, isLower, isSpace, toLower,
+ toUpper)
+import Data.Function (on)
+import Data.List (groupBy, sortBy)
+import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe,
+ maybeToList)
+import Data.Ratio ((%))
+import qualified Data.Set as Set
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Read as T
-import Data.Text.Lazy(Text)
-import Data.Word(Word8, Word16)
-import Control.Arrow(first, second)
-import Control.Monad(when)
+import Data.Version (Version (..))
+import Data.Word (Word16, Word8)
-- -----------------------------------------------------------------------------
-- Based off code from Text.Parse in the polyparse library
@@ -107,10 +110,17 @@
-- | A @ReadS@-like type alias.
type Parse a = Parser GraphvizState a
-runParser :: Parse a -> Text -> (Either String a, Text)
-runParser p t = let (r,_,t') = P.runParser p initialState t
- in (r,t')
+runParser :: Parse a -> Text -> (Either String a, Text)
+runParser = runParserWith id
+parseLiberally :: GraphvizState -> GraphvizState
+parseLiberally gs = gs { parseStrictly = False }
+
+runParserWith :: (GraphvizState -> GraphvizState) -> Parse a -> Text
+ -> (Either String a, Text)
+runParserWith f p t = let (r,_,t') = P.runParser p (f initialState) t
+ in (r,t')
+
-- | A variant of 'runParser' where it is assumed that the provided
-- parsing function consumes all of the 'Text' input (with the
-- exception of whitespace at the end).
@@ -138,7 +148,7 @@
parseList = quotedParse parseUnqtList
-- | Parse the required value, returning also the rest of the input
--- 'String' that hasn't been parsed (for debugging purposes).
+-- 'Text' that hasn't been parsed (for debugging purposes).
parseIt :: (ParseDot a) => Text -> (a, Text)
parseIt = first checkValidParse . runParser parse
@@ -149,12 +159,12 @@
checkValidParse (Right a) = a
-- | Parse the required value with the assumption that it will parse
--- all of the input 'String'.
+-- all of the input 'Text'.
parseIt' :: (ParseDot a) => Text -> a
parseIt' = runParser' parse
instance ParseDot Int where
- parseUnqt = parseInt'
+ parseUnqt = parseSignedInt
instance ParseDot Integer where
parseUnqt = parseSigned parseInt
@@ -166,8 +176,11 @@
parseUnqt = parseInt
instance ParseDot Double where
- parseUnqt = parseFloat'
+ parseUnqt = parseSignedFloat True
+ parse = quotedParse parseUnqt
+ <|> parseSignedFloat False
+
parseUnqtList = sepBy1 parseUnqt (character ':')
parseList = quotedParse parseUnqtList
@@ -177,7 +190,7 @@
instance ParseDot Bool where
parseUnqt = onlyBool
`onFail`
- fmap (zero /=) parseInt'
+ fmap (zero /=) parseSignedInt
where
zero :: Int
zero = 0
@@ -200,6 +213,20 @@
parseList = T.unpack <$> parse
+-- | Ignores 'versionTags' and assumes 'not . null . versionBranch'
+-- (usually you want 'length . versionBranch == 2') and that all
+-- such values are non-negative.
+instance ParseDot Version where
+ parseUnqt = createVersion <$> sepBy1 (parseIntCheck False) (character '.')
+
+ parse = quotedParse parseUnqt
+ <|>
+ (createVersion .) . (. maybeToList) . (:)
+ <$> (parseIntCheck False) <*> optional (character '.' *> parseInt)
+ -- Leave the last one to check for possible decimals
+ -- afterwards as there should be at most two version
+ -- numbers here.
+
instance ParseDot Text where
-- Too many problems with using this within other parsers where
-- using numString or stringBlock will cause a parse failure. As
@@ -217,14 +244,14 @@
parse = parseList
--- | Parse a 'String' that doesn't need to be quoted.
+-- | Parse a 'Text' that doesn't need to be quoted.
quotelessString :: Parse Text
-quotelessString = numString `onFail` stringBlock
+quotelessString = numString False `onFail` stringBlock
-numString :: Parse Text
-numString = fmap tShow parseStrictFloat
- `onFail`
- fmap tShow parseInt'
+numString :: Bool -> Parse Text
+numString q = fmap tShow (parseStrictFloat q)
+ `onFail`
+ fmap tShow parseSignedInt
where
tShow :: (Show a) => a -> Text
tShow = T.pack . show
@@ -242,68 +269,65 @@
p
parseInt :: (Integral a) => Parse a
-parseInt = do cs <- many1Satisfy isDigit
- `adjustErr` ("Expected one or more digits\n\t"++)
- case T.decimal cs of
- Right (n,"") -> checkInt n
- -- This case should never actually happen...
- Right (_,txt) -> fail $ "Trailing digits not parsed as Integral: " ++ T.unpack txt
- Left err -> fail $ "Could not read Integral: " ++ err
+parseInt = parseIntCheck True
+
+-- | Flag indicates whether to check whether the number is actually a
+-- floating-point value.
+parseIntCheck :: (Integral a) => Bool -> Parse a
+parseIntCheck ch = do cs <- many1Satisfy isDigit
+ `adjustErr` ("Expected one or more digits\n\t"++)
+ case T.decimal cs of
+ Right (n,"") -> bool return checkInt ch n
+ -- This case should never actually happen...
+ Right (_,txt) -> fail $ "Trailing digits not parsed as Integral: " ++ T.unpack txt
+ Left err -> fail $ "Could not read Integral: " ++ err
where
checkInt n = do c <- optional $ oneOf [ character '.', character 'e' ]
if isJust c
then fail "This number is actually Floating, not Integral!"
else return n
-parseInt' :: Parse Int
-parseInt' = parseSigned parseInt
+parseSignedInt :: Parse Int
+parseSignedInt = parseSigned parseInt
-- | Parse a floating point number that actually contains decimals.
-parseStrictFloat :: Parse Double
-parseStrictFloat = parseSigned parseFloat
+-- Bool flag indicates whether values that need to be quoted are
+-- parsed.
+parseStrictFloat :: Bool -> Parse Double
+parseStrictFloat = parseSigned . parseFloat
-parseFloat :: (RealFrac a) => Parse a
-parseFloat = do ds <- manySatisfy isDigit
- frac <- optional $ character '.' *> manySatisfy isDigit
- when (T.null ds && noDec frac)
- (fail "No actual digits in floating point number!")
- expn <- optional parseExp
- when (isNothing frac && isNothing expn)
- (fail "This is an integer, not a floating point number!")
- let frac' = fromMaybe "" frac
- expn' = fromMaybe 0 expn
- ( return . fromRational . (* (10^^(expn' - fromIntegral (T.length frac'))))
- . (%1) . runParser' parseInt) (ds `T.append` frac')
- `onFail`
- fail "Expected a floating point number"
+-- | Bool flag indicates whether to allow parsing exponentiated term,
+-- as this is only allowed when quoted.
+parseFloat :: (RealFrac a) => Bool -> Parse a
+parseFloat q = do ds <- manySatisfy isDigit
+ frac <- optional $ character '.' *> manySatisfy isDigit
+ when (T.null ds && noDec frac)
+ (fail "No actual digits in floating point number!")
+ expn <- bool (pure Nothing) (optional parseExp) q
+ when (isNothing frac && isNothing expn)
+ (fail "This is an integer, not a floating point number!")
+ let frac' = fromMaybe "" frac
+ expn' = fromMaybe 0 expn
+ ( return . fromRational . (* (10^^(expn' - fromIntegral (T.length frac'))))
+ . (%1) . runParser' parseInt) (ds `T.append` frac')
+ `onFail`
+ fail "Expected a floating point number"
where
parseExp = character 'e'
*> ((character '+' *> parseInt)
`onFail`
- parseInt')
+ parseSignedInt)
noDec = maybe True T.null
-parseFloat' :: Parse Double
-parseFloat' = parseSigned ( parseFloat
- `onFail`
- fmap fI parseInt
- )
+-- Bool indicates whether we can parse values that need quotes.
+parseSignedFloat :: Bool -> Parse Double
+parseSignedFloat q = parseSigned ( parseFloat q <|> fmap fI parseInt )
where
fI :: Integer -> Double
fI = fromIntegral
-- -----------------------------------------------------------------------------
--- | Parse a bracketed item, discarding the brackets.
---
--- The definition of @bracket@ defined in Polyparse uses
--- 'adjustErrBad' and thus doesn't allow backtracking and trying the
--- next possible parser. This is a version of @bracket@ that does.
-bracket :: Parse bra -> Parse ket -> Parse a -> Parse a
-bracket open close pa = (open `adjustErr` ("Missing opening bracket:\n\t"++))
- *> pa
- <* (close `adjustErr` ("Was expecting closing bracket:\n\t"++))
-
parseAndSpace :: Parse a -> Parse a
parseAndSpace p = p `discard` whitespace
@@ -331,6 +355,8 @@
strings :: [String] -> Parse ()
strings = oneOf . map string
+-- | Assumes that any letter is ASCII for case-insensitive
+-- comparisons.
character :: Char -> Parse Char
character c = satisfy parseC
`adjustErr`
@@ -378,11 +404,10 @@
quoteChar :: Char
quoteChar = '"'
--- | Parse a 'String' where the provided 'Char's (as well as @\"@ and
+-- | Parse a 'Text' where the provided 'Char's (as well as @\"@ and
-- @\\@) are escaped and the second list of 'Char's are those that
-- are not permitted. Note: does not parse surrounding quotes. The
--- 'Bool' value indicates whether empty 'String's are allowed or
--- not.
+-- 'Bool' value indicates whether empty 'Text's are allowed or not.
parseEscaped :: Bool -> [Char] -> [Char] -> Parse Text
parseEscaped empt cs bnd = fmap T.pack . lots $ qPrs `onFail` oth
where
diff --git a/Data/GraphViz/Printing.hs b/Data/GraphViz/Printing.hs
--- a/Data/GraphViz/Printing.hs
+++ b/Data/GraphViz/Printing.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Data.GraphViz.Printing
@@ -47,7 +48,7 @@
module Data.GraphViz.Printing
( module Text.PrettyPrint.Leijen.Text.Monadic
, DotCode
- , renderDot -- Exported for Data.GraphViz.Types.printSGID
+ , renderDot -- Exported for Data.GraphViz.Types.Internal.Common.printSGID
, PrintDot(..)
, unqtText
, dotText
@@ -63,33 +64,29 @@
, printColorScheme
) where
-import Data.GraphViz.Util
-import Data.GraphViz.State
+import Data.GraphViz.Internal.State
+import Data.GraphViz.Internal.Util
-- To avoid orphan instances and cyclic imports
import Data.GraphViz.Attributes.ColorScheme
-- Only implicitly import and re-export combinators.
-import Text.PrettyPrint.Leijen.Text.Monadic hiding ( SimpleDoc(..)
- , renderPretty
- , renderCompact
- , displayT
- , displayIO
- , putDoc
- , hPutDoc
- , Pretty(..)
- , bool
- , string
- , width
- , (<$>))
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import Text.PrettyPrint.Leijen.Text.Monadic hiding (Pretty (..),
+ SimpleDoc (..), bool,
+ displayIO, displayT,
+ hPutDoc, putDoc,
+ renderCompact,
+ renderPretty, string,
+ width, (<$>))
import qualified Text.PrettyPrint.Leijen.Text.Monadic as PP
-import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import Data.Char(toLower)
-import qualified Data.Set as Set
-import Data.Word(Word8, Word16)
-import Control.Monad(ap, when)
-import Control.Monad.Trans.State
+import Control.Monad (ap, when)
+import Control.Monad.Trans.State
+import Data.Char (toLower)
+import qualified Data.Set as Set
+import Data.Version (Version (..))
+import Data.Word (Word16, Word8)
-- -----------------------------------------------------------------------------
@@ -178,6 +175,14 @@
unqtListToDot = unqtDot . T.pack
listToDot = toDot . T.pack
+
+-- | Ignores 'versionTags' and assumes 'not . null . versionBranch'
+-- (usually you want 'length . versionBranch == 2').
+instance PrintDot Version where
+ unqtDot = hcat . punctuate dot . mapM int . versionBranch
+
+ toDot v = bool id dquotes (not . null . drop 2 . versionBranch $ v)
+ $ unqtDot v
instance PrintDot Text where
unqtDot = unqtString
diff --git a/Data/GraphViz/State.hs b/Data/GraphViz/State.hs
deleted file mode 100644
--- a/Data/GraphViz/State.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-
-{- |
- Module : Data.GraphViz.State
- Description : Printing and parsing state.
- Copyright : (c) Ivan Lazar Miljenovic
- License : 3-Clause BSD-style
- Maintainer : Ivan.Miljenovic@gmail.com
-
- When printing and parsing Dot code, some items depend on values
- that are set earlier.
--}
-module Data.GraphViz.State
- ( GraphvizStateM(..)
- , GraphvizState(..)
- , AttributeType(..)
- , setAttributeType
- , getAttributeType
- , initialState
- , setDirectedness
- , getDirectedness
- , setLayerSep
- , getLayerSep
- , setLayerListSep
- , getLayerListSep
- , setColorScheme
- , getColorScheme
- ) where
-
-import Data.GraphViz.Attributes.ColorScheme
-
-import Control.Monad.Trans.State(State, modify, gets)
-import Text.ParserCombinators.Poly.StateText(Parser, stUpdate, stQuery)
-
--- -----------------------------------------------------------------------------
-
-class (Monad m) => GraphvizStateM m where
- modifyGS :: (GraphvizState -> GraphvizState) -> m ()
-
- getsGS :: (GraphvizState -> a) -> m a
-
-instance GraphvizStateM (State GraphvizState) where
- modifyGS = modify
-
- getsGS = gets
-
-instance GraphvizStateM (Parser GraphvizState) where
- modifyGS = stUpdate
-
- getsGS = stQuery
-
-data AttributeType = GraphAttribute
- | SubGraphAttribute
- | ClusterAttribute
- | NodeAttribute
- | EdgeAttribute
- deriving (Eq, Ord, Show, Read)
-
--- | Several aspects of Dot code are either global or mutable state.
-data GraphvizState = GS { directedEdges :: !Bool
- , layerSep :: [Char]
- , layerListSep :: [Char]
- , attributeType :: !AttributeType
- , graphColor :: !ColorScheme
- , clusterColor :: !ColorScheme
- , nodeColor :: !ColorScheme
- , edgeColor :: !ColorScheme
- }
- deriving (Eq, Ord, Show, Read)
-
-initialState :: GraphvizState
-initialState = GS { directedEdges = True
- , layerSep = defLayerSep
- , layerListSep = defLayerListSep
- , attributeType = GraphAttribute
- , graphColor = X11
- , clusterColor = X11
- , nodeColor = X11
- , edgeColor = X11
- }
-
-setDirectedness :: (GraphvizStateM m) => Bool -> m ()
-setDirectedness d = modifyGS (\ gs -> gs { directedEdges = d } )
-
-getDirectedness :: (GraphvizStateM m) => m Bool
-getDirectedness = getsGS directedEdges
-
-setAttributeType :: (GraphvizStateM m) => AttributeType -> m ()
-setAttributeType tp = modifyGS $ \ gs -> gs { attributeType = tp }
-
-getAttributeType :: (GraphvizStateM m) => m AttributeType
-getAttributeType = getsGS attributeType
-
-setLayerSep :: (GraphvizStateM m) => [Char] -> m ()
-setLayerSep sep = modifyGS (\ gs -> gs { layerSep = sep } )
-
-getLayerSep :: (GraphvizStateM m) => m [Char]
-getLayerSep = getsGS layerSep
-
-setLayerListSep :: (GraphvizStateM m) => [Char] -> m ()
-setLayerListSep sep = modifyGS (\ gs -> gs { layerListSep = sep } )
-
-getLayerListSep :: (GraphvizStateM m) => m [Char]
-getLayerListSep = getsGS layerListSep
-
-setColorScheme :: (GraphvizStateM m) => ColorScheme -> m ()
-setColorScheme cs = do tp <- getsGS attributeType
- modifyGS $ \gs -> case tp of
- GraphAttribute -> gs { graphColor = cs }
- -- subgraphs don't have specified scheme
- SubGraphAttribute -> gs { graphColor = cs }
- ClusterAttribute -> gs { clusterColor = cs }
- NodeAttribute -> gs { nodeColor = cs }
- EdgeAttribute -> gs { edgeColor = cs }
-
-getColorScheme :: (GraphvizStateM m) => m ColorScheme
-getColorScheme = do tp <- getsGS attributeType
- getsGS $ case tp of
- GraphAttribute -> graphColor
- -- subgraphs don't have specified scheme
- SubGraphAttribute -> graphColor
- ClusterAttribute -> clusterColor
- NodeAttribute -> nodeColor
- EdgeAttribute -> edgeColor
-
--- | The default separators for 'LayerSep'.
-defLayerSep :: [Char]
-defLayerSep = [' ', ':', '\t']
-
--- | The default separators for 'LayerListSep'.
-defLayerListSep :: [Char]
-defLayerListSep = [',']
diff --git a/Data/GraphViz/Types.hs b/Data/GraphViz/Types.hs
--- a/Data/GraphViz/Types.hs
+++ b/Data/GraphViz/Types.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
+ TypeSynonymInstances #-}
{- |
Module : Data.GraphViz.Types
@@ -35,30 +36,30 @@
> digraph G {
>
- > subgraph cluster_0 {
- > style=filled;
- > color=lightgrey;
- > node [style=filled,color=white];
- > a0 -> a1 -> a2 -> a3;
- > label = "process #1";
- > }
+ > subgraph cluster_0 {
+ > style=filled;
+ > color=lightgrey;
+ > node [style=filled,color=white];
+ > a0 -> a1 -> a2 -> a3;
+ > label = "process #1";
+ > }
>
- > subgraph cluster_1 {
- > node [style=filled];
- > b0 -> b1 -> b2 -> b3;
- > label = "process #2";
- > color=blue
- > }
- > start -> a0;
- > start -> b0;
- > a1 -> b3;
- > b2 -> a3;
- > a3 -> a0;
- > a3 -> end;
- > b3 -> end;
+ > subgraph cluster_1 {
+ > node [style=filled];
+ > b0 -> b1 -> b2 -> b3;
+ > label = "process #2";
+ > color=blue
+ > }
+ > start -> a0;
+ > start -> b0;
+ > a1 -> b3;
+ > b2 -> a3;
+ > a3 -> a0;
+ > a3 -> end;
+ > b3 -> end;
>
- > start [shape=Mdiamond];
- > end [shape=Msquare];
+ > start [shape=Mdiamond];
+ > end [shape=Msquare];
> }
Each representation is suited for different things:
@@ -94,6 +95,7 @@
, PPDotRepr
-- * Common sub-types
, GraphID(..)
+ , Number (..)
, ToGraphID(..)
, textGraphID
, GlobalAttributes(..)
@@ -112,26 +114,33 @@
-- * Printing and parsing a @DotRepr@.
, printDotGraph
, parseDotGraph
+ , parseDotGraphLiberally
-- * Limitations and documentation
-- $limitations
) where
-import Data.GraphViz.Types.Canonical( DotGraph(..), DotStatements(..)
- , DotSubGraph(..))
-import Data.GraphViz.Types.Common( GraphID(..), GlobalAttributes(..), withGlob
- , DotNode(..), DotEdge(..), numericValue)
+import Data.GraphViz.Attributes.Complete (rmUnwantedAttributes,
+ usedByClusters, usedByEdges,
+ usedByGraphs, usedByNodes)
+import Data.GraphViz.Internal.State (GraphvizState)
+import Data.GraphViz.Internal.Util (bool)
+import Data.GraphViz.Parsing (ParseDot (..), adjustErr,
+ checkValidParse, parse,
+ parseLiberally, runParserWith)
+import Data.GraphViz.PreProcessing (preProcess)
+import Data.GraphViz.Printing (PrintDot (..), printIt)
+import Data.GraphViz.Types.Canonical (DotGraph (..), DotStatements (..),
+ DotSubGraph (..))
+import Data.GraphViz.Types.Internal.Common (DotEdge (..), DotNode (..),
+ GlobalAttributes (..), GraphID (..),
+ Number (..), numericValue, withGlob)
import Data.GraphViz.Types.State
-import Data.GraphViz.Attributes.Complete( rmUnwantedAttributes, usedByGraphs
- , usedByClusters, usedByNodes, usedByEdges)
-import Data.GraphViz.Util(bool)
-import Data.GraphViz.Parsing(ParseDot(..), runParser, checkValidParse, parse, adjustErr)
-import Data.GraphViz.PreProcessing(preProcess)
-import Data.GraphViz.Printing(PrintDot(..), printIt)
-import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import Control.Arrow(first, second, (***))
-import Control.Monad.Trans.State(get, put, modify, execState, evalState)
+import Control.Arrow (first, second, (***))
+import Control.Monad.Trans.State (evalState, execState, get, modify,
+ put)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
-- -----------------------------------------------------------------------------
@@ -147,6 +156,9 @@
class (Ord n) => DotRepr dg n where
-- | Convert from a graph in canonical form. This is especially
-- useful when using the functions from "Data.GraphViz.Algorithms".
+ --
+ -- See @FromGeneralisedDot@ in "Data.GraphViz.Types.Generalised"
+ -- for a semi-inverse of this function.
fromCanonical :: DotGraph n -> dg n
-- | Return the ID of the graph.
@@ -260,9 +272,23 @@
--
-- Also removes any comments, etc. before parsing.
parseDotGraph :: (ParseDotRepr dg n) => Text -> dg n
-parseDotGraph = fst . prs . preProcess
+parseDotGraph = parseDotGraphWith id
+
+-- | As with 'parseDotGraph', but if an 'Attribute' cannot be parsed
+-- strictly according to the known rules, let it fall back to being
+-- parsed as an 'UnknownAttribute'. This is especially useful for
+-- when using a version of Graphviz that is either newer (especially
+-- for the XDot attributes) or older (when some attributes have
+-- changed) but you'd still prefer it to parse rather than throwing
+-- an error.
+parseDotGraphLiberally :: (ParseDotRepr dg n) => Text -> dg n
+parseDotGraphLiberally = parseDotGraphWith parseLiberally
+
+parseDotGraphWith :: (ParseDotRepr dg n) => (GraphvizState -> GraphvizState)
+ -> Text -> dg n
+parseDotGraphWith f = fst . prs . preProcess
where
- prs = first checkValidParse . runParser parse'
+ prs = first checkValidParse . runParserWith f parse'
parse' = parse `adjustErr`
("Unable to parse the Dot graph; usually this is because of either:\n\
@@ -342,7 +368,7 @@
sgRe sg = do sgid' <- case subGraphID sg of
Nothing -> do n <- get
put $ succ n
- return . Just $ Int n
+ return . Just . Num $ Int n
sgid -> return sgid
stmts' <- stRe $ subGraphStmts sg
return $ sg { subGraphID = sgid'
@@ -385,14 +411,14 @@
toGraphID = toGraphID . T.singleton
instance ToGraphID Int where
- toGraphID = Int
+ toGraphID = Num . Int
-- | This instance loses precision by going via 'Int'.
instance ToGraphID Integer where
- toGraphID = Int . fromInteger
+ toGraphID = Num . Int . fromInteger
instance ToGraphID Double where
- toGraphID = Dbl
+ toGraphID = Num . Dbl
-- -----------------------------------------------------------------------------
diff --git a/Data/GraphViz/Types/Canonical.hs b/Data/GraphViz/Types/Canonical.hs
--- a/Data/GraphViz/Types/Canonical.hs
+++ b/Data/GraphViz/Types/Canonical.hs
@@ -84,13 +84,13 @@
, DotEdge(..)
) where
-import Data.GraphViz.Types.Common
+import Data.GraphViz.Internal.State (AttributeType (..))
+import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Parsing
import Data.GraphViz.Printing
-import Data.GraphViz.State(AttributeType(..))
-import Data.GraphViz.Util(bool)
+import Data.GraphViz.Types.Internal.Common
-import Control.Arrow((&&&))
+import Control.Arrow ((&&&))
-- -----------------------------------------------------------------------------
diff --git a/Data/GraphViz/Types/Common.hs b/Data/GraphViz/Types/Common.hs
deleted file mode 100644
--- a/Data/GraphViz/Types/Common.hs
+++ /dev/null
@@ -1,528 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_HADDOCK hide #-}
-
-{- |
- Module : Data.GraphViz.Types.Common
- Description : Common internal functions for dealing with overall types.
- Copyright : (c) Ivan Lazar Miljenovic
- License : 3-Clause BSD-style
- Maintainer : Ivan.Miljenovic@gmail.com
-
- This module provides common functions used by both
- "Data.GraphViz.Types" as well as "Data.GraphViz.Types.Generalised".
--}
-module Data.GraphViz.Types.Common where
-
-import Data.GraphViz.Parsing
-import Data.GraphViz.Printing
-import Data.GraphViz.State
-import Data.GraphViz.Util
-import Data.GraphViz.Attributes.Complete( Attributes, Attribute(HeadPort, TailPort)
- , usedByGraphs, usedByClusters
- , usedByNodes)
-import Data.GraphViz.Attributes.Internal(PortPos, parseEdgeBasedPP)
-
-import Data.Maybe(isJust)
-import qualified Data.Text.Lazy as T
-import qualified Data.Text.Lazy.Read as T
-import Data.Text.Lazy(Text)
-import Control.Monad(when, unless)
-
--- -----------------------------------------------------------------------------
--- This is re-exported by Data.GraphViz.Types
-
--- | A polymorphic type that covers all possible ID values allowed by
--- Dot syntax. Note that whilst the 'ParseDot' and 'PrintDot'
--- instances for 'String' will properly take care of the special
--- cases for numbers, they are treated differently here.
-data GraphID = Str Text
- | Int Int
- | Dbl Double
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot GraphID where
- unqtDot (Str str) = unqtDot str
- unqtDot (Int i) = unqtDot i
- unqtDot (Dbl d) = unqtDot d
-
- toDot (Str str) = toDot str
- toDot gID = unqtDot gID
-
-instance ParseDot GraphID where
- parseUnqt = stringNum <$> parseUnqt
-
- parse = stringNum <$> parse
- `adjustErr`
- ("Not a valid GraphID\n\t"++)
-
-stringNum :: Text -> GraphID
-stringNum str = maybe checkDbl Int $ stringToInt str
- where
- checkDbl = if isNumString str
- then Dbl $ toDouble str
- else Str str
-
-numericValue :: GraphID -> Maybe Int
-numericValue (Str str) = either (const Nothing) (Just . round . fst)
- $ T.signed T.double str
-numericValue (Int n) = Just n
-numericValue (Dbl x) = Just $ round x
-
--- -----------------------------------------------------------------------------
-
--- Re-exported by Data.GraphViz.Types.*
-
--- | Represents a list of top-level list of 'Attribute's for the
--- entire graph/sub-graph. Note that 'GraphAttrs' also applies to
--- 'DotSubGraph's.
---
--- Note that Dot allows a single 'Attribute' to be listed on a line;
--- if this is the case then when parsing, the type of 'Attribute' it
--- is determined and that type of 'GlobalAttribute' is created.
-data GlobalAttributes = GraphAttrs { attrs :: Attributes }
- | NodeAttrs { attrs :: Attributes }
- | EdgeAttrs { attrs :: Attributes }
- deriving (Eq, Ord, Show, Read)
-
-instance PrintDot GlobalAttributes where
- unqtDot = printAttrBased True printGlobAttrType globAttrType attrs
-
- unqtListToDot = printAttrBasedList True printGlobAttrType globAttrType attrs
-
- listToDot = unqtListToDot
-
--- GraphAttrs, NodeAttrs and EdgeAttrs respectively
-partitionGlobal :: [GlobalAttributes] -> (Attributes, Attributes, Attributes)
-partitionGlobal = foldr select ([], [], [])
- where
- select globA ~(gs,ns,es) = case globA of
- GraphAttrs as -> (as ++ gs, ns, es)
- NodeAttrs as -> (gs, as ++ ns, es)
- EdgeAttrs as -> (gs, ns, as ++ es)
-
-unPartitionGlobal :: (Attributes, Attributes, Attributes) -> [GlobalAttributes]
-unPartitionGlobal (gas,nas,eas) = [ GraphAttrs gas
- , NodeAttrs nas
- , EdgeAttrs eas
- ]
-
-printGlobAttrType :: GlobalAttributes -> DotCode
-printGlobAttrType GraphAttrs{} = text "graph"
-printGlobAttrType NodeAttrs{} = text "node"
-printGlobAttrType EdgeAttrs{} = text "edge"
-
-instance ParseDot GlobalAttributes where
- -- Not using parseAttrBased here because we want to force usage of
- -- Attributes.
- parseUnqt = do gat <- parseGlobAttrType
-
- -- Determine if we need to set the attribute type.
- let mtp = globAttrType $ gat [] -- Only need the constructor
- oldTp <- getAttributeType
- maybe (return ()) setAttributeType mtp
-
- as <- whitespace *> parse
-
- -- Safe to set back even if not changed.
- setAttributeType oldTp
- return $ gat as
- `onFail`
- fmap determineType parse
-
- parse = parseUnqt -- Don't want the option of quoting
- `adjustErr`
- ("Not a valid listing of global attributes\n\t"++)
-
- -- Have to do this manually because of the special case
- parseUnqtList = parseStatements parseUnqt
-
- parseList = parseUnqtList
-
--- Cheat: rather than determine whether it's a graph, cluster or
--- sub-graph just don't set it.
-globAttrType :: GlobalAttributes -> Maybe AttributeType
-globAttrType NodeAttrs{} = Just NodeAttribute
-globAttrType EdgeAttrs{} = Just EdgeAttribute
-globAttrType _ = Nothing
-
-parseGlobAttrType :: Parse (Attributes -> GlobalAttributes)
-parseGlobAttrType = oneOf [ stringRep GraphAttrs "graph"
- , stringRep NodeAttrs "node"
- , stringRep EdgeAttrs "edge"
- ]
-
-determineType :: Attribute -> GlobalAttributes
-determineType attr
- | usedByGraphs attr = GraphAttrs attr'
- | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case
- | usedByNodes attr = NodeAttrs attr'
- | otherwise = EdgeAttrs attr' -- Must be for edges.
- where
- attr' = [attr]
-
-withGlob :: (Attributes -> Attributes) -> GlobalAttributes -> GlobalAttributes
-withGlob f (GraphAttrs as) = GraphAttrs $ f as
-withGlob f (NodeAttrs as) = NodeAttrs $ f as
-withGlob f (EdgeAttrs as) = EdgeAttrs $ f as
-
--- -----------------------------------------------------------------------------
-
--- | A node in 'DotGraph'.
-data DotNode n = DotNode { nodeID :: n
- , nodeAttributes :: Attributes
- }
- deriving (Eq, Ord, Show, Read)
-
-instance (PrintDot n) => PrintDot (DotNode n) where
- unqtDot = printAttrBased False printNodeID
- (const $ Just NodeAttribute) nodeAttributes
-
- unqtListToDot = printAttrBasedList False printNodeID
- (const $ Just NodeAttribute) nodeAttributes
-
- listToDot = unqtListToDot
-
-printNodeID :: (PrintDot n) => DotNode n -> DotCode
-printNodeID = toDot . nodeID
-
-instance (ParseDot n) => ParseDot (DotNode n) where
- parseUnqt = parseAttrBased NodeAttribute False parseNodeID
-
- parse = parseUnqt -- Don't want the option of quoting
-
- parseUnqtList = parseAttrBasedList NodeAttribute False parseNodeID
-
- parseList = parseUnqtList
-
-parseNodeID :: (ParseDot n) => Parse (Attributes -> DotNode n)
-parseNodeID = DotNode <$> parseAndCheck
- where
- parseAndCheck = do n <- parse
- me <- optional parseUnwanted
- maybe (return n) (const notANode) me
- notANode = fail "This appears to be an edge, not a node"
- parseUnwanted = oneOf [ parseEdgeType *> return ()
- , character ':' *> return () -- PortPos value
- ]
-
-instance Functor DotNode where
- fmap f n = n { nodeID = f $ nodeID n }
-
--- -----------------------------------------------------------------------------
-
--- This is re-exported in Data.GraphViz.Types; defined here so that
--- Generalised can access and use parseEdgeLine (needed for "a -> b ->
--- c"-style edge statements).
-
--- | An edge in 'DotGraph'.
-data DotEdge n = DotEdge { fromNode :: n
- , toNode :: n
- , edgeAttributes :: Attributes
- }
- deriving (Eq, Ord, Show, Read)
-
-instance (PrintDot n) => PrintDot (DotEdge n) where
- unqtDot = printAttrBased False printEdgeID
- (const $ Just EdgeAttribute) edgeAttributes
-
- unqtListToDot = printAttrBasedList False printEdgeID
- (const $ Just EdgeAttribute) edgeAttributes
-
- listToDot = unqtListToDot
-
-printEdgeID :: (PrintDot n) => DotEdge n -> DotCode
-printEdgeID e = do isDir <- getDirectedness
- toDot (fromNode e)
- <+> bool undirEdge' dirEdge' isDir
- <+> toDot (toNode e)
-
-
-instance (ParseDot n) => ParseDot (DotEdge n) where
- parseUnqt = parseAttrBased EdgeAttribute False parseEdgeID
-
- parse = parseUnqt -- Don't want the option of quoting
-
- -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.
- parseUnqtList = concat <$> parseStatements parseEdgeLine
-
- parseList = parseUnqtList
-
-parseEdgeID :: (ParseDot n) => Parse (Attributes -> DotEdge n)
-parseEdgeID = ignoreSep mkEdge parseEdgeNode parseEdgeType parseEdgeNode
- `adjustErr`
- ("Parsed beginning of DotEdge but could not parse Attributes:\n\t"++)
- -- Parse both edge types just to be more liberal
-
-type EdgeNode n = (n, Maybe PortPos)
-
--- | Takes into account edge statements containing something like
--- @a -> \{b c\}@.
-parseEdgeNodes :: (ParseDot n) => Parse [EdgeNode n]
-parseEdgeNodes = parseBraced ( wrapWhitespace
- -- Should really use sepBy1, but this will do.
- $ parseStatements parseEdgeNode
- )
- `onFail`
- fmap (:[]) parseEdgeNode
-
-parseEdgeNode :: (ParseDot n) => Parse (EdgeNode n)
-parseEdgeNode = liftA2 (,) parse
- (optional $ character ':' *> parseEdgeBasedPP)
-
-mkEdge :: EdgeNode n -> EdgeNode n -> Attributes -> DotEdge n
-mkEdge (eFrom, mFP) (eTo, mTP) = DotEdge eFrom eTo
- . addPortPos TailPort mFP
- . addPortPos HeadPort mTP
-
-mkEdges :: [EdgeNode n] -> [EdgeNode n]
- -> Attributes -> [DotEdge n]
-mkEdges fs ts as = liftA2 (\f t -> mkEdge f t as) fs ts
-
-addPortPos :: (PortPos -> Attribute) -> Maybe PortPos
- -> Attributes -> Attributes
-addPortPos c = maybe id ((:) . c)
-
-parseEdgeType :: Parse Bool
-parseEdgeType = wrapWhitespace $ stringRep True dirEdge
- `onFail`
- stringRep False undirEdge
-
-parseEdgeLine :: (ParseDot n) => Parse [DotEdge n]
-parseEdgeLine = do n1 <- parseEdgeNodes
- ens <- many1 $ parseEdgeType *> parseEdgeNodes
- let ens' = n1 : ens
- efs = zipWith mkEdges ens' (tail ens')
- ef = return $ \ as -> concatMap ($as) efs
- parseAttrBased EdgeAttribute False ef
-
-instance Functor DotEdge where
- fmap f e = e { fromNode = f $ fromNode e
- , toNode = f $ toNode e
- }
-
-dirEdge :: String
-dirEdge = "->"
-
-dirEdge' :: DotCode
-dirEdge' = text $ T.pack dirEdge
-
-undirEdge :: String
-undirEdge = "--"
-
-undirEdge' :: DotCode
-undirEdge' = text $ T.pack undirEdge
-
--- -----------------------------------------------------------------------------
--- Labels
-
-dirGraph :: String
-dirGraph = "digraph"
-
-dirGraph' :: DotCode
-dirGraph' = text $ T.pack dirGraph
-
-undirGraph :: String
-undirGraph = "graph"
-
-undirGraph' :: DotCode
-undirGraph' = text $ T.pack undirGraph
-
-strGraph :: String
-strGraph = "strict"
-
-strGraph' :: DotCode
-strGraph' = text $ T.pack strGraph
-
-sGraph :: String
-sGraph = "subgraph"
-
-sGraph' :: DotCode
-sGraph' = text $ T.pack sGraph
-
-clust :: String
-clust = "cluster"
-
-clust' :: DotCode
-clust' = text $ T.pack clust
-
--- -----------------------------------------------------------------------------
-
-printGraphID :: (a -> Bool) -> (a -> Bool)
- -> (a -> Maybe GraphID)
- -> a -> DotCode
-printGraphID str isDir mID g = do setDirectedness isDir'
- bool empty strGraph' (str g)
- <+> bool undirGraph' dirGraph' isDir'
- <+> maybe empty toDot (mID g)
- where
- isDir' = isDir g
-
-parseGraphID :: (Bool -> Bool -> Maybe GraphID -> a) -> Parse a
-parseGraphID f = do whitespace
- str <- isJust <$> optional (parseAndSpace $ string strGraph)
- dir <- parseAndSpace ( stringRep True dirGraph
- `onFail`
- stringRep False undirGraph
- )
- setDirectedness dir
- gID <- optional $ parseAndSpace parse
- return $ f str dir gID
-
-printStmtBased :: (a -> DotCode) -> (a -> AttributeType)
- -> (a -> stmts) -> (stmts -> DotCode)
- -> a -> DotCode
-printStmtBased f ftp r dr a = do gs <- getsGS id
- setAttributeType $ ftp a
- dc <- printBracesBased (f a) (dr $ r a)
- modifyGS (const gs)
- return dc
-
-printStmtBasedList :: (a -> DotCode) -> (a -> AttributeType)
- -> (a -> stmts) -> (stmts -> DotCode)
- -> [a] -> DotCode
-printStmtBasedList f ftp r dr = vcat . mapM (printStmtBased f ftp r dr)
-
--- Can't use the 'braces' combinator here because we want the closing
--- brace lined up with the h value, which due to indentation might not
--- be the case with braces.
-printBracesBased :: DotCode -> DotCode -> DotCode
-printBracesBased h i = vcat $ sequence [ h <+> lbrace
- , ind i
- , rbrace
- ]
- where
- ind = indent 4
-
--- | This /must/ only be used for sub-graphs, etc.
-parseBracesBased :: AttributeType -> Parse a -> Parse a
-parseBracesBased tp p = do gs <- getsGS id
- setAttributeType tp
- a <- whitespace *> parseBraced (wrapWhitespace p)
- modifyGS (const gs)
- return a
- `adjustErr`
- ("Not a valid value wrapped in braces.\n\t"++)
-
-printSubGraphID :: (a -> (Bool, Maybe GraphID)) -> a -> DotCode
-printSubGraphID f a = sGraph'
- <+> maybe cl dtID mID
- where
- (isCl, mID) = f a
- cl = bool empty clust' isCl
- dtID = printSGID isCl
-
--- | Print the actual ID for a 'DotSubGraph'.
-printSGID :: Bool -> GraphID -> DotCode
-printSGID isCl sID = bool noClust addClust isCl
- where
- noClust = toDot sID
- -- Have to manually render it as we need the un-quoted form.
- addClust = toDot . T.append (T.pack clust) . T.cons '_'
- . renderDot $ mkDot sID
- mkDot (Str str) = text str -- Quotes will be escaped later
- mkDot gid = unqtDot gid
-
-parseSubGraph :: (Bool -> Maybe GraphID -> stmt -> c) -> Parse stmt -> Parse c
-parseSubGraph pid pst = do (isC, fID) <- parseSubGraphID pid
- let tp = bool SubGraphAttribute ClusterAttribute isC
- fID <$> parseBracesBased tp pst
-
-parseSubGraphID :: (Bool -> Maybe GraphID -> c) -> Parse (Bool,c)
-parseSubGraphID f = appl <$> (string sGraph *> whitespace1 *> parseSGID)
- where
- appl (isC, mid) = (isC, f isC mid)
-
-parseSGID :: Parse (Bool, Maybe GraphID)
-parseSGID = oneOf [ getClustFrom <$> parseAndSpace parse
- , return (False, Nothing)
- ]
- where
- -- If it's a String value, check to see if it's actually a
- -- cluster_Blah value; thus need to manually re-parse it.
- getClustFrom (Str str) = runParser' pStr str
- getClustFrom gid = (False, Just gid)
-
- checkCl = stringRep True clust
- pStr = do isCl <- checkCl
- `onFail`
- return False
- when isCl $ optional (character '_') *> return ()
- sID <- optional pID
- let sID' = if sID == emptyID
- then Nothing
- else sID
- return (isCl, sID')
-
- emptyID = Just $ Str ""
-
- -- For Strings, there are no more quotes to unescape, so consume
- -- what you can.
- pID = stringNum <$> manySatisfy (const True)
-
-{- This is a much nicer definition, but unfortunately it doesn't work.
- The problem is that Graphviz decides that a subgraph is a cluster
- if the ID starts with "cluster" (no quotes); thus, we _have_ to do
- the double layer of parsing to get it to work :@
-
- do isCl <- stringRep True clust
- `onFail`
- return False
- sID <- optional $ do when isCl
- $ optional (character '_') *> return ()
- parseUnqt
- when (isCl || isJust sID) $ whitespace1 *> return ()
- return (isCl, sID)
--}
-
--- The Bool is True for global, False for local.
-printAttrBased :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)
- -> (a -> Attributes) -> a -> DotCode
-printAttrBased prEmp ff ftp fas a = do oldType <- getAttributeType
- maybe (return ()) setAttributeType mtp
- oldCS <- getColorScheme
- (dc <> semi) <* unless prEmp (setColorScheme oldCS)
- <* setAttributeType oldType
- where
- mtp = ftp a
- f = ff a
- dc = case fas a of
- [] | not prEmp -> f
- as -> f <+> toDot as
-
--- The Bool is True for global, False for local.
-printAttrBasedList :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)
- -> (a -> Attributes) -> [a] -> DotCode
-printAttrBasedList prEmp ff ftp fas = vcat . mapM (printAttrBased prEmp ff ftp fas)
-
--- The Bool is True for global, False for local.
-parseAttrBased :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse a
-parseAttrBased tp lc p = do oldType <- getAttributeType
- setAttributeType tp
- oldCS <- getColorScheme
- f <- p
- atts <- tryParseList' (whitespace *> parse)
- unless lc $ setColorScheme oldCS
- when (tp /= oldType) $ setAttributeType oldType
- return $ f atts
- `adjustErr`
- ("Not a valid attribute-based structure\n\t"++)
-
--- The Bool is True for global, False for local.
-parseAttrBasedList :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse [a]
-parseAttrBasedList tp lc = parseStatements . parseAttrBased tp lc
-
--- | Parse the separator (and any other whitespace1 present) between statements.
-statementEnd :: Parse ()
-statementEnd = parseSplit *> newline'
- where
- parseSplit = (whitespace *> oneOf [ character ';' *> return ()
- , newline
- ]
- )
- `onFail`
- whitespace1
-
-parseStatements :: Parse a -> Parse [a]
-parseStatements p = sepBy (whitespace *> p) statementEnd
- `discard`
- optional statementEnd
diff --git a/Data/GraphViz/Types/Generalised.hs b/Data/GraphViz/Types/Generalised.hs
--- a/Data/GraphViz/Types/Generalised.hs
+++ b/Data/GraphViz/Types/Generalised.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{- |
Module : Data.GraphViz.Types.Generalised.
@@ -49,6 +49,7 @@
-}
module Data.GraphViz.Types.Generalised
( DotGraph(..)
+ , FromGeneralisedDot (..)
-- * Sub-components of a @DotGraph@.
, DotStatements
, DotStatement(..)
@@ -60,21 +61,23 @@
, DotEdge(..)
) where
-import Data.GraphViz.Types
-import qualified Data.GraphViz.Types.Canonical as C
-import Data.GraphViz.Types.Common
-import Data.GraphViz.Types.State
-import Data.GraphViz.Parsing
-import Data.GraphViz.Printing
-import Data.GraphViz.State(AttributeType(..))
-import Data.GraphViz.Util(bool)
+import Data.GraphViz.Algorithms (canonicalise)
+import Data.GraphViz.Internal.State (AttributeType (..))
+import Data.GraphViz.Internal.Util (bool)
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
+import Data.GraphViz.Types
+import qualified Data.GraphViz.Types.Canonical as C
+import Data.GraphViz.Types.Internal.Common
+import Data.GraphViz.Types.State
-import qualified Data.Sequence as Seq
-import Data.Sequence(Seq, (><))
-import qualified Data.Foldable as F
-import qualified Data.Traversable as T
-import Control.Arrow((&&&))
-import Control.Monad.Trans.State(get, put, modify, execState, evalState)
+import Control.Arrow ((&&&))
+import Control.Monad.Trans.State (evalState, execState, get, modify,
+ put)
+import qualified Data.Foldable as F
+import Data.Sequence (Seq, (><))
+import qualified Data.Sequence as Seq
+import qualified Data.Traversable as T
-- -----------------------------------------------------------------------------
@@ -150,6 +153,22 @@
-- -----------------------------------------------------------------------------
+-- | This class is useful for being able to parse in a dot graph as a
+-- generalised one, and then convert it to your preferred
+-- representation.
+--
+-- This can be seen as a semi-inverse of 'fromCanonical'.
+class (DotRepr dg n) => FromGeneralisedDot dg n where
+ fromGeneralised :: DotGraph n -> dg n
+
+instance (Ord n) => FromGeneralisedDot C.DotGraph n where
+ fromGeneralised = canonicalise
+
+instance (Ord n) => FromGeneralisedDot DotGraph n where
+ fromGeneralised = id
+
+-- -----------------------------------------------------------------------------
+
type DotStatements n = Seq (DotStatement n)
printGStmts :: (PrintDot n) => DotStatements n -> DotCode
@@ -307,7 +326,7 @@
sgRe sg = do sgid' <- case subGraphID sg of
Nothing -> do n <- get
put $ succ n
- return . Just $ Int n
+ return . Just . Num $ Int n
sgid -> return sgid
stmts' <- stsRe $ subGraphStmts sg
return $ sg { subGraphID = sgid'
diff --git a/Data/GraphViz/Types/Graph.hs b/Data/GraphViz/Types/Graph.hs
--- a/Data/GraphViz/Types/Graph.hs
+++ b/Data/GraphViz/Types/Graph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{- |
Module : Data.GraphViz.Types.Graph
@@ -96,28 +96,31 @@
, removeEmptyClusters
) where
-import Data.GraphViz.Types
-import qualified Data.GraphViz.Types.Canonical as C
-import qualified Data.GraphViz.Types.Generalised as G
-import Data.GraphViz.Types.Common(partitionGlobal)
-import qualified Data.GraphViz.Types.State as St
-import Data.GraphViz.Attributes.Same
-import Data.GraphViz.Attributes.Complete(Attributes)
-import Data.GraphViz.Util(groupSortBy, groupSortCollectBy)
-import Data.GraphViz.Algorithms(CanonicaliseOptions(..), canonicaliseOptions)
-import Data.GraphViz.Algorithms.Clustering
+import Data.GraphViz.Algorithms (CanonicaliseOptions (..),
+ canonicaliseOptions)
+import Data.GraphViz.Algorithms.Clustering
+import Data.GraphViz.Attributes.Complete (Attributes)
+import Data.GraphViz.Attributes.Same
+import Data.GraphViz.Internal.Util (groupSortBy,
+ groupSortCollectBy)
+import Data.GraphViz.Types
+import qualified Data.GraphViz.Types.Canonical as C
+import qualified Data.GraphViz.Types.Generalised as G
+import Data.GraphViz.Types.Internal.Common (partitionGlobal)
+import qualified Data.GraphViz.Types.State as St
-import Data.List(foldl', delete, unfoldr)
-import qualified Data.Foldable as F
-import Data.Maybe(mapMaybe, fromMaybe)
-import qualified Data.Map as M
-import Data.Map(Map)
-import qualified Data.Set as S
-import qualified Data.Sequence as Seq
-import Control.Applicative(liftA2, (<$>), (<*>))
-import Control.Arrow((***))
-import Text.Read(Lexeme(Ident), lexP, parens, readPrec)
-import Text.ParserCombinators.ReadPrec(prec)
+import Control.Applicative (liftA2, (<$>), (<*>))
+import Control.Arrow ((***))
+import qualified Data.Foldable as F
+import Data.List (delete, foldl', unfoldr)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe, mapMaybe)
+import qualified Data.Sequence as Seq
+import qualified Data.Set as S
+import Text.ParserCombinators.ReadPrec (prec)
+import Text.Read (Lexeme (Ident), lexP, parens,
+ readPrec)
-- -----------------------------------------------------------------------------
@@ -564,6 +567,9 @@
edgeInformation = getEdgeInfo
unAnonymise = id -- No anonymous clusters!
+
+instance (Ord n) => G.FromGeneralisedDot DotGraph n where
+ fromGeneralised = fromDotRepr
instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n
instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n
diff --git a/Data/GraphViz/Types/Internal/Common.hs b/Data/GraphViz/Types/Internal/Common.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Types/Internal/Common.hs
@@ -0,0 +1,547 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+{- |
+ Module : Data.GraphViz.Types.Internal.Common
+ Description : Common internal functions for dealing with overall types.
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ This module provides common functions used by both
+ "Data.GraphViz.Types" as well as "Data.GraphViz.Types.Generalised".
+-}
+module Data.GraphViz.Types.Internal.Common
+ ( GraphID (..)
+ , Number (..)
+ , numericValue
+ , GlobalAttributes (..)
+ , partitionGlobal
+ , unPartitionGlobal
+ , withGlob
+ , DotNode (..)
+ , DotEdge (..)
+ , parseEdgeLine
+ , printGraphID
+ , parseGraphID
+ , printStmtBased
+ , printStmtBasedList
+ , printSubGraphID
+ , parseSubGraph
+ , parseBracesBased
+ , parseStatements
+ ) where
+
+import Data.GraphViz.Attributes.Complete (Attribute (HeadPort, TailPort),
+ Attributes, Number (..),
+ usedByClusters, usedByGraphs,
+ usedByNodes)
+import Data.GraphViz.Attributes.Internal (PortPos, parseEdgeBasedPP)
+import Data.GraphViz.Internal.State
+import Data.GraphViz.Internal.Util
+import Data.GraphViz.Parsing
+import Data.GraphViz.Printing
+
+import Control.Monad (unless, when)
+import Data.Maybe (isJust)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Read as T
+
+-- -----------------------------------------------------------------------------
+-- This is re-exported by Data.GraphViz.Types
+
+-- | A polymorphic type that covers all possible ID values allowed by
+-- Dot syntax. Note that whilst the 'ParseDot' and 'PrintDot'
+-- instances for 'String' will properly take care of the special
+-- cases for numbers, they are treated differently here.
+data GraphID = Str Text
+ | Num Number
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot GraphID where
+ unqtDot (Str str) = unqtDot str
+ unqtDot (Num n) = unqtDot n
+
+ toDot (Str str) = toDot str
+ toDot (Num n) = toDot n
+
+instance ParseDot GraphID where
+ parseUnqt = stringNum <$> parseUnqt
+
+ parse = stringNum <$> parse
+ `adjustErr`
+ ("Not a valid GraphID\n\t"++)
+
+stringNum :: Text -> GraphID
+stringNum str = maybe checkDbl (Num . Int) $ stringToInt str
+ where
+ checkDbl = if isNumString str
+ then Num . Dbl $ toDouble str
+ else Str str
+
+numericValue :: GraphID -> Maybe Int
+numericValue (Str str) = either (const Nothing) (Just . round . fst)
+ $ T.signed T.double str
+numericValue (Num n) = case n of
+ Int i -> Just i
+ Dbl d -> Just $ round d
+
+-- -----------------------------------------------------------------------------
+
+-- Re-exported by Data.GraphViz.Types.*
+
+-- | Represents a list of top-level list of 'Attribute's for the
+-- entire graph/sub-graph. Note that 'GraphAttrs' also applies to
+-- 'DotSubGraph's.
+--
+-- Note that Dot allows a single 'Attribute' to be listed on a line;
+-- if this is the case then when parsing, the type of 'Attribute' it
+-- is determined and that type of 'GlobalAttribute' is created.
+data GlobalAttributes = GraphAttrs { attrs :: Attributes }
+ | NodeAttrs { attrs :: Attributes }
+ | EdgeAttrs { attrs :: Attributes }
+ deriving (Eq, Ord, Show, Read)
+
+instance PrintDot GlobalAttributes where
+ unqtDot = printAttrBased True printGlobAttrType globAttrType attrs
+
+ unqtListToDot = printAttrBasedList True printGlobAttrType globAttrType attrs
+
+ listToDot = unqtListToDot
+
+-- GraphAttrs, NodeAttrs and EdgeAttrs respectively
+partitionGlobal :: [GlobalAttributes] -> (Attributes, Attributes, Attributes)
+partitionGlobal = foldr select ([], [], [])
+ where
+ select globA ~(gs,ns,es) = case globA of
+ GraphAttrs as -> (as ++ gs, ns, es)
+ NodeAttrs as -> (gs, as ++ ns, es)
+ EdgeAttrs as -> (gs, ns, as ++ es)
+
+unPartitionGlobal :: (Attributes, Attributes, Attributes) -> [GlobalAttributes]
+unPartitionGlobal (gas,nas,eas) = [ GraphAttrs gas
+ , NodeAttrs nas
+ , EdgeAttrs eas
+ ]
+
+printGlobAttrType :: GlobalAttributes -> DotCode
+printGlobAttrType GraphAttrs{} = text "graph"
+printGlobAttrType NodeAttrs{} = text "node"
+printGlobAttrType EdgeAttrs{} = text "edge"
+
+instance ParseDot GlobalAttributes where
+ -- Not using parseAttrBased here because we want to force usage of
+ -- Attributes.
+ parseUnqt = do gat <- parseGlobAttrType
+
+ -- Determine if we need to set the attribute type.
+ let mtp = globAttrType $ gat [] -- Only need the constructor
+ oldTp <- getAttributeType
+ maybe (return ()) setAttributeType mtp
+
+ as <- whitespace *> parse
+
+ -- Safe to set back even if not changed.
+ setAttributeType oldTp
+ return $ gat as
+ `onFail`
+ fmap determineType parse
+
+ parse = parseUnqt -- Don't want the option of quoting
+ `adjustErr`
+ ("Not a valid listing of global attributes\n\t"++)
+
+ -- Have to do this manually because of the special case
+ parseUnqtList = parseStatements parseUnqt
+
+ parseList = parseUnqtList
+
+-- Cheat: rather than determine whether it's a graph, cluster or
+-- sub-graph just don't set it.
+globAttrType :: GlobalAttributes -> Maybe AttributeType
+globAttrType NodeAttrs{} = Just NodeAttribute
+globAttrType EdgeAttrs{} = Just EdgeAttribute
+globAttrType _ = Nothing
+
+parseGlobAttrType :: Parse (Attributes -> GlobalAttributes)
+parseGlobAttrType = oneOf [ stringRep GraphAttrs "graph"
+ , stringRep NodeAttrs "node"
+ , stringRep EdgeAttrs "edge"
+ ]
+
+determineType :: Attribute -> GlobalAttributes
+determineType attr
+ | usedByGraphs attr = GraphAttrs attr'
+ | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case
+ | usedByNodes attr = NodeAttrs attr'
+ | otherwise = EdgeAttrs attr' -- Must be for edges.
+ where
+ attr' = [attr]
+
+withGlob :: (Attributes -> Attributes) -> GlobalAttributes -> GlobalAttributes
+withGlob f (GraphAttrs as) = GraphAttrs $ f as
+withGlob f (NodeAttrs as) = NodeAttrs $ f as
+withGlob f (EdgeAttrs as) = EdgeAttrs $ f as
+
+-- -----------------------------------------------------------------------------
+
+-- | A node in 'DotGraph'.
+data DotNode n = DotNode { nodeID :: n
+ , nodeAttributes :: Attributes
+ }
+ deriving (Eq, Ord, Show, Read)
+
+instance (PrintDot n) => PrintDot (DotNode n) where
+ unqtDot = printAttrBased False printNodeID
+ (const $ Just NodeAttribute) nodeAttributes
+
+ unqtListToDot = printAttrBasedList False printNodeID
+ (const $ Just NodeAttribute) nodeAttributes
+
+ listToDot = unqtListToDot
+
+printNodeID :: (PrintDot n) => DotNode n -> DotCode
+printNodeID = toDot . nodeID
+
+instance (ParseDot n) => ParseDot (DotNode n) where
+ parseUnqt = parseAttrBased NodeAttribute False parseNodeID
+
+ parse = parseUnqt -- Don't want the option of quoting
+
+ parseUnqtList = parseAttrBasedList NodeAttribute False parseNodeID
+
+ parseList = parseUnqtList
+
+parseNodeID :: (ParseDot n) => Parse (Attributes -> DotNode n)
+parseNodeID = DotNode <$> parseAndCheck
+ where
+ parseAndCheck = do n <- parse
+ me <- optional parseUnwanted
+ maybe (return n) (const notANode) me
+ notANode = fail "This appears to be an edge, not a node"
+ parseUnwanted = oneOf [ parseEdgeType *> return ()
+ , character ':' *> return () -- PortPos value
+ ]
+
+instance Functor DotNode where
+ fmap f n = n { nodeID = f $ nodeID n }
+
+-- -----------------------------------------------------------------------------
+
+-- This is re-exported in Data.GraphViz.Types; defined here so that
+-- Generalised can access and use parseEdgeLine (needed for "a -> b ->
+-- c"-style edge statements).
+
+-- | An edge in 'DotGraph'.
+data DotEdge n = DotEdge { fromNode :: n
+ , toNode :: n
+ , edgeAttributes :: Attributes
+ }
+ deriving (Eq, Ord, Show, Read)
+
+instance (PrintDot n) => PrintDot (DotEdge n) where
+ unqtDot = printAttrBased False printEdgeID
+ (const $ Just EdgeAttribute) edgeAttributes
+
+ unqtListToDot = printAttrBasedList False printEdgeID
+ (const $ Just EdgeAttribute) edgeAttributes
+
+ listToDot = unqtListToDot
+
+printEdgeID :: (PrintDot n) => DotEdge n -> DotCode
+printEdgeID e = do isDir <- getDirectedness
+ toDot (fromNode e)
+ <+> bool undirEdge' dirEdge' isDir
+ <+> toDot (toNode e)
+
+
+instance (ParseDot n) => ParseDot (DotEdge n) where
+ parseUnqt = parseAttrBased EdgeAttribute False parseEdgeID
+
+ parse = parseUnqt -- Don't want the option of quoting
+
+ -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.
+ parseUnqtList = concat <$> parseStatements parseEdgeLine
+
+ parseList = parseUnqtList
+
+parseEdgeID :: (ParseDot n) => Parse (Attributes -> DotEdge n)
+parseEdgeID = ignoreSep mkEdge parseEdgeNode parseEdgeType parseEdgeNode
+ `adjustErr`
+ ("Parsed beginning of DotEdge but could not parse Attributes:\n\t"++)
+ -- Parse both edge types just to be more liberal
+
+type EdgeNode n = (n, Maybe PortPos)
+
+-- | Takes into account edge statements containing something like
+-- @a -> \{b c\}@.
+parseEdgeNodes :: (ParseDot n) => Parse [EdgeNode n]
+parseEdgeNodes = parseBraced ( wrapWhitespace
+ -- Should really use sepBy1, but this will do.
+ $ parseStatements parseEdgeNode
+ )
+ `onFail`
+ fmap (:[]) parseEdgeNode
+
+parseEdgeNode :: (ParseDot n) => Parse (EdgeNode n)
+parseEdgeNode = liftA2 (,) parse
+ (optional $ character ':' *> parseEdgeBasedPP)
+
+mkEdge :: EdgeNode n -> EdgeNode n -> Attributes -> DotEdge n
+mkEdge (eFrom, mFP) (eTo, mTP) = DotEdge eFrom eTo
+ . addPortPos TailPort mFP
+ . addPortPos HeadPort mTP
+
+mkEdges :: [EdgeNode n] -> [EdgeNode n]
+ -> Attributes -> [DotEdge n]
+mkEdges fs ts as = liftA2 (\f t -> mkEdge f t as) fs ts
+
+addPortPos :: (PortPos -> Attribute) -> Maybe PortPos
+ -> Attributes -> Attributes
+addPortPos c = maybe id ((:) . c)
+
+parseEdgeType :: Parse Bool
+parseEdgeType = wrapWhitespace $ stringRep True dirEdge
+ `onFail`
+ stringRep False undirEdge
+
+parseEdgeLine :: (ParseDot n) => Parse [DotEdge n]
+parseEdgeLine = do n1 <- parseEdgeNodes
+ ens <- many1 $ parseEdgeType *> parseEdgeNodes
+ let ens' = n1 : ens
+ efs = zipWith mkEdges ens' (tail ens')
+ ef = return $ \ as -> concatMap ($as) efs
+ parseAttrBased EdgeAttribute False ef
+
+instance Functor DotEdge where
+ fmap f e = e { fromNode = f $ fromNode e
+ , toNode = f $ toNode e
+ }
+
+dirEdge :: String
+dirEdge = "->"
+
+dirEdge' :: DotCode
+dirEdge' = text $ T.pack dirEdge
+
+undirEdge :: String
+undirEdge = "--"
+
+undirEdge' :: DotCode
+undirEdge' = text $ T.pack undirEdge
+
+-- -----------------------------------------------------------------------------
+-- Labels
+
+dirGraph :: String
+dirGraph = "digraph"
+
+dirGraph' :: DotCode
+dirGraph' = text $ T.pack dirGraph
+
+undirGraph :: String
+undirGraph = "graph"
+
+undirGraph' :: DotCode
+undirGraph' = text $ T.pack undirGraph
+
+strGraph :: String
+strGraph = "strict"
+
+strGraph' :: DotCode
+strGraph' = text $ T.pack strGraph
+
+sGraph :: String
+sGraph = "subgraph"
+
+sGraph' :: DotCode
+sGraph' = text $ T.pack sGraph
+
+clust :: String
+clust = "cluster"
+
+clust' :: DotCode
+clust' = text $ T.pack clust
+
+-- -----------------------------------------------------------------------------
+
+printGraphID :: (a -> Bool) -> (a -> Bool)
+ -> (a -> Maybe GraphID)
+ -> a -> DotCode
+printGraphID str isDir mID g = do setDirectedness isDir'
+ bool empty strGraph' (str g)
+ <+> bool undirGraph' dirGraph' isDir'
+ <+> maybe empty toDot (mID g)
+ where
+ isDir' = isDir g
+
+parseGraphID :: (Bool -> Bool -> Maybe GraphID -> a) -> Parse a
+parseGraphID f = do whitespace
+ str <- isJust <$> optional (parseAndSpace $ string strGraph)
+ dir <- parseAndSpace ( stringRep True dirGraph
+ `onFail`
+ stringRep False undirGraph
+ )
+ setDirectedness dir
+ gID <- optional $ parseAndSpace parse
+ return $ f str dir gID
+
+printStmtBased :: (a -> DotCode) -> (a -> AttributeType)
+ -> (a -> stmts) -> (stmts -> DotCode)
+ -> a -> DotCode
+printStmtBased f ftp r dr a = do gs <- getsGS id
+ setAttributeType $ ftp a
+ dc <- printBracesBased (f a) (dr $ r a)
+ modifyGS (const gs)
+ return dc
+
+printStmtBasedList :: (a -> DotCode) -> (a -> AttributeType)
+ -> (a -> stmts) -> (stmts -> DotCode)
+ -> [a] -> DotCode
+printStmtBasedList f ftp r dr = vcat . mapM (printStmtBased f ftp r dr)
+
+-- Can't use the 'braces' combinator here because we want the closing
+-- brace lined up with the h value, which due to indentation might not
+-- be the case with braces.
+printBracesBased :: DotCode -> DotCode -> DotCode
+printBracesBased h i = vcat $ sequence [ h <+> lbrace
+ , ind i
+ , rbrace
+ ]
+ where
+ ind = indent 4
+
+-- | This /must/ only be used for sub-graphs, etc.
+parseBracesBased :: AttributeType -> Parse a -> Parse a
+parseBracesBased tp p = do gs <- getsGS id
+ setAttributeType tp
+ a <- whitespace *> parseBraced (wrapWhitespace p)
+ modifyGS (const gs)
+ return a
+ `adjustErr`
+ ("Not a valid value wrapped in braces.\n\t"++)
+
+printSubGraphID :: (a -> (Bool, Maybe GraphID)) -> a -> DotCode
+printSubGraphID f a = sGraph'
+ <+> maybe cl dtID mID
+ where
+ (isCl, mID) = f a
+ cl = bool empty clust' isCl
+ dtID = printSGID isCl
+
+-- | Print the actual ID for a 'DotSubGraph'.
+printSGID :: Bool -> GraphID -> DotCode
+printSGID isCl sID = bool noClust addClust isCl
+ where
+ noClust = toDot sID
+ -- Have to manually render it as we need the un-quoted form.
+ addClust = toDot . T.append (T.pack clust) . T.cons '_'
+ . renderDot $ mkDot sID
+ mkDot (Str str) = text str -- Quotes will be escaped later
+ mkDot gid = unqtDot gid
+
+parseSubGraph :: (Bool -> Maybe GraphID -> stmt -> c) -> Parse stmt -> Parse c
+parseSubGraph pid pst = do (isC, fID) <- parseSubGraphID pid
+ let tp = bool SubGraphAttribute ClusterAttribute isC
+ fID <$> parseBracesBased tp pst
+
+parseSubGraphID :: (Bool -> Maybe GraphID -> c) -> Parse (Bool,c)
+parseSubGraphID f = appl <$> (string sGraph *> whitespace1 *> parseSGID)
+ where
+ appl (isC, mid) = (isC, f isC mid)
+
+parseSGID :: Parse (Bool, Maybe GraphID)
+parseSGID = oneOf [ getClustFrom <$> parseAndSpace parse
+ , return (False, Nothing)
+ ]
+ where
+ -- If it's a String value, check to see if it's actually a
+ -- cluster_Blah value; thus need to manually re-parse it.
+ getClustFrom (Str str) = runParser' pStr str
+ getClustFrom gid = (False, Just gid)
+
+ checkCl = stringRep True clust
+ pStr = do isCl <- checkCl
+ `onFail`
+ return False
+ when isCl $ optional (character '_') *> return ()
+ sID <- optional pID
+ let sID' = if sID == emptyID
+ then Nothing
+ else sID
+ return (isCl, sID')
+
+ emptyID = Just $ Str ""
+
+ -- For Strings, there are no more quotes to unescape, so consume
+ -- what you can.
+ pID = stringNum <$> manySatisfy (const True)
+
+{- This is a much nicer definition, but unfortunately it doesn't work.
+ The problem is that Graphviz decides that a subgraph is a cluster
+ if the ID starts with "cluster" (no quotes); thus, we _have_ to do
+ the double layer of parsing to get it to work :@
+
+ do isCl <- stringRep True clust
+ `onFail`
+ return False
+ sID <- optional $ do when isCl
+ $ optional (character '_') *> return ()
+ parseUnqt
+ when (isCl || isJust sID) $ whitespace1 *> return ()
+ return (isCl, sID)
+-}
+
+-- The Bool is True for global, False for local.
+printAttrBased :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)
+ -> (a -> Attributes) -> a -> DotCode
+printAttrBased prEmp ff ftp fas a = do oldType <- getAttributeType
+ maybe (return ()) setAttributeType mtp
+ oldCS <- getColorScheme
+ (dc <> semi) <* unless prEmp (setColorScheme oldCS)
+ <* setAttributeType oldType
+ where
+ mtp = ftp a
+ f = ff a
+ dc = case fas a of
+ [] | not prEmp -> f
+ as -> f <+> toDot as
+
+-- The Bool is True for global, False for local.
+printAttrBasedList :: Bool -> (a -> DotCode) -> (a -> Maybe AttributeType)
+ -> (a -> Attributes) -> [a] -> DotCode
+printAttrBasedList prEmp ff ftp fas = vcat . mapM (printAttrBased prEmp ff ftp fas)
+
+-- The Bool is True for global, False for local.
+parseAttrBased :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse a
+parseAttrBased tp lc p = do oldType <- getAttributeType
+ setAttributeType tp
+ oldCS <- getColorScheme
+ f <- p
+ atts <- tryParseList' (whitespace *> parse)
+ unless lc $ setColorScheme oldCS
+ when (tp /= oldType) $ setAttributeType oldType
+ return $ f atts
+ `adjustErr`
+ ("Not a valid attribute-based structure\n\t"++)
+
+-- The Bool is True for global, False for local.
+parseAttrBasedList :: AttributeType -> Bool -> Parse (Attributes -> a) -> Parse [a]
+parseAttrBasedList tp lc = parseStatements . parseAttrBased tp lc
+
+-- | Parse the separator (and any other whitespace1 present) between statements.
+statementEnd :: Parse ()
+statementEnd = parseSplit *> newline'
+ where
+ parseSplit = (whitespace *> oneOf [ character ';' *> return ()
+ , newline
+ ]
+ )
+ `onFail`
+ whitespace1
+
+parseStatements :: Parse a -> Parse [a]
+parseStatements p = sepBy (whitespace *> p) statementEnd
+ `discard`
+ optional statementEnd
diff --git a/Data/GraphViz/Types/Monadic.hs b/Data/GraphViz/Types/Monadic.hs
--- a/Data/GraphViz/Types/Monadic.hs
+++ b/Data/GraphViz/Types/Monadic.hs
@@ -75,13 +75,13 @@
, (<->)
) where
-import Data.GraphViz.Attributes(Attributes)
-import Data.GraphViz.Types.Common
+import Data.GraphViz.Attributes (Attributes)
import Data.GraphViz.Types.Generalised
-import qualified Data.DList as DL
-import Data.DList(DList)
-import qualified Data.Sequence as Seq
+import Control.Applicative (Applicative (..))
+import Data.DList (DList)
+import qualified Data.DList as DL
+import qualified Data.Sequence as Seq
-- -----------------------------------------------------------------------------
-- The Dot monad.
@@ -97,8 +97,16 @@
execDot :: DotM n a -> DotStmts n
execDot = snd . runDot
+instance Functor (DotM n) where
+ fmap f (DotM (a,stmts)) = DotM (f a, stmts)
+
+instance Applicative (DotM n) where
+ pure = DotM . flip (,) DL.empty
+
+ (DotM (f,stmts1)) <*> (DotM (a,stmts2)) = DotM (f a, stmts1 `DL.append` stmts2)
+
instance Monad (DotM n) where
- return a = DotM (a, DL.empty)
+ return = pure
dt >>= f = DotM
$ let ~(a,stmts) = runDot dt
diff --git a/Data/GraphViz/Types/State.hs b/Data/GraphViz/Types/State.hs
--- a/Data/GraphViz/Types/State.hs
+++ b/Data/GraphViz/Types/State.hs
@@ -34,22 +34,22 @@
, addEdge
) where
-import Data.GraphViz.Types.Common
-import Data.GraphViz.Attributes.Complete( Attributes
- , usedByClusters, usedByGraphs)
+import Data.GraphViz.Attributes.Complete (Attributes, usedByClusters,
+ usedByGraphs)
import Data.GraphViz.Attributes.Same
+import Data.GraphViz.Types.Internal.Common
-import Data.Function(on)
-import qualified Data.DList as DList
-import Data.DList(DList)
-import qualified Data.Map as Map
-import Data.Map(Map)
-import qualified Data.Set as Set
-import qualified Data.Sequence as Seq
-import Data.Sequence(Seq, (|>), ViewL(..))
-import Control.Arrow((&&&), (***))
-import Control.Monad(when)
-import Control.Monad.Trans.State
+import Control.Arrow ((&&&), (***))
+import Control.Monad (when)
+import Control.Monad.Trans.State
+import Data.DList (DList)
+import qualified Data.DList as DList
+import Data.Function (on)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Sequence (Seq, ViewL (..), (|>))
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
-- -----------------------------------------------------------------------------
@@ -160,8 +160,8 @@
type NodeLookup' n = Map n NodeInfo
-data NodeInfo = NI { atts :: SAttrs
- , gAtts :: SAttrs -- from globals
+data NodeInfo = NI { atts :: SAttrs
+ , gAtts :: SAttrs -- from globals
, location :: Path
}
deriving (Eq, Ord, Show, Read)
diff --git a/Data/GraphViz/Util.hs b/Data/GraphViz/Util.hs
deleted file mode 100644
--- a/Data/GraphViz/Util.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-{-# LANGUAGE OverloadedStrings, PatternGuards #-}
-{-# OPTIONS_HADDOCK hide #-}
-
-{- |
- Module : Data.GraphViz.Util
- Description : Internal utility functions
- Copyright : (c) Ivan Lazar Miljenovic
- License : 3-Clause BSD-style
- Maintainer : Ivan.Miljenovic@gmail.com
-
- This module defines internal utility functions.
--}
-module Data.GraphViz.Util where
-
-import Data.Char( isAsciiUpper
- , isAsciiLower
- , isDigit
- , ord
- )
-
-import Data.List(groupBy, sortBy)
-import Data.Maybe(isJust)
-import Data.Function(on)
-import qualified Data.Set as Set
-import Data.Set(Set)
-import qualified Data.Text.Lazy as T
-import qualified Data.Text.Lazy.Read as T
-import Data.Text.Lazy(Text)
-import Control.Monad(liftM2)
-
--- -----------------------------------------------------------------------------
-
-isIDString :: Text -> Bool
-isIDString = maybe False (\(f,os) -> frstIDString f && T.all restIDString os)
- . T.uncons
-
--- | First character of a non-quoted 'String' must match this.
-frstIDString :: Char -> Bool
-frstIDString c = any ($c) [ isAsciiUpper
- , isAsciiLower
- , (==) '_'
- , (\ x -> ord x >= 128)
- ]
-
--- | The rest of a non-quoted 'String' must match this.
-restIDString :: Char -> Bool
-restIDString c = frstIDString c || isDigit c
-
--- | Determine if this String represents a number.
-isNumString :: Text -> Bool
-isNumString "" = False
-isNumString "-" = False
-isNumString str = case T.uncons $ T.toLower str of
- Just ('-',str') -> go str'
- _ -> go str
- where
- -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all
- -- possible cases
- go s = uncurry go' $ T.span isDigit s
- go' ds nds
- | T.null nds = True
- | T.null ds && nds == "." = False
- | T.null ds
- , Just ('.',nds') <- T.uncons nds
- , Just (d,nds'') <- T.uncons nds' = isDigit d && checkEs' nds''
- | Just ('.',nds') <- T.uncons nds = checkEs $ T.dropWhile isDigit nds'
- | T.null ds = False
- | otherwise = checkEs nds
- checkEs' s = case T.break ('e' ==) s of
- ("", _) -> False
- (ds,es) -> T.all isDigit ds && checkEs es
- checkEs str' = case T.uncons str' of
- Nothing -> True
- Just ('e',ds) -> isIntString ds
- _ -> False
-
-{-
--- | This assumes that 'isNumString' is 'True'.
-toDouble :: Text -> Double
-toDouble str = case T.uncons $ T.toLower str of
- Just ('-', str') -> toD $ '-' `T.cons` adj str'
- _ -> toD $ adj str
- where
- adj s = T.cons '0'
- $ case T.span ('.' ==) s of
- (ds, ".") | not $ T.null ds -> s `T.snoc` '0'
- (ds, ds') | Just ('.',es) <- T.uncons ds'
- , Just ('e',es') <- T.uncons es
- -> ds `T.snoc` '.' `T.snoc` '0'
- `T.snoc` 'e' `T.snoc` '0' `T.append` es'
- _ -> s
- toD = either (const $ error "Not a Double") fst . T.signed T.double
--}
--- | This assumes that 'isNumString' is 'True'.
-toDouble :: Text -> Double
-toDouble str = case T.uncons $ T.toLower str of
- Just ('-', str') -> toD $ '-' `T.cons` adj str'
- _ -> toD $ adj str
- where
- adj s = T.cons '0'
- $ case T.span ('.' ==) s of
- (ds, ".") | not $ T.null ds -> s `T.snoc` '0'
- (ds, ds') | Just ('.',es) <- T.uncons ds'
- , Just ('e',_) <- T.uncons es
- -> ds `T.snoc` '.' `T.snoc` '0' `T.append` es
- _ -> s
- toD = read . T.unpack
-
-isIntString :: Text -> Bool
-isIntString = isJust . stringToInt
-
--- | Determine if this String represents an integer.
-stringToInt :: Text -> Maybe Int
-stringToInt str = case T.signed T.decimal str of
- Right (n, "") -> Just n
- _ -> Nothing
-
--- | Graphviz requires double quotes to be explicitly escaped.
-escapeQuotes :: String -> String
-escapeQuotes [] = []
-escapeQuotes ('"':str) = '\\':'"': escapeQuotes str
-escapeQuotes (c:str) = c : escapeQuotes str
-
--- | Remove explicit escaping of double quotes.
-descapeQuotes :: String -> String
-descapeQuotes [] = []
-descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str
-descapeQuotes (c:str) = c : descapeQuotes str
-
-isKeyword :: Text -> Bool
-isKeyword = (`Set.member` keywords) . T.toLower
-
--- | The following are Dot keywords and are not valid as labels, etc. unquoted.
-keywords :: Set Text
-keywords = Set.fromList [ "node"
- , "edge"
- , "graph"
- , "digraph"
- , "subgraph"
- , "strict"
- ]
-
--- -----------------------------------------------------------------------------
-
-uniq :: (Ord a) => [a] -> [a]
-uniq = uniqBy id
-
-uniqBy :: (Ord b) => (a -> b) -> [a] -> [a]
-uniqBy f = map head . groupSortBy f
-
-groupSortBy :: (Ord b) => (a -> b) -> [a] -> [[a]]
-groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)
-
-groupSortCollectBy :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]
-groupSortCollectBy f g = map (liftM2 (,) (f . head) (map g)) . groupSortBy f
-
--- | Fold over 'Bool's; first param is for 'False', second for 'True'.
-bool :: a -> a -> Bool -> a
-bool f t b = if b
- then t
- else f
-
-isSingle :: [a] -> Bool
-isSingle [_] = True
-isSingle _ = False
diff --git a/FAQ.md b/FAQ.md
--- a/FAQ.md
+++ b/FAQ.md
@@ -35,10 +35,12 @@
* There are [four different representations] of Dot graphs:
- 1. Canonical, which matches the layout of `dot -Tcanon`.
+ 1. Canonical, which provides a clean separated definition of a
+ Dot graph (that matches the former layout of `dot -Tcanon`).
2. Generalised, which allows statements to be in any order.
3. A graph-based one that allows manipulation of the Dot graph.
- 4. A monadic interface for embedding graphs in Haskell.
+ 4. A monadic interface for embedding relatively static graphs
+ in Haskell.
There are also conversion functions between them.
@@ -53,7 +55,7 @@
* The ability to use a custom node type for Dot graphs.
-* Support for the all five layout algorithm programs and all specified
+* Support for all stated layout algorithm programs and all specified
[output formats] as well as the ability to use custom programs, etc.
[output formats]: http://www.graphviz.org/doc/info/output.html
@@ -122,12 +124,15 @@
ability to specify an integer prefix for use with the `fdp` layout
tool is not available.
-* `pointf` and `point` values have been combined into one datatype; as
- such, when constructing values such as `Rect` care should be taken
- about which parts of a `Point` are allowed.
+* The deprecated `shapefile` attribute is not available; instead, you
+ should specify the file on the command line.
-* Only polygon-based `shape`s are available.
+* The deprecated `z` attribute is not available; use the optional
+ third dimension for the `pos` attribute instead.
+* Only polygon-based `shape`s are available (i.e. no custom shapes as
+ yet).
+
* The `charset` attribute is not available as _graphviz_ assumes that
all Dot graphs will be in UTF-8 for simplicity; if Latin1-encoded
graphs need to be parsed then you shall need to do all I/O for them
@@ -303,8 +308,8 @@
**Canonical:**
-: matches the output of `dot -Tcanon`. Recommended for use when
- converting existing data into Dot (especially with the
+: matches the (former) output of `dot -Tcanon`. Recommended for use
+ when converting existing data into Dot (especially with the
`graphElemsToDot` function in `Data.GraphViz`).
**Generalised:**
@@ -330,21 +335,20 @@
### What's the best way to parse Dot code? ###
-In both cases below, you should use the `parseDotGraph` function to
-parse the Dot code: this is because it will strip out comments and
-pre-processor lines and join together split lines (if any of these
-remain the parser will fail). Also, if you are not sure what the type
-of the nodes are, use either String or else the `GraphID` type as it
-explicitly caters for both Strings and numbers (whereas just assuming
-it being a String will result in numbers being stored internally as a
-String).
-
-If you can, first run `dot -Tcanon` on the Dot code and parse it as a
-`DotGraph` value. This is because `DotGraph` types are easier to deal
-with.
+Use the `parseDotGraph` function (rather than the general parsing
+functions that are available) to parse your Dot code: this is will
+strip out comments and pre-processor lines and join together split
+lines (if any of these remain the parser will fail). Also, if you are
+not sure what the type of the nodes are, use either String or else the
+`GraphID` type as it explicitly caters for both Strings and numbers
+(whereas just assuming it being a String will result in numbers being
+stored internally as a String).
-If, however, this isn't possible (e.g. it uses an image that isn't in
-the current working directory) then use the `GDotGraph` type.
+Unless you are very sure of the representation of the Dot code you
+have been provided, you should parse in any Dot code as the
+`Generalised.DotGraph` type. Afterwards you can use
+`FromGeneralisedDot` to convert to whichever representation you
+prefer.
### There are too many attributes!!! Which ones should I use? ###
@@ -394,10 +398,10 @@
be printed like `"1: Foo"`:
~~~~~~~~~~~~~~~~~~~~ {.haskell}
-data MyType = MyType String Int
+data MyType = MyType Int String
instance PrintDot MyType where
- unqtDot (MyType s i) = unqtDot i <> colon <+> unqtDot s
+ unqtDot (MyType i s) = unqtDot i <> colon <+> unqtDot s
-- We have a space in there, so we need quotes.
toDot = doubleQuotes . unqtDot
@@ -527,8 +531,8 @@
yet
[people didn't like the idea](http://www.haskell.org/pipermail/haskell-cafe/2009-July/064442.html).
-The graph-based implementation was added solely so I could write as
-(un-yet finished) tutorial, and thought others might find it useful.
+The graph-based implementation was added solely so I could write an
+(as-yet finished) tutorial, and thought others might find it useful.
The monadic implementation came about as an attempt to encourage more
people to use _graphviz_ rather than other libraries such as [dotgen],
and I thought a nicer way of writing Dot graphs might help (the
@@ -592,9 +596,9 @@
`TestParsing.hs` script that comes in the _graphviz_ tarball (but is
not installed). Once you have _graphviz_ installed you can just run
this script, passing it any files containing Dot graphs you wish to
-test. It will attempt to parse each Dot graph as a `GDotGraph`, and
-then test to see if the canonicalised form is parseable as a
-`DotGraph`.
+test. It will attempt to parse each Dot graph as a
+`Generalised.DotGraph`, and then test to see if the canonicalised form
+is parseable as a `DotGraph`.
### I've found a bug! ###
diff --git a/TODO.md b/TODO.md
--- a/TODO.md
+++ b/TODO.md
@@ -1,6 +1,8 @@
% TODO
% Ivan Lazar Miljenovic
+* Data.Data.Data instances
+
Future Plans for graphviz
=========================
diff --git a/graphviz.cabal b/graphviz.cabal
--- a/graphviz.cabal
+++ b/graphviz.cabal
@@ -1,5 +1,5 @@
Name: graphviz
-Version: 2999.16.0.0
+Version: 2999.17.0.0
Stability: Beta
Synopsis: Bindings to Graphviz for graph visualisation.
Description: {
@@ -45,29 +45,32 @@
README.md
FAQ.md
utils/AttributeGenerator.hs
- utils/TestParsing.hs
Source-Repository head
Type: darcs
Location: http://hub.darcs.net/ivanm/graphviz
+Flag test-parsing
+ Description: Build a utility to test parsing of available Dot code.
+ Default: False
+
Library {
- Default-Language: Haskell98
+ Default-Language: Haskell2010
Build-Depends: base == 4.*,
containers,
process,
directory,
- temporary >=1.1 && <1.2,
- fgl == 5.4.*,
+ temporary >=1.1 && <1.3,
+ fgl >= 5.4 && < 5.6,
filepath,
- polyparse >= 1.7 && < 1.9,
+ polyparse == 1.9.*,
bytestring >= 0.9 && < 0.11,
colour == 2.3.*,
transformers >= 0.2 && < 0.4,
text,
wl-pprint-text >= 1.1.0.0 && < 1.2.0.0,
- dlist == 0.5.*
+ dlist >= 0.5 && < 0.8
Exposed-Modules: Data.GraphViz
Data.GraphViz.Types
@@ -90,14 +93,18 @@
Data.GraphViz.Exception
Data.GraphViz.Algorithms
+ Data.GraphViz.Attributes.Internal
+ Data.GraphViz.Internal.Util
+ Data.GraphViz.Internal.State
+ Data.GraphViz.Types.Internal.Common
+
Other-Modules: Data.GraphViz.Algorithms.Clustering
+ Data.GraphViz.Attributes.Arrows
Data.GraphViz.Attributes.ColorScheme
- Data.GraphViz.Attributes.Internal
Data.GraphViz.Attributes.Same
- Data.GraphViz.Types.Common
+ Data.GraphViz.Attributes.Values
+ Data.GraphViz.Commands.Available
Data.GraphViz.Types.State
- Data.GraphViz.Util
- Data.GraphViz.State
if True
Ghc-Options: -Wall
@@ -109,28 +116,20 @@
}
Test-Suite graphviz-testsuite {
- Default-Language: Haskell98
+ Default-Language: Haskell2010
Type: exitcode-stdio-1.0
-- Versions controlled by library section
Build-Depends: base,
+ graphviz,
containers,
- process,
- directory,
- temporary,
fgl,
filepath,
- polyparse,
- bytestring,
- colour,
- transformers,
text,
- wl-pprint-text,
- dlist,
- QuickCheck >= 2.3 && < 2.6
+ QuickCheck >= 2.3 && < 2.8
- hs-Source-Dirs: . tests
+ hs-Source-Dirs: tests
Main-Is: RunTests.hs
@@ -156,7 +155,7 @@
}
Benchmark graphviz-printparse {
- Default-Language: Haskell98
+ Default-Language: Haskell2010
Type: exitcode-stdio-1.0
@@ -164,7 +163,7 @@
deepseq,
text,
graphviz,
- criterion >= 0.5 && < 0.7
+ criterion >= 0.5 && < 0.9
hs-Source-Dirs: utils
@@ -175,6 +174,30 @@
if impl(ghc >= 6.12.1)
Ghc-Options: -fno-warn-unused-do-bind
+
+ GHC-Prof-Options: -auto-all -caf-all -rtsopts
+}
+
+Executable graphviz-testparsing {
+ Default-Language: Haskell2010
+
+ if flag(test-parsing)
+ Buildable: True
+ else
+ Buildable: False
+
+ hs-Source-Dirs: utils
+
+ Main-Is: TestParsing.hs
+
+ Build-Depends: base,
+ graphviz,
+ bytestring,
+ directory,
+ filepath,
+ text
+
+ Ghc-Options: -O -Wall
GHC-Prof-Options: -auto-all -caf-all -rtsopts
}
diff --git a/tests/Data/GraphViz/Testing/Instances/Attributes.hs b/tests/Data/GraphViz/Testing/Instances/Attributes.hs
--- a/tests/Data/GraphViz/Testing/Instances/Attributes.hs
+++ b/tests/Data/GraphViz/Testing/Instances/Attributes.hs
@@ -19,23 +19,25 @@
import Data.GraphViz.Testing.Instances.Helpers
-import Data.GraphViz.Attributes.Complete
-import qualified Data.GraphViz.Attributes.HTML as Html
-import Data.GraphViz.Attributes.Colors.Brewer
-import Data.GraphViz.Attributes.Colors.X11(X11Color)
-import Data.GraphViz.Attributes.Colors.SVG(SVGColor)
-import Data.GraphViz.Attributes.Internal(compassLookup)
-import Data.GraphViz.State(initialState, layerSep, layerListSep)
-import Data.GraphViz.Util(bool)
+import Data.GraphViz.Attributes.Colors.Brewer
+import Data.GraphViz.Attributes.Colors.SVG (SVGColor)
+import Data.GraphViz.Attributes.Colors.X11 (X11Color)
+import Data.GraphViz.Attributes.Complete
+import qualified Data.GraphViz.Attributes.HTML as Html
+import Data.GraphViz.Attributes.Internal (compassLookup)
+import Data.GraphViz.Internal.State (initialState,
+ layerListSep, layerSep)
+import Data.GraphViz.Internal.Util (bool, createVersion)
import Test.QuickCheck
-import Data.List(nub, delete, groupBy)
-import qualified Data.Map as Map
-import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import Control.Monad(liftM, liftM2, liftM3, liftM4)
-import System.FilePath(searchPathSeparator)
+import Control.Monad (liftM, liftM2, liftM3, liftM4)
+import Data.List (delete, groupBy, nub)
+import qualified Data.Map as Map
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import Data.Version (Version (..))
+import System.FilePath (searchPathSeparator)
-- -----------------------------------------------------------------------------
-- Defining Arbitrary instances for Attributes
@@ -66,7 +68,7 @@
, liftM ArrowHead arbitrary
, liftM ArrowSize arbitrary
, liftM ArrowTail arbitrary
- , liftM Aspect arbitrary
+ , liftM Background arbitrary
, liftM BoundingBox arbitrary
, liftM BgColor arbList
, liftM Center arbitrary
@@ -112,6 +114,7 @@
, liftM Image arbitrary
, liftM ImagePath arbitrary
, liftM ImageScale arbitrary
+ , liftM InputScale arbitrary
, liftM Label arbitrary
, liftM LabelURL arbitrary
, liftM LabelScheme arbitrary
@@ -158,6 +161,7 @@
, liftM OutputOrder arbitrary
, liftM Overlap arbitrary
, liftM OverlapScaling arbitrary
+ , liftM OverlapShrink arbitrary
, liftM Pack arbitrary
, liftM PackMode arbitrary
, liftM Pad arbitrary
@@ -213,6 +217,7 @@
, liftM VoroMargin arbitrary
, liftM Weight arbitrary
, liftM Width arbitrary
+ , liftM XDotVersion arbitrary
, liftM XLabel arbitrary
, liftM XLP arbitrary
, liftM2 UnknownAttribute (suchThat arbIDString validUnknown) arbitrary
@@ -225,7 +230,7 @@
shrink (ArrowHead v) = map ArrowHead $ shrink v
shrink (ArrowSize v) = map ArrowSize $ shrink v
shrink (ArrowTail v) = map ArrowTail $ shrink v
- shrink (Aspect v) = map Aspect $ shrink v
+ shrink (Background v) = map Background $ shrink v
shrink (BoundingBox v) = map BoundingBox $ shrink v
shrink (BgColor v) = map BgColor $ nonEmptyShrinks v
shrink (Center v) = map Center $ shrink v
@@ -271,6 +276,7 @@
shrink (Image v) = map Image $ shrink v
shrink (ImagePath v) = map ImagePath $ shrink v
shrink (ImageScale v) = map ImageScale $ shrink v
+ shrink (InputScale v) = map InputScale $ shrink v
shrink (Label v) = map Label $ shrink v
shrink (LabelURL v) = map LabelURL $ shrink v
shrink (LabelScheme v) = map LabelScheme $ shrink v
@@ -317,6 +323,7 @@
shrink (OutputOrder v) = map OutputOrder $ shrink v
shrink (Overlap v) = map Overlap $ shrink v
shrink (OverlapScaling v) = map OverlapScaling $ shrink v
+ shrink (OverlapShrink v) = map OverlapShrink $ shrink v
shrink (Pack v) = map Pack $ shrink v
shrink (PackMode v) = map PackMode $ shrink v
shrink (Pad v) = map Pad $ shrink v
@@ -372,6 +379,7 @@
shrink (VoroMargin v) = map VoroMargin $ shrink v
shrink (Weight v) = map Weight $ shrink v
shrink (Width v) = map Width $ shrink v
+ shrink (XDotVersion v) = map XDotVersion $ shrink v
shrink (XLabel v) = map XLabel $ shrink v
shrink (XLP v) = map XLP $ shrink v
shrink (UnknownAttribute a v) = liftM2 UnknownAttribute (liftM (filter validUnknown) shrink a) (shrink v)
@@ -399,16 +407,6 @@
instance Arbitrary ArrowSide where
arbitrary = arbBounded
-instance Arbitrary AspectType where
- arbitrary = oneof [ liftM RatioOnly arbitrary
- , liftM2 RatioPassCount arbitrary posArbitrary
- ]
-
- shrink (RatioOnly d) = map RatioOnly $ shrink d
- shrink (RatioPassCount d i) = do ds <- shrink d
- is <- shrink i
- return $ RatioPassCount ds is
-
instance Arbitrary LabelScheme where
arbitrary = arbBounded
@@ -474,7 +472,7 @@
shrink (StrLabel str) = map StrLabel $ shrink str
shrink (HtmlLabel html) = map HtmlLabel $ shrink html
- shrink (RecordLabel fs) = map RecordLabel . filter notStr $ shrinkList fs
+ shrink (RecordLabel fs) = map RecordLabel . filter notStr $ listShrink fs
notStr :: RecordFields -> Bool
notStr [FieldLabel{}] = False -- Just in case
@@ -499,7 +497,7 @@
shrink (LabelledTarget f l) = [PortName f, FieldLabel l]
shrink (PortName f) = map PortName $ shrink f
shrink (FieldLabel l) = map FieldLabel $ shrink l
- shrink (FlipFields fs) = map FlipFields $ shrinkList fs
+ shrink (FlipFields fs) = map FlipFields $ listShrink fs
instance Arbitrary Overlap where
arbitrary = oneof [ simpleOverlap
@@ -998,3 +996,44 @@
notCP :: Text -> Bool
notCP = flip Map.notMember compassLookup
+
+instance Arbitrary Number where
+ arbitrary = frequency [ (3, liftM Dbl $ suchThat arbitrary notInt)
+ , (1, liftM Int arbitrary)
+ ]
+
+ shrink (Int i) = map Int $ shrink i
+ shrink (Dbl d) = map Dbl $ filter notInt $ shrink d
+
+instance Arbitrary Normalized where
+ arbitrary = oneof [ elements [IsNormalized, NotNormalized]
+ , liftM NormalizedAngle arbitrary
+ ]
+
+ shrink (NormalizedAngle a) = map NormalizedAngle $ shrink a
+ shrink _ = []
+
+instance Arbitrary Version where
+ arbitrary = liftM (createVersion . map getPositive) arbList
+
+ shrink = map createVersion . nonEmptyShrinks . versionBranch
+
+instance Arbitrary NodeSize where
+ arbitrary = arbBounded
+
+{-
+
+As of Graphviz 2.36.0 this was commented out; as such it might come
+back, so leave this here in case we need it again.
+
+instance Arbitrary AspectType where
+ arbitrary = oneof [ liftM RatioOnly arbitrary
+ , liftM2 RatioPassCount arbitrary posArbitrary
+ ]
+
+ shrink (RatioOnly d) = map RatioOnly $ shrink d
+ shrink (RatioPassCount d i) = do ds <- shrink d
+ is <- shrink i
+ return $ RatioPassCount ds is
+
+-}
diff --git a/tests/Data/GraphViz/Testing/Instances/Canonical.hs b/tests/Data/GraphViz/Testing/Instances/Canonical.hs
--- a/tests/Data/GraphViz/Testing/Instances/Canonical.hs
+++ b/tests/Data/GraphViz/Testing/Instances/Canonical.hs
@@ -13,12 +13,12 @@
import Data.GraphViz.Testing.Instances.Common
import Data.GraphViz.Testing.Instances.Helpers
+import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Types.Canonical
-import Data.GraphViz.Util(bool)
import Test.QuickCheck
-import Control.Monad(liftM2, liftM4)
+import Control.Monad (liftM2, liftM4)
-- -----------------------------------------------------------------------------
-- Defining Arbitrary instances for the overall types
diff --git a/tests/Data/GraphViz/Testing/Instances/Common.hs b/tests/Data/GraphViz/Testing/Instances/Common.hs
--- a/tests/Data/GraphViz/Testing/Instances/Common.hs
+++ b/tests/Data/GraphViz/Testing/Instances/Common.hs
@@ -17,27 +17,25 @@
import Data.GraphViz.Testing.Instances.Attributes
import Data.GraphViz.Testing.Instances.Helpers
-import Data.GraphViz.Attributes(Attributes)
-import Data.GraphViz.Types.Common( DotNode(..), DotEdge(..)
- , GlobalAttributes(..), GraphID(..))
-import Data.GraphViz.Algorithms(CanonicaliseOptions(..))
+import Data.GraphViz.Algorithms (CanonicaliseOptions (..))
+import Data.GraphViz.Attributes (Attributes)
+import Data.GraphViz.Types.Internal.Common (DotEdge (..), DotNode (..),
+ GlobalAttributes (..), GraphID (..))
import Test.QuickCheck
-import Control.Monad(liftM, liftM2, liftM3)
+import Control.Monad (liftM, liftM2, liftM3)
-- -----------------------------------------------------------------------------
-- Common values
instance Arbitrary GraphID where
arbitrary = oneof [ liftM Str arbitrary
- , liftM Int arbitrary
- , liftM Dbl $ suchThat arbitrary notInt
+ , liftM Num arbitrary
]
shrink (Str s) = map Str $ shrink s
- shrink (Int i) = map Int $ shrink i
- shrink (Dbl d) = map Dbl $ filter notInt $ shrink d
+ shrink (Num n) = map Num $ shrink n
instance (Arbitrary n) => Arbitrary (DotNode n) where
arbitrary = liftM2 DotNode arbitrary arbNodeAttrs
diff --git a/tests/Data/GraphViz/Testing/Instances/FGL.hs b/tests/Data/GraphViz/Testing/Instances/FGL.hs
--- a/tests/Data/GraphViz/Testing/Instances/FGL.hs
+++ b/tests/Data/GraphViz/Testing/Instances/FGL.hs
@@ -18,12 +18,12 @@
import Test.QuickCheck
-import Data.GraphViz.Util(uniq)
+import Data.GraphViz.Internal.Util (uniq)
-import Data.Graph.Inductive.Graph(Graph, mkGraph, nodes, delNode)
-import Data.List(sortBy)
-import Data.Function(on)
-import Control.Monad(liftM, liftM3)
+import Control.Monad (liftM, liftM3)
+import Data.Function (on)
+import Data.Graph.Inductive.Graph (Graph, delNode, mkGraph, nodes)
+import Data.List (sortBy)
-- -----------------------------------------------------------------------------
-- Arbitrary instance for FGL graphs.
diff --git a/tests/Data/GraphViz/Testing/Instances/Generalised.hs b/tests/Data/GraphViz/Testing/Instances/Generalised.hs
--- a/tests/Data/GraphViz/Testing/Instances/Generalised.hs
+++ b/tests/Data/GraphViz/Testing/Instances/Generalised.hs
@@ -10,17 +10,17 @@
-}
module Data.GraphViz.Testing.Instances.Generalised where
-import Data.GraphViz.Testing.Instances.Attributes()
+import Data.GraphViz.Testing.Instances.Attributes ()
import Data.GraphViz.Testing.Instances.Common
-import Data.GraphViz.Testing.Instances.Helpers()
+import Data.GraphViz.Testing.Instances.Helpers ()
+import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Types.Generalised
-import Data.GraphViz.Util(bool)
import Test.QuickCheck
+import Control.Monad (liftM, liftM2, liftM4)
import qualified Data.Sequence as Seq
-import Control.Monad(liftM, liftM2, liftM4)
-- -----------------------------------------------------------------------------
-- Defining Arbitrary instances for the generalised types
diff --git a/tests/Data/GraphViz/Testing/Instances/Helpers.hs b/tests/Data/GraphViz/Testing/Instances/Helpers.hs
--- a/tests/Data/GraphViz/Testing/Instances/Helpers.hs
+++ b/tests/Data/GraphViz/Testing/Instances/Helpers.hs
@@ -11,14 +11,14 @@
-}
module Data.GraphViz.Testing.Instances.Helpers where
-import Data.GraphViz.Parsing(isNumString)
-import Data.GraphViz.State(initialState, layerSep, layerListSep)
+import Data.GraphViz.Internal.State (initialState, layerListSep, layerSep)
+import Data.GraphViz.Parsing (isNumString)
import Test.QuickCheck
+import Control.Monad (liftM, liftM2)
+import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
-import Control.Monad(liftM, liftM2)
-- -----------------------------------------------------------------------------
-- Helper Functions
@@ -89,17 +89,17 @@
nonEmptyShrinks = filter (not . null) . shrink
nonEmptyShrinks' :: [a] -> [[a]]
-nonEmptyShrinks' = filter (not . null) . shrinkList'
+nonEmptyShrinks' = filter (not . null) . listShrink'
-- Shrink lists with more than one value only by removing values, not
-- by shrinking individual items.
-shrinkList :: (Arbitrary a) => [a] -> [[a]]
-shrinkList [a] = map return $ shrink a
-shrinkList as = shrinkList' as
+listShrink :: (Arbitrary a) => [a] -> [[a]]
+listShrink [a] = map return $ shrink a
+listShrink as = listShrink' as
-- Just shrink the size.
-shrinkList' :: [a] -> [[a]]
-shrinkList' as = rm (length as) as
+listShrink' :: [a] -> [[a]]
+listShrink' as = rm (length as) as
where
rm 0 _ = []
rm 1 _ = [[]]
@@ -125,7 +125,7 @@
shrinkM j = shrink j
shrinkL :: (Arbitrary a) => [a] -> [[a]]
-shrinkL xs = case shrinkList xs of
+shrinkL xs = case listShrink xs of
[] -> [xs]
xs' -> xs'
diff --git a/tests/Data/GraphViz/Testing/Properties.hs b/tests/Data/GraphViz/Testing/Properties.hs
--- a/tests/Data/GraphViz/Testing/Properties.hs
+++ b/tests/Data/GraphViz/Testing/Properties.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
{- |
Module : Data.GraphViz.Testing.Properties
@@ -11,30 +11,37 @@
-}
module Data.GraphViz.Testing.Properties where
-import Data.GraphViz( dotizeGraph, graphToDot
- , setDirectedness, nonClusteredParams)
-import Data.GraphViz.Types( DotRepr(..), PrintDotRepr
- , DotNode(..), DotEdge(..), GlobalAttributes(..)
- , printDotGraph, graphNodes, graphEdges
- , nodeInformationClean, edgeInformationClean)
-import Data.GraphViz.Types.Canonical(DotGraph(..), DotStatements(..))
+import Data.GraphViz (dotizeGraph, graphToDot,
+ nonClusteredParams,
+ setDirectedness)
+import Data.GraphViz.Algorithms
+import Data.GraphViz.Internal.Util (groupSortBy, isSingle)
+import Data.GraphViz.Parsing (ParseDot (..), parseIt,
+ parseIt')
+import Data.GraphViz.PreProcessing (preProcess)
+import Data.GraphViz.Printing (PrintDot (..), printIt)
+import Data.GraphViz.Types (DotEdge (..), DotNode (..),
+ DotRepr (..),
+ GlobalAttributes (..),
+ PrintDotRepr,
+ edgeInformationClean,
+ graphEdges, graphNodes,
+ nodeInformationClean,
+ printDotGraph)
+import Data.GraphViz.Types.Canonical (DotGraph (..),
+ DotStatements (..))
import qualified Data.GraphViz.Types.Generalised as G
-import Data.GraphViz.Printing(PrintDot(..), printIt)
-import Data.GraphViz.Parsing(ParseDot(..), parseIt, parseIt')
-import Data.GraphViz.PreProcessing(preProcess)
-import Data.GraphViz.Util(groupSortBy, isSingle)
-import Data.GraphViz.Algorithms
import Test.QuickCheck
-import Data.Graph.Inductive( Graph, DynGraph
- , equal, nmap, emap, labNodes, labEdges, nodes, edges)
-import Data.List(nub, sort)
-import Data.Function(on)
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import Data.Text.Lazy(Text)
-import Control.Arrow((&&&))
+import Control.Arrow ((&&&))
+import Data.Function (on)
+import Data.Graph.Inductive (DynGraph, Graph, edges, emap, equal,
+ labEdges, labNodes, nmap, nodes)
+import Data.List (nub, sort)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Text.Lazy (Text)
-- -----------------------------------------------------------------------------
-- The properties to test for
diff --git a/utils/AttributeGenerator.hs b/utils/AttributeGenerator.hs
--- a/utils/AttributeGenerator.hs
+++ b/utils/AttributeGenerator.hs
@@ -467,39 +467,39 @@
attributes :: [Attribute]
attributes = [
-- BEGIN RECEIVE ORGTBL Attributes
- makeAttr "Damping" ["Damping"] "G" (Dbl) Nothing (Just "0.99") (Just "@0.99@") (Just "@0.0@") (Just "neato only"),
- makeAttr "K" ["K"] "GC" (Dbl) Nothing (Just "0.3") (Just "@0.3@") (Just "@0@") (Just "sfdp, fdp only"),
+ makeAttr "Damping" ["Damping"] "G" (Dbl) Nothing (Just "0.99") (Just "@0.99@") (Just "@0.0@") (Just "'Neato' only"),
+ makeAttr "K" ["K"] "GC" (Dbl) Nothing (Just "0.3") (Just "@0.3@") (Just "@0@") (Just "'Sfdp', 'Fdp' only"),
makeAttr "URL" ["URL", "href"] "ENGC" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, postscript, map only"),
- makeAttr "Area" ["area"] "NC" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@>0@") (Just "patchwork only, requires Graphviz >= 2.30.0"),
+ makeAttr "Area" ["area"] "NC" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@>0@") (Just "'Patchwork' only, requires Graphviz >= 2.30.0"),
makeAttr "ArrowHead" ["arrowhead"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing,
makeAttr "ArrowSize" ["arrowsize"] "E" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") Nothing,
makeAttr "ArrowTail" ["arrowtail"] "E" (Cust "ArrowType") Nothing (Just "normal") (Just "@'normal'@") Nothing Nothing,
- makeAttr "Aspect" ["aspect"] "G" (Cust "AspectType") Nothing Nothing Nothing Nothing (Just "dot only"),
+ makeAttr "Background" ["_background"] "G" (Strng) Nothing (Just "\"\"") (Just "none") Nothing (Just "xdot only"),
makeAttr "BoundingBox" ["bb"] "G" (Cust "Rect") Nothing Nothing Nothing Nothing (Just "write only"),
makeAttr "BgColor" ["bgcolor"] "GC" (Cust "ColorList") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,
makeAttr "Center" ["center"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
- makeAttr "ClusterRank" ["clusterrank"] "G" (Cust "ClusterMode") Nothing (Just "Local") (Just "@'Local'@") Nothing (Just "dot only"),
+ makeAttr "ClusterRank" ["clusterrank"] "G" (Cust "ClusterMode") Nothing (Just "Local") (Just "@'Local'@") Nothing (Just "'Dot' only"),
makeAttr "Color" ["color"] "ENC" (Cust "ColorList") Nothing (Just "[toWColor Black]") (Just "@['WC' ('X11Color' 'Black') Nothing]@") Nothing Nothing,
makeAttr "ColorScheme" ["colorscheme"] "ENCG" (Cust "ColorScheme") Nothing (Just "X11") (Just "@'X11'@") Nothing Nothing,
makeAttr "Comment" ["comment"] "ENG" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing,
- makeAttr "Compound" ["compound"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "dot only"),
+ makeAttr "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 "Constraint" ["constraint"] "E" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "'Dot' only"),
makeAttr "Decorate" ["decorate"] "E" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
- makeAttr "DefaultDist" ["defaultdist"] "G" (Dbl) Nothing Nothing (Just "@1+(avg. len)*sqrt(abs(V))@ (unable to statically define)") (Just "The value of 'Epsilon'.") (Just "neato only, only if @'Pack' 'DontPack'@"),
- makeAttr "Dim" ["dim"] "G" (Integ) Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "maximum of @10@; sfdp, fdp, neato only"),
- makeAttr "Dimen" ["dimen"] "G" (Integ) Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "maximum of @10@; sfdp, fdp, neato only"),
+ makeAttr "DefaultDist" ["defaultdist"] "G" (Dbl) Nothing Nothing (Just "@1+(avg. len)*sqrt(abs(V))@ (unable to statically define)") (Just "The value of 'Epsilon'.") (Just "'Neato' only, only if @'Pack' 'DontPack'@"),
+ makeAttr "Dim" ["dim"] "G" (Integ) Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only"),
+ makeAttr "Dimen" ["dimen"] "G" (Integ) Nothing (Just "2") (Just "@2@") (Just "@2@") (Just "maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only"),
makeAttr "Dir" ["dir"] "E" (Cust "DirType") Nothing Nothing (Just "@'Forward'@ (directed), @'NoDir'@ (undirected)") Nothing Nothing,
- makeAttr "DirEdgeConstraints" ["diredgeconstraints"] "G" (Cust "DEConstraints") (Just "EdgeConstraints") (Just "NoConstraints") (Just "@'NoConstraints'@") Nothing (Just "neato only"),
+ makeAttr "DirEdgeConstraints" ["diredgeconstraints"] "G" (Cust "DEConstraints") (Just "EdgeConstraints") (Just "NoConstraints") (Just "@'NoConstraints'@") Nothing (Just "'Neato' only"),
makeAttr "Distortion" ["distortion"] "N" (Dbl) Nothing (Just "0.0") (Just "@0.0@") (Just "@-100.0@") Nothing,
makeAttr "DPI" ["dpi", "resolution"] "G" (Dbl) Nothing (Just "96.0") (Just "@96.0@, @0.0@") Nothing (Just "svg, bitmap output only; \\\"resolution\\\" is a synonym"),
makeAttr "EdgeURL" ["edgeURL", "edgehref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),
makeAttr "EdgeTarget" ["edgetarget"] "E" (EStrng) Nothing Nothing (Just "none") Nothing (Just "svg, map only"),
makeAttr "EdgeTooltip" ["edgetooltip"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),
- makeAttr "Epsilon" ["epsilon"] "G" (Dbl) Nothing Nothing (Just "@.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@)") Nothing (Just "neato only"),
- makeAttr "ESep" ["esep"] "G" (Cust "DPoint") Nothing (Just "(DVal 3)") (Just "@'DVal' 3@") Nothing (Just "not dot"),
+ makeAttr "Epsilon" ["epsilon"] "G" (Dbl) Nothing Nothing (Just "@.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@)") Nothing (Just "'Neato' only"),
+ makeAttr "ESep" ["esep"] "G" (Cust "DPoint") Nothing (Just "(DVal 3)") (Just "@'DVal' 3@") Nothing (Just "not 'Dot'"),
makeAttr "FillColor" ["fillcolor"] "NEC" (Cust "ColorList") Nothing (Just "[toWColor Black]") (Just "@['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters)") Nothing Nothing,
- makeAttr "FixedSize" ["fixedsize"] "N" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
+ makeAttr "FixedSize" ["fixedsize"] "N" (Cust "NodeSize") (Just "SetNodeSize") (Just "GrowAsNeeded") (Just "@'GrowAsNeeded'@") Nothing Nothing,
makeAttr "FontColor" ["fontcolor"] "ENGC" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing,
makeAttr "FontName" ["fontname"] "ENGC" (Strng) Nothing (Just "\"Times-Roman\"") (Just "@\\\"Times-Roman\\\"@") Nothing Nothing,
makeAttr "FontNames" ["fontnames"] "G" (Cust "SVGFontNames") Nothing (Just "SvgNames") (Just "@'SvgNames'@") Nothing (Just "svg only"),
@@ -507,7 +507,7 @@
makeAttr "FontSize" ["fontsize"] "ENGC" (Dbl) Nothing (Just "14.0") (Just "@14.0@") (Just "@1.0@") Nothing,
makeAttr "ForceLabels" ["forcelabels"] "G" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "only for 'XLabel' attributes, requires Graphviz >= 2.29.0"),
makeAttr "GradientAngle" ["gradientangle"] "NCG" (Integ) Nothing (Just "0") (Just "0") Nothing (Just "requires Graphviz >= 2.29.0"),
- makeAttr "Group" ["group"] "N" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only"),
+ makeAttr "Group" ["group"] "N" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),
makeAttr "HeadURL" ["headURL", "headhref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),
makeAttr "Head_LP" ["head_lp"] "E" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.30.0"),
makeAttr "HeadClip" ["headclip"] "E" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing,
@@ -520,9 +520,10 @@
makeAttr "Image" ["image"] "N" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing Nothing,
makeAttr "ImagePath" ["imagepath"] "G" (Cust "Paths") Nothing (Just "(Paths [])") (Just "@'Paths' []@") Nothing (Just "Printing and parsing is OS-specific, requires Graphviz >= 2.29.0"),
makeAttr "ImageScale" ["imagescale"] "N" (Cust "ScaleType") (Just "UniformScale") (Just "NoScale") (Just "@'NoScale'@") Nothing Nothing,
+ makeAttr "InputScale" ["inputscale"] "N" (Dbl) Nothing Nothing (Just "none") Nothing (Just "'Fdp', 'Neato' only, a value of @0@ is equivalent to being @72@, requires Graphviz >= 2.36.0"),
makeAttr "Label" ["label"] "ENGC" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise)") Nothing Nothing,
makeAttr "LabelURL" ["labelURL", "labelhref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),
- makeAttr "LabelScheme" ["label_scheme"] "G" (Cust "LabelScheme") Nothing (Just "NotEdgeLabel") (Just "@'NotEdgeLabel'@") Nothing (Just "sfdp only, requires Graphviz >= 2.28.0"),
+ makeAttr "LabelScheme" ["label_scheme"] "G" (Cust "LabelScheme") Nothing (Just "NotEdgeLabel") (Just "@'NotEdgeLabel'@") Nothing (Just "'Sfdp' only, requires Graphviz >= 2.28.0"),
makeAttr "LabelAngle" ["labelangle"] "E" (Dbl) Nothing (Just "(-25.0)") (Just "@-25.0@") (Just "@-180.0@") Nothing,
makeAttr "LabelDistance" ["labeldistance"] "E" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") Nothing,
makeAttr "LabelFloat" ["labelfloat"] "E" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
@@ -534,80 +535,81 @@
makeAttr "LabelTarget" ["labeltarget"] "E" (EStrng) Nothing (Just "\"\"") (Just "none") Nothing (Just "svg, map only"),
makeAttr "LabelTooltip" ["labeltooltip"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, cmap only"),
makeAttr "Landscape" ["landscape"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
- makeAttr "Layer" ["layer"] "EN" (Cust "LayerRange") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,
+ makeAttr "Layer" ["layer"] "ENC" (Cust "LayerRange") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,
makeAttr "LayerListSep" ["layerlistsep"] "G" (Cust "LayerListSep") Nothing (Just "(LLSep \",\")") (Just "@'LLSep' \\\",\\\"@") Nothing (Just "requires Graphviz >= 2.30.0"),
makeAttr "Layers" ["layers"] "G" (Cust "LayerList") Nothing (Just "(LL [])") (Just "@'LL' []@") Nothing Nothing,
makeAttr "LayerSelect" ["layerselect"] "G" (Cust "LayerRange") Nothing (Just "[]") (Just "@[]@") Nothing Nothing,
makeAttr "LayerSep" ["layersep"] "G" (Cust "LayerSep") Nothing (Just "(LSep \" :\\t\")") (Just "@'LSep' \\\" :\\t\\\"@") Nothing Nothing,
makeAttr "Layout" ["layout"] "G" (Cust "GraphvizCommand") Nothing Nothing Nothing Nothing Nothing,
- makeAttr "Len" ["len"] "E" (Dbl) Nothing Nothing (Just "@1.0@ (neato), @0.3@ (fdp)") Nothing (Just "fdp, neato only"),
- makeAttr "Levels" ["levels"] "G" (Integ) Nothing (Just "maxBound") (Just "@'maxBound'@") (Just "@0@") (Just "sfdp only"),
- makeAttr "LevelsGap" ["levelsgap"] "G" (Dbl) Nothing (Just "0.0") (Just "@0.0@") Nothing (Just "neato only"),
- makeAttr "LHead" ["lhead"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only"),
+ makeAttr "Len" ["len"] "E" (Dbl) Nothing Nothing (Just "@1.0@ ('Neato'), @0.3@ ('Fdp')") Nothing (Just "'Fdp', 'Neato' only"),
+ makeAttr "Levels" ["levels"] "G" (Integ) Nothing (Just "maxBound") (Just "@'maxBound'@") (Just "@0@") (Just "'Sfdp' only"),
+ makeAttr "LevelsGap" ["levelsgap"] "G" (Dbl) Nothing (Just "0.0") (Just "@0.0@") Nothing (Just "'Neato' only"),
+ makeAttr "LHead" ["lhead"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),
makeAttr "LHeight" ["LHeight"] "GC" (Dbl) Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.28.0"),
makeAttr "LPos" ["lp"] "EGC" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only"),
- makeAttr "LTail" ["ltail"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only"),
+ makeAttr "LTail" ["ltail"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),
makeAttr "LWidth" ["lwidth"] "GC" (Dbl) Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.28.0"),
- makeAttr "Margin" ["margin"] "NG" (Cust "DPoint") Nothing Nothing (Just "device dependent") Nothing Nothing,
- makeAttr "MaxIter" ["maxiter"] "G" (Integ) Nothing Nothing (Just "@100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp)") Nothing (Just "fdp, neato only"),
- makeAttr "MCLimit" ["mclimit"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") Nothing (Just "dot only"),
- makeAttr "MinDist" ["mindist"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") (Just "circo only"),
- makeAttr "MinLen" ["minlen"] "E" (Integ) Nothing (Just "1") (Just "@1@") (Just "@0@") (Just "dot only"),
- makeAttr "Mode" ["mode"] "G" (Cust "ModeType") Nothing (Just "Major") (Just "@'Major'@") Nothing (Just "neato only"),
- makeAttr "Model" ["model"] "G" (Cust "Model") Nothing (Just "ShortPath") (Just "@'ShortPath'@") Nothing (Just "neato only"),
- makeAttr "Mosek" ["mosek"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "neato only; requires the Mosek software"),
- makeAttr "NodeSep" ["nodesep"] "G" (Dbl) Nothing (Just "0.25") (Just "@0.25@") (Just "@0.02@") (Just "dot only"),
+ makeAttr "Margin" ["margin"] "NGC" (Cust "DPoint") Nothing Nothing (Just "device dependent") Nothing Nothing,
+ makeAttr "MaxIter" ["maxiter"] "G" (Integ) Nothing Nothing (Just "@100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ ('Fdp')") Nothing (Just "'Fdp', 'Neato' only"),
+ makeAttr "MCLimit" ["mclimit"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") Nothing (Just "'Dot' only"),
+ makeAttr "MinDist" ["mindist"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") (Just "'Circo' only"),
+ makeAttr "MinLen" ["minlen"] "E" (Integ) Nothing (Just "1") (Just "@1@") (Just "@0@") (Just "'Dot' only"),
+ makeAttr "Mode" ["mode"] "G" (Cust "ModeType") Nothing (Just "Major") (Just "@'Major'@ (actually @'Spring'@ for 'Sfdp', but this isn't used as a default in this library)") Nothing (Just "'Neato', 'Sfdp' only"),
+ makeAttr "Model" ["model"] "G" (Cust "Model") Nothing (Just "ShortPath") (Just "@'ShortPath'@") Nothing (Just "'Neato' only"),
+ makeAttr "Mosek" ["mosek"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Neato' only; requires the Mosek software"),
+ makeAttr "NodeSep" ["nodesep"] "G" (Dbl) Nothing (Just "0.25") (Just "@0.25@") (Just "@0.02@") Nothing,
makeAttr "NoJustify" ["nojustify"] "GCNE" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
- makeAttr "Normalize" ["normalize"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "not dot"),
- makeAttr "Nslimit" ["nslimit"] "G" (Dbl) Nothing Nothing Nothing Nothing (Just "dot only"),
- makeAttr "Nslimit1" ["nslimit1"] "G" (Dbl) Nothing Nothing Nothing Nothing (Just "dot only"),
- makeAttr "Ordering" ["ordering"] "GN" (Cust "Order") Nothing Nothing (Just "none") Nothing (Just "dot only"),
+ makeAttr "Normalize" ["normalize"] "G" (Cust "Normalized") (Just "IsNormalized") (Just "NotNormalized") (Just "@'NotNormalized'@") Nothing (Just "not 'Dot'"),
+ makeAttr "Nslimit" ["nslimit"] "G" (Dbl) Nothing Nothing Nothing Nothing (Just "'Dot' only"),
+ makeAttr "Nslimit1" ["nslimit1"] "G" (Dbl) Nothing Nothing Nothing Nothing (Just "'Dot' only"),
+ makeAttr "Ordering" ["ordering"] "GN" (Cust "Order") Nothing Nothing (Just "none") Nothing (Just "'Dot' only"),
makeAttr "Orientation" ["orientation"] "N" (Dbl) Nothing (Just "0.0") (Just "@0.0@") (Just "@360.0@") Nothing,
makeAttr "OutputOrder" ["outputorder"] "G" (Cust "OutputMode") Nothing (Just "BreadthFirst") (Just "@'BreadthFirst'@") Nothing Nothing,
- makeAttr "Overlap" ["overlap"] "G" (Cust "Overlap") (Just "KeepOverlaps") (Just "KeepOverlaps") (Just "@'KeepOverlaps'@") Nothing (Just "not dot"),
- makeAttr "OverlapScaling" ["overlap_scaling"] "G" (Dbl) Nothing (Just "(-4)") (Just "@-4@") (Just "@-1.0e10@") (Just "prism only"),
- makeAttr "Pack" ["pack"] "G" (Cust "Pack") (Just "DoPack") (Just "DontPack") (Just "@'DontPack'@") Nothing (Just "not dot"),
- makeAttr "PackMode" ["packmode"] "G" (Cust "PackMode") Nothing (Just "PackNode") (Just "@'PackNode'@") Nothing (Just "not dot"),
+ makeAttr "Overlap" ["overlap"] "G" (Cust "Overlap") (Just "KeepOverlaps") (Just "KeepOverlaps") (Just "@'KeepOverlaps'@") Nothing (Just "not 'Dot'"),
+ makeAttr "OverlapScaling" ["overlap_scaling"] "G" (Dbl) Nothing (Just "(-4)") (Just "@-4@") (Just "@-1.0e10@") (Just "'PrismOverlap' only"),
+ makeAttr "OverlapShrink" ["overlap_shrink"] "G" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing (Just "'PrismOverlap' only, requires Graphviz >= 2.36.0"),
+ makeAttr "Pack" ["pack"] "G" (Cust "Pack") (Just "DoPack") (Just "DontPack") (Just "@'DontPack'@") Nothing Nothing,
+ makeAttr "PackMode" ["packmode"] "G" (Cust "PackMode") Nothing (Just "PackNode") (Just "@'PackNode'@") Nothing Nothing,
makeAttr "Pad" ["pad"] "G" (Cust "DPoint") Nothing (Just "(DVal 0.0555)") (Just "@'DVal' 0.0555@ (4 points)") Nothing Nothing,
makeAttr "Page" ["page"] "G" (Cust "Point") Nothing Nothing Nothing Nothing Nothing,
makeAttr "PageDir" ["pagedir"] "G" (Cust "PageDir") Nothing (Just "Bl") (Just "@'Bl'@") Nothing Nothing,
makeAttr "PenColor" ["pencolor"] "C" (Cust "Color") Nothing (Just "(X11Color Black)") (Just "@'X11Color' 'Black'@") Nothing Nothing,
makeAttr "PenWidth" ["penwidth"] "CNE" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") Nothing,
makeAttr "Peripheries" ["peripheries"] "NC" (Integ) Nothing (Just "1") (Just "shape default (nodes), @1@ (clusters)") (Just "0") Nothing,
- makeAttr "Pin" ["pin"] "N" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "fdp, neato only"),
+ makeAttr "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 "QuadTree" ["quadtree"] "G" (Cust "QuadType") (Just "NormalQT") (Just "NormalQT") (Just "@'NormalQT'@") Nothing (Just "'Sfdp' only"),
makeAttr "Quantum" ["quantum"] "G" (Dbl) Nothing (Just "0") (Just "@0.0@") (Just "@0.0@") Nothing,
- makeAttr "Rank" ["rank"] "S" (Cust "RankType") Nothing Nothing Nothing Nothing (Just "dot only"),
- makeAttr "RankDir" ["rankdir"] "G" (Cust "RankDir") Nothing (Just "FromTop") (Just "@'FromTop'@") Nothing (Just "dot only"),
- makeAttr "RankSep" ["ranksep"] "G" (Cust "[Double]") Nothing Nothing (Just "@[0.5]@ (dot), @[1.0]@ (twopi)") (Just "[0.02]") (Just "twopi, dot only"),
+ makeAttr "Rank" ["rank"] "S" (Cust "RankType") Nothing Nothing Nothing Nothing (Just "'Dot' only"),
+ makeAttr "RankDir" ["rankdir"] "G" (Cust "RankDir") Nothing (Just "FromTop") (Just "@'FromTop'@") Nothing (Just "'Dot' only"),
+ makeAttr "RankSep" ["ranksep"] "G" (Cust "[Double]") Nothing Nothing (Just "@[0.5]@ ('Dot'), @[1.0]@ ('Twopi')") (Just "@[0.02]@") (Just "'Twopi', 'Dot' only"),
makeAttr "Ratio" ["ratio"] "G" (Cust "Ratios") Nothing Nothing Nothing Nothing Nothing,
makeAttr "Rects" ["rects"] "N" (Cust "[Rect]") Nothing Nothing Nothing Nothing (Just "write only"),
makeAttr "Regular" ["regular"] "N" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing Nothing,
- makeAttr "ReMinCross" ["remincross"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "dot only"),
- makeAttr "RepulsiveForce" ["repulsiveforce"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") (Just "sfdp only"),
- makeAttr "Root" ["root"] "GN" (Cust "Root") (Just "IsCentral") (Just "(NodeName \"\")") (Just "@'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes)") Nothing (Just "circo, twopi only"),
+ makeAttr "ReMinCross" ["remincross"] "G" (Bl) (Just "True") (Just "False") (Just "@'False'@") Nothing (Just "'Dot' only"),
+ makeAttr "RepulsiveForce" ["repulsiveforce"] "G" (Dbl) Nothing (Just "1.0") (Just "@1.0@") (Just "@0.0@") (Just "'Sfdp' only"),
+ makeAttr "Root" ["root"] "GN" (Cust "Root") (Just "IsCentral") (Just "(NodeName \"\")") (Just "@'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes)") Nothing (Just "'Circo', 'Twopi' only"),
makeAttr "Rotate" ["rotate"] "G" (Integ) Nothing (Just "0") (Just "@0@") Nothing Nothing,
- makeAttr "Rotation" ["rotation"] "G" (Dbl) Nothing (Just "0") (Just "@0@") Nothing (Just "sfdp only, requires Graphviz >= 2.28.0"),
- makeAttr "SameHead" ["samehead"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only"),
- makeAttr "SameTail" ["sametail"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "dot only"),
+ makeAttr "Rotation" ["rotation"] "G" (Dbl) Nothing (Just "0") (Just "@0@") Nothing (Just "'Sfdp' only, requires Graphviz >= 2.28.0"),
+ makeAttr "SameHead" ["samehead"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),
+ makeAttr "SameTail" ["sametail"] "E" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "'Dot' only"),
makeAttr "SamplePoints" ["samplepoints"] "N" (Integ) Nothing Nothing (Just "@8@ (output), @20@ (overlap and image maps)") Nothing Nothing,
- makeAttr "Scale" ["scale"] "G" (Cust "DPoint") Nothing Nothing Nothing Nothing (Just "twopi only, requires Graphviz >= 2.28.0"),
- makeAttr "SearchSize" ["searchsize"] "G" (Integ) Nothing (Just "30") (Just "@30@") Nothing (Just "dot only"),
- makeAttr "Sep" ["sep"] "G" (Cust "DPoint") Nothing (Just "(DVal 4)") (Just "@'DVal' 4@") Nothing (Just "not dot"),
+ makeAttr "Scale" ["scale"] "G" (Cust "DPoint") Nothing Nothing Nothing Nothing (Just "Not 'Dot', requires Graphviz >= 2.28.0 (>= 2.38.0 for anything except 'TwoPi')"),
+ makeAttr "SearchSize" ["searchsize"] "G" (Integ) Nothing (Just "30") (Just "@30@") Nothing (Just "'Dot' only"),
+ makeAttr "Sep" ["sep"] "G" (Cust "DPoint") Nothing (Just "(DVal 4)") (Just "@'DVal' 4@") Nothing (Just "not 'Dot'"),
makeAttr "Shape" ["shape"] "N" (Cust "Shape") Nothing (Just "Ellipse") (Just "@'Ellipse'@") Nothing Nothing,
- makeAttr "ShowBoxes" ["showboxes"] "ENG" (Integ) Nothing (Just "0") (Just "@0@") (Just "@0@") (Just "dot only; used for debugging by printing PostScript guide boxes"),
+ makeAttr "ShowBoxes" ["showboxes"] "ENG" (Integ) Nothing (Just "0") (Just "@0@") (Just "@0@") (Just "'Dot' only; used for debugging by printing PostScript guide boxes"),
makeAttr "Sides" ["sides"] "N" (Integ) Nothing (Just "4") (Just "@4@") (Just "@0@") Nothing,
makeAttr "Size" ["size"] "G" (Cust "GraphSize") Nothing Nothing Nothing Nothing Nothing,
makeAttr "Skew" ["skew"] "N" (Dbl) Nothing (Just "0.0") (Just "@0.0@") (Just "@-100.0@") Nothing,
- makeAttr "Smoothing" ["smoothing"] "G" (Cust "SmoothType") Nothing (Just "NoSmooth") (Just "@'NoSmooth'@") Nothing (Just "sfdp only"),
+ makeAttr "Smoothing" ["smoothing"] "G" (Cust "SmoothType") Nothing (Just "NoSmooth") (Just "@'NoSmooth'@") Nothing (Just "'Sfdp' only"),
makeAttr "SortV" ["sortv"] "GCN" (Cust "Word16") Nothing (Just "0") (Just "@0@") (Just "@0@") Nothing,
- makeAttr "Splines" ["splines"] "G" (Cust "EdgeType") (Just "SplineEdges") Nothing (Just "@'SplineEdges'@ (dot), @'LineEdges'@ (other)") Nothing Nothing,
- makeAttr "Start" ["start"] "G" (Cust "StartType") Nothing Nothing (Just "@'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed.") Nothing (Just "fdp, neato only"),
- makeAttr "Style" ["style"] "ENC" (Cust "[StyleItem]") Nothing Nothing Nothing Nothing Nothing,
+ makeAttr "Splines" ["splines"] "G" (Cust "EdgeType") (Just "SplineEdges") Nothing (Just "@'SplineEdges'@ ('Dot'), @'LineEdges'@ (other)") Nothing Nothing,
+ makeAttr "Start" ["start"] "G" (Cust "StartType") Nothing Nothing (Just "@'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed.") Nothing (Just "'Fdp', 'Neato' only"),
+ makeAttr "Style" ["style"] "ENCG" (Cust "[StyleItem]") Nothing Nothing Nothing Nothing Nothing,
makeAttr "StyleSheet" ["stylesheet"] "G" (Strng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg only"),
makeAttr "TailURL" ["tailURL", "tailhref"] "E" (EStrng) Nothing (Just "\"\"") (Just "@\\\"\\\"@") Nothing (Just "svg, map only"),
- makeAttr "Tail_LP" ["tail_lp"] "E" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only"),
+ makeAttr "Tail_LP" ["tail_lp"] "E" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.30.0"),
makeAttr "TailClip" ["tailclip"] "E" (Bl) (Just "True") (Just "True") (Just "@'True'@") Nothing Nothing,
makeAttr "TailLabel" ["taillabel"] "E" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing Nothing,
makeAttr "TailPort" ["tailport"] "E" (Cust "PortPos") Nothing (Just "(CompassPoint CenterPoint)") (Just "@'CompassPoint' 'CenterPoint'@") Nothing Nothing,
@@ -618,9 +620,10 @@
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 (Just "1.0") (Just "@1.0@") (Just "@0@ (dot), @1@ (neato,fdp,sfdp)") Nothing,
+ makeAttr "VoroMargin" ["voro_margin"] "G" (Dbl) Nothing (Just "0.05") (Just "@0.05@") (Just "@0.0@") (Just "not 'Dot'"),
+ makeAttr "Weight" ["weight"] "E" (Cust "Number") Nothing (Just "(Int 1)") (Just "@'Int' 1@") (Just "@'Int' 0@ ('Dot'), @'Int' 1@ ('Neato','Fdp','Sfdp')") (Just "as of Graphviz 2.30: weights for dot need to be 'Int's"),
makeAttr "Width" ["width"] "N" (Dbl) Nothing (Just "0.75") (Just "@0.75@") (Just "@0.01@") Nothing,
+ makeAttr "XDotVersion" ["xdotversion"] "G" (Cust "Version") Nothing Nothing Nothing Nothing (Just "xdot only, requires Graphviz >= 2.34.0, equivalent to specifying version of xdot to be used"),
makeAttr "XLabel" ["xlabel"] "EN" (Cust "Label") Nothing (Just "(StrLabel \"\")") (Just "@'StrLabel' \\\"\\\"@") Nothing (Just "requires Graphviz >= 2.29.0"),
makeAttr "XLP" ["xlp"] "EN" (Cust "Point") Nothing Nothing Nothing Nothing (Just "write only, requires Graphviz >= 2.29.0")
-- END RECEIVE ORGTBL Attributes
@@ -649,165 +652,171 @@
valid Haskell value (add parens if needed) with the exception that
double-quotes should be escaped.
+* @C-c `@ can be used to edit a field that has been narrowed.
+
#+ORGTBL: SEND Attributes orgtbl-to-generic :skip 2 :splice t :hline nil :no-escape t :lstart " makeAttr " :lend "," :llend "" :sep " " :fmt (1 cell-quote 2 cell-to-list 3 cell-quote 4 cell-parens 5 cell-to-maybe 6 cell-to-maybe 7 cell-to-maybe 8 cell-to-maybe 9 cell-to-maybe)
-| Constructor | Allowed names | Used By | Type | Parsing default | Default value | Default for Documentation | Minimum | Comment notes |
-|--------------------+--------------------+---------+--------------------------+-----------------+----------------------------+-----------------------------------------------------------------------------------------------------+---------------------------------+------------------------------------------------------------------|
-| Damping | Damping | G | Dbl | | 0.99 | @0.99@ | @0.0@ | neato only |
-| K | K | GC | Dbl | | 0.3 | @0.3@ | @0@ | sfdp, fdp only |
-| URL | URL href | ENGC | EStrng | | \"\" | none | | svg, postscript, map only |
-| Area | area | NC | Dbl | | 1.0 | @1.0@ | @>0@ | patchwork only, requires Graphviz >= 2.30.0 |
-| ArrowHead | arrowhead | E | Cust "ArrowType" | | normal | @'normal'@ | | |
-| ArrowSize | arrowsize | E | Dbl | | 1.0 | @1.0@ | @0.0@ | |
-| ArrowTail | arrowtail | E | Cust "ArrowType" | | normal | @'normal'@ | | |
-| Aspect | aspect | G | Cust "AspectType" | | | | | dot only |
-| BoundingBox | bb | G | Cust "Rect" | | | | | write only |
-| BgColor | bgcolor | GC | Cust "ColorList" | | [] | @[]@ | | |
-| Center | center | G | Bl | True | False | @'False'@ | | |
-| ClusterRank | clusterrank | G | Cust "ClusterMode" | | Local | @'Local'@ | | dot only |
-| Color | color | ENC | Cust "ColorList" | | [toWColor Black] | @['WC' ('X11Color' 'Black') Nothing]@ | | |
-| ColorScheme | colorscheme | ENCG | Cust "ColorScheme" | | X11 | @'X11'@ | | |
-| Comment | comment | ENG | Strng | | \"\" | @\\\"\\\"@ | | |
-| Compound | compound | G | Bl | True | False | @'False'@ | | dot only |
-| Concentrate | concentrate | G | Bl | True | False | @'False'@ | | |
-| Constraint | constraint | E | Bl | True | True | @'True'@ | | dot only |
-| Decorate | decorate | E | Bl | True | False | @'False'@ | | |
-| DefaultDist | defaultdist | G | Dbl | | | @1+(avg. len)*sqrt(abs(V))@ (unable to statically define) | The value of 'Epsilon'. | neato only, only if @'Pack' 'DontPack'@ |
-| Dim | dim | G | Integ | | 2 | @2@ | @2@ | maximum of @10@; sfdp, fdp, neato only |
-| Dimen | dimen | G | Integ | | 2 | @2@ | @2@ | maximum of @10@; sfdp, fdp, neato only |
-| Dir | dir | E | Cust "DirType" | | | @'Forward'@ (directed), @'NoDir'@ (undirected) | | |
-| DirEdgeConstraints | diredgeconstraints | G | Cust "DEConstraints" | EdgeConstraints | NoConstraints | @'NoConstraints'@ | | neato only |
-| Distortion | distortion | N | Dbl | | 0.0 | @0.0@ | @-100.0@ | |
-| DPI | dpi resolution | G | Dbl | | 96.0 | @96.0@, @0.0@ | | svg, bitmap output only; \\\"resolution\\\" is a synonym |
-| EdgeURL | edgeURL edgehref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
-| EdgeTarget | edgetarget | E | EStrng | | | none | | svg, map only |
-| EdgeTooltip | edgetooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
-| Epsilon | epsilon | G | Dbl | | | @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@) | | neato only |
-| ESep | esep | G | Cust "DPoint" | | (DVal 3) | @'DVal' 3@ | | not dot |
-| FillColor | fillcolor | NEC | Cust "ColorList" | | [toWColor Black] | @['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters) | | |
-| FixedSize | fixedsize | N | Bl | True | False | @'False'@ | | |
-| FontColor | fontcolor | ENGC | Cust "Color" | | (X11Color Black) | @'X11Color' 'Black'@ | | |
-| FontName | fontname | ENGC | Strng | | \"Times-Roman\" | @\\\"Times-Roman\\\"@ | | |
-| FontNames | fontnames | G | Cust "SVGFontNames" | | SvgNames | @'SvgNames'@ | | svg only |
-| FontPath | fontpath | G | Cust "Paths" | | | system dependent | | |
-| FontSize | fontsize | ENGC | Dbl | | 14.0 | @14.0@ | @1.0@ | |
-| ForceLabels | forcelabels | G | Bl | True | True | @'True'@ | | only for 'XLabel' attributes, requires Graphviz >= 2.29.0 |
-| GradientAngle | gradientangle | NCG | Integ | | 0 | 0 | | requires Graphviz >= 2.29.0 |
-| Group | group | N | Strng | | \"\" | @\\\"\\\"@ | | dot only |
-| HeadURL | headURL headhref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
-| Head_LP | head_lp | E | Cust "Point" | | | | | write only, requires Graphviz >= 2.30.0 |
-| HeadClip | headclip | E | Bl | True | True | @'True'@ | | |
-| HeadLabel | headlabel | E | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ | | |
-| HeadPort | headport | E | Cust "PortPos" | | (CompassPoint CenterPoint) | @'CompassPoint' 'CenterPoint'@ | | |
-| HeadTarget | headtarget | E | EStrng | | \"\" | none | | svg, map only |
-| HeadTooltip | headtooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
-| Height | height | N | Dbl | | 0.5 | @0.5@ | @0.02@ | |
-| ID | id | GNE | EStrng | | \"\" | @\\\"\\\"@ | | svg, postscript, map only |
-| Image | image | N | Strng | | \"\" | @\\\"\\\"@ | | |
-| ImagePath | imagepath | G | Cust "Paths" | | (Paths []) | @'Paths' []@ | | Printing and parsing is OS-specific, requires Graphviz >= 2.29.0 |
-| ImageScale | imagescale | N | Cust "ScaleType" | UniformScale | NoScale | @'NoScale'@ | | |
-| Label | label | ENGC | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise) | | |
-| LabelURL | labelURL labelhref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
-| LabelScheme | label_scheme | G | Cust "LabelScheme" | | NotEdgeLabel | @'NotEdgeLabel'@ | | sfdp only, requires Graphviz >= 2.28.0 |
-| LabelAngle | labelangle | E | Dbl | | (-25.0) | @-25.0@ | @-180.0@ | |
-| LabelDistance | labeldistance | E | Dbl | | 1.0 | @1.0@ | @0.0@ | |
-| LabelFloat | labelfloat | E | Bl | True | False | @'False'@ | | |
-| LabelFontColor | labelfontcolor | E | Cust "Color" | | (X11Color Black) | @'X11Color' 'Black'@ | | |
-| LabelFontName | labelfontname | E | Strng | | \"Times-Roman\" | @\\\"Times-Roman\\\"@ | | |
-| LabelFontSize | labelfontsize | E | Dbl | | 14.0 | @14.0@ | @1.0@ | |
-| LabelJust | labeljust | GC | Cust "Justification" | | JCenter | @'JCenter'@ | | |
-| LabelLoc | labelloc | GCN | Cust "VerticalPlacement" | | VTop | @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes) | | |
-| LabelTarget | labeltarget | E | EStrng | | \"\" | none | | svg, map only |
-| LabelTooltip | labeltooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
-| Landscape | landscape | G | Bl | True | False | @'False'@ | | |
-| Layer | layer | EN | Cust "LayerRange" | | [] | @[]@ | | |
-| LayerListSep | layerlistsep | G | Cust "LayerListSep" | | (LLSep \",\") | @'LLSep' \\\",\\\"@ | | requires Graphviz >= 2.30.0 |
-| Layers | layers | G | Cust "LayerList" | | (LL []) | @'LL' []@ | | |
-| LayerSelect | layerselect | G | Cust "LayerRange" | | [] | @[]@ | | |
-| LayerSep | layersep | G | Cust "LayerSep" | | (LSep \" :\\t\") | @'LSep' \\\" :\\t\\\"@ | | |
-| Layout | layout | G | Cust "GraphvizCommand" | | | | | |
-| Len | len | E | Dbl | | | @1.0@ (neato), @0.3@ (fdp) | | fdp, neato only |
-| Levels | levels | G | Integ | | maxBound | @'maxBound'@ | @0@ | sfdp only |
-| LevelsGap | levelsgap | G | Dbl | | 0.0 | @0.0@ | | neato only |
-| LHead | lhead | E | Strng | | \"\" | @\\\"\\\"@ | | dot only |
-| LHeight | LHeight | GC | Dbl | | | | | write only, requires Graphviz >= 2.28.0 |
-| LPos | lp | EGC | Cust "Point" | | | | | write only |
-| LTail | ltail | E | Strng | | \"\" | @\\\"\\\"@ | | dot only |
-| LWidth | lwidth | GC | Dbl | | | | | write only, requires Graphviz >= 2.28.0 |
-| Margin | margin | NG | Cust "DPoint" | | | device dependent | | |
-| MaxIter | maxiter | G | Integ | | | @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp) | | fdp, neato only |
-| MCLimit | mclimit | G | Dbl | | 1.0 | @1.0@ | | dot only |
-| MinDist | mindist | G | Dbl | | 1.0 | @1.0@ | @0.0@ | circo only |
-| MinLen | minlen | E | Integ | | 1 | @1@ | @0@ | dot only |
-| Mode | mode | G | Cust "ModeType" | | Major | @'Major'@ | | neato only |
-| Model | model | G | Cust "Model" | | ShortPath | @'ShortPath'@ | | neato only |
-| Mosek | mosek | G | Bl | True | False | @'False'@ | | neato only; requires the Mosek software |
-| NodeSep | nodesep | G | Dbl | | 0.25 | @0.25@ | @0.02@ | dot only |
-| NoJustify | nojustify | GCNE | Bl | True | False | @'False'@ | | |
-| Normalize | normalize | G | Bl | True | False | @'False'@ | | not dot |
-| Nslimit | nslimit | G | Dbl | | | | | dot only |
-| Nslimit1 | nslimit1 | G | Dbl | | | | | dot only |
-| Ordering | ordering | GN | Cust "Order" | | | none | | dot only |
-| Orientation | orientation | N | Dbl | | 0.0 | @0.0@ | @360.0@ | |
-| OutputOrder | outputorder | G | Cust "OutputMode" | | BreadthFirst | @'BreadthFirst'@ | | |
-| Overlap | overlap | G | Cust "Overlap" | KeepOverlaps | KeepOverlaps | @'KeepOverlaps'@ | | not dot |
-| OverlapScaling | overlap_scaling | G | Dbl | | (-4) | @-4@ | @-1.0e10@ | prism only |
-| Pack | pack | G | Cust "Pack" | DoPack | DontPack | @'DontPack'@ | | not dot |
-| PackMode | packmode | G | Cust "PackMode" | | PackNode | @'PackNode'@ | | not dot |
-| Pad | pad | G | Cust "DPoint" | | (DVal 0.0555) | @'DVal' 0.0555@ (4 points) | | |
-| Page | page | G | Cust "Point" | | | | | |
-| PageDir | pagedir | G | Cust "PageDir" | | Bl | @'Bl'@ | | |
-| PenColor | pencolor | C | Cust "Color" | | (X11Color Black) | @'X11Color' 'Black'@ | | |
-| PenWidth | penwidth | CNE | Dbl | | 1.0 | @1.0@ | @0.0@ | |
-| Peripheries | peripheries | NC | Integ | | 1 | shape default (nodes), @1@ (clusters) | 0 | |
-| Pin | pin | N | Bl | True | False | @'False'@ | | fdp, neato only |
-| Pos | pos | EN | Cust "Pos" | | | | | |
-| QuadTree | quadtree | G | Cust "QuadType" | NormalQT | NormalQT | @'NormalQT'@ | | sfdp only |
-| Quantum | quantum | G | Dbl | | 0 | @0.0@ | @0.0@ | |
-| Rank | rank | S | Cust "RankType" | | | | | dot only |
-| RankDir | rankdir | G | Cust "RankDir" | | FromTop | @'FromTop'@ | | dot only |
-| RankSep | ranksep | G | Cust "[Double]" | | | @[0.5]@ (dot), @[1.0]@ (twopi) | [0.02] | twopi, dot only |
-| Ratio | ratio | G | Cust "Ratios" | | | | | |
-| Rects | rects | N | Cust "[Rect]" | | | | | write only |
-| Regular | regular | N | Bl | True | False | @'False'@ | | |
-| ReMinCross | remincross | G | Bl | True | False | @'False'@ | | dot only |
-| RepulsiveForce | repulsiveforce | G | Dbl | | 1.0 | @1.0@ | @0.0@ | sfdp only |
-| Root | root | GN | Cust "Root" | IsCentral | (NodeName \"\") | @'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes) | | circo, twopi only |
-| Rotate | rotate | G | Integ | | 0 | @0@ | | |
-| Rotation | rotation | G | Dbl | | 0 | @0@ | | sfdp only, requires Graphviz >= 2.28.0 |
-| SameHead | samehead | E | Strng | | \"\" | @\\\"\\\"@ | | dot only |
-| SameTail | sametail | E | Strng | | \"\" | @\\\"\\\"@ | | dot only |
-| SamplePoints | samplepoints | N | Integ | | | @8@ (output), @20@ (overlap and image maps) | | |
-| Scale | scale | G | Cust "DPoint" | | | | | twopi only, requires Graphviz >= 2.28.0 |
-| SearchSize | searchsize | G | Integ | | 30 | @30@ | | dot only |
-| Sep | sep | G | Cust "DPoint" | | (DVal 4) | @'DVal' 4@ | | not dot |
-| Shape | shape | N | Cust "Shape" | | Ellipse | @'Ellipse'@ | | |
-| ShowBoxes | showboxes | ENG | Integ | | 0 | @0@ | @0@ | dot only; used for debugging by printing PostScript guide boxes |
-| Sides | sides | N | Integ | | 4 | @4@ | @0@ | |
-| Size | size | G | Cust "GraphSize" | | | | | |
-| Skew | skew | N | Dbl | | 0.0 | @0.0@ | @-100.0@ | |
-| Smoothing | smoothing | G | Cust "SmoothType" | | NoSmooth | @'NoSmooth'@ | | sfdp only |
-| SortV | sortv | GCN | Cust "Word16" | | 0 | @0@ | @0@ | |
-| Splines | splines | G | Cust "EdgeType" | SplineEdges | | @'SplineEdges'@ (dot), @'LineEdges'@ (other) | | |
-| Start | start | G | Cust "StartType" | | | @'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed. | | fdp, neato only |
-| Style | style | ENC | Cust "[StyleItem]" | | | | | |
-| StyleSheet | stylesheet | G | Strng | | \"\" | @\\\"\\\"@ | | svg only |
-| TailURL | tailURL tailhref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
-| Tail_LP | tail_lp | E | Cust "Point" | | | | | write only |
-| TailClip | tailclip | E | Bl | True | True | @'True'@ | | |
-| TailLabel | taillabel | E | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ | | |
-| TailPort | tailport | E | Cust "PortPos" | | (CompassPoint CenterPoint) | @'CompassPoint' 'CenterPoint'@ | | |
-| TailTarget | tailtarget | E | EStrng | | \"\" | none | | svg, map only |
-| TailTooltip | tailtooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
-| Target | target | ENGC | EStrng | | \"\" | none | | svg, map only |
-| Tooltip | tooltip | NEC | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
-| TrueColor | truecolor | G | Bl | True | | | | bitmap output only |
-| Vertices | vertices | N | Cust "[Point]" | | | | | write only |
-| ViewPort | viewport | G | Cust "ViewPort" | | | none | | |
-| VoroMargin | voro_margin | G | Dbl | | 0.05 | @0.05@ | @0.0@ | not dot |
-| Weight | weight | E | Dbl | | 1.0 | @1.0@ | @0@ (dot), @1@ (neato,fdp,sfdp) | |
-| Width | width | N | Dbl | | 0.75 | @0.75@ | @0.01@ | |
-| XLabel | xlabel | EN | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ | | requires Graphviz >= 2.29.0 |
-| XLP | xlp | EN | Cust "Point" | | | | | write only, requires Graphviz >= 2.29.0 |
+| Constructor | Allowed names | Used By | Type | Parse def | Default value | Default for Documentation | Minimum | Comment notes |
+|-----------------+-----------------+---------+-----------------+------------+-----------------+----------------------+------------+----------------------|
+| <15> | <15> | | <15> | <10> | <15> | <20> | <10> | <20> |
+| Damping | Damping | G | Dbl | | 0.99 | @0.99@ | @0.0@ | 'Neato' only |
+| K | K | GC | Dbl | | 0.3 | @0.3@ | @0@ | 'Sfdp', 'Fdp' only |
+| URL | URL href | ENGC | EStrng | | \"\" | none | | svg, postscript, map only |
+| Area | area | NC | Dbl | | 1.0 | @1.0@ | @>0@ | 'Patchwork' only, requires Graphviz >= 2.30.0 |
+| ArrowHead | arrowhead | E | Cust "ArrowType" | | normal | @'normal'@ | | |
+| ArrowSize | arrowsize | E | Dbl | | 1.0 | @1.0@ | @0.0@ | |
+| ArrowTail | arrowtail | E | Cust "ArrowType" | | normal | @'normal'@ | | |
+| Background | _background | G | Strng | | \"\" | none | | xdot only |
+| BoundingBox | bb | G | Cust "Rect" | | | | | write only |
+| BgColor | bgcolor | GC | Cust "ColorList" | | [] | @[]@ | | |
+| Center | center | G | Bl | True | False | @'False'@ | | |
+| ClusterRank | clusterrank | G | Cust "ClusterMode" | | Local | @'Local'@ | | 'Dot' only |
+| Color | color | ENC | Cust "ColorList" | | [toWColor Black] | @['WC' ('X11Color' 'Black') Nothing]@ | | |
+| ColorScheme | colorscheme | ENCG | Cust "ColorScheme" | | X11 | @'X11'@ | | |
+| Comment | comment | ENG | Strng | | \"\" | @\\\"\\\"@ | | |
+| Compound | compound | G | Bl | True | False | @'False'@ | | 'Dot' only |
+| Concentrate | concentrate | G | Bl | True | False | @'False'@ | | |
+| Constraint | constraint | E | Bl | True | True | @'True'@ | | 'Dot' only |
+| Decorate | decorate | E | Bl | True | False | @'False'@ | | |
+| DefaultDist | defaultdist | G | Dbl | | | @1+(avg. len)*sqrt(abs(V))@ (unable to statically define) | The value of 'Epsilon'. | 'Neato' only, only if @'Pack' 'DontPack'@ |
+| Dim | dim | G | Integ | | 2 | @2@ | @2@ | maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only |
+| Dimen | dimen | G | Integ | | 2 | @2@ | @2@ | maximum of @10@; 'Sfdp', 'Fdp', 'Neato' only |
+| Dir | dir | E | Cust "DirType" | | | @'Forward'@ (directed), @'NoDir'@ (undirected) | | |
+| DirEdgeConstraints | diredgeconstraints | G | Cust "DEConstraints" | EdgeConstraints | NoConstraints | @'NoConstraints'@ | | 'Neato' only |
+| Distortion | distortion | N | Dbl | | 0.0 | @0.0@ | @-100.0@ | |
+| DPI | dpi resolution | G | Dbl | | 96.0 | @96.0@, @0.0@ | | svg, bitmap output only; \\\"resolution\\\" is a synonym |
+| EdgeURL | edgeURL edgehref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
+| EdgeTarget | edgetarget | E | EStrng | | | none | | svg, map only |
+| EdgeTooltip | edgetooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
+| Epsilon | epsilon | G | Dbl | | | @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@) | | 'Neato' only |
+| ESep | esep | G | Cust "DPoint" | | (DVal 3) | @'DVal' 3@ | | not 'Dot' |
+| FillColor | fillcolor | NEC | Cust "ColorList" | | [toWColor Black] | @['WC' ('X11Color' 'LightGray') Nothing]@ (nodes), @['WC' ('X11Color' 'Black') Nothing]@ (clusters) | | |
+| FixedSize | fixedsize | N | Cust "NodeSize" | SetNodeSize | GrowAsNeeded | @'GrowAsNeeded'@ | | |
+| FontColor | fontcolor | ENGC | Cust "Color" | | (X11Color Black) | @'X11Color' 'Black'@ | | |
+| FontName | fontname | ENGC | Strng | | \"Times-Roman\" | @\\\"Times-Roman\\\"@ | | |
+| FontNames | fontnames | G | Cust "SVGFontNames" | | SvgNames | @'SvgNames'@ | | svg only |
+| FontPath | fontpath | G | Cust "Paths" | | | system dependent | | |
+| FontSize | fontsize | ENGC | Dbl | | 14.0 | @14.0@ | @1.0@ | |
+| ForceLabels | forcelabels | G | Bl | True | True | @'True'@ | | only for 'XLabel' attributes, requires Graphviz >= 2.29.0 |
+| GradientAngle | gradientangle | NCG | Integ | | 0 | 0 | | requires Graphviz >= 2.29.0 |
+| Group | group | N | Strng | | \"\" | @\\\"\\\"@ | | 'Dot' only |
+| HeadURL | headURL headhref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
+| Head_LP | head_lp | E | Cust "Point" | | | | | write only, requires Graphviz >= 2.30.0 |
+| HeadClip | headclip | E | Bl | True | True | @'True'@ | | |
+| HeadLabel | headlabel | E | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ | | |
+| HeadPort | headport | E | Cust "PortPos" | | (CompassPoint CenterPoint) | @'CompassPoint' 'CenterPoint'@ | | |
+| HeadTarget | headtarget | E | EStrng | | \"\" | none | | svg, map only |
+| HeadTooltip | headtooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
+| Height | height | N | Dbl | | 0.5 | @0.5@ | @0.02@ | |
+| ID | id | GNE | EStrng | | \"\" | @\\\"\\\"@ | | svg, postscript, map only |
+| Image | image | N | Strng | | \"\" | @\\\"\\\"@ | | |
+| ImagePath | imagepath | G | Cust "Paths" | | (Paths []) | @'Paths' []@ | | Printing and parsing is OS-specific, requires Graphviz >= 2.29.0 |
+| ImageScale | imagescale | N | Cust "ScaleType" | UniformScale | NoScale | @'NoScale'@ | | |
+| InputScale | inputscale | N | Dbl | | | none | | 'Fdp', 'Neato' only, a value of @0@ is equivalent to being @72@, requires Graphviz >= 2.36.0 |
+| Label | label | ENGC | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\\N\\\"@ (nodes), @'StrLabel' \\\"\\\"@ (otherwise) | | |
+| LabelURL | labelURL labelhref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
+| LabelScheme | label_scheme | G | Cust "LabelScheme" | | NotEdgeLabel | @'NotEdgeLabel'@ | | 'Sfdp' only, requires Graphviz >= 2.28.0 |
+| LabelAngle | labelangle | E | Dbl | | (-25.0) | @-25.0@ | @-180.0@ | |
+| LabelDistance | labeldistance | E | Dbl | | 1.0 | @1.0@ | @0.0@ | |
+| LabelFloat | labelfloat | E | Bl | True | False | @'False'@ | | |
+| LabelFontColor | labelfontcolor | E | Cust "Color" | | (X11Color Black) | @'X11Color' 'Black'@ | | |
+| LabelFontName | labelfontname | E | Strng | | \"Times-Roman\" | @\\\"Times-Roman\\\"@ | | |
+| LabelFontSize | labelfontsize | E | Dbl | | 14.0 | @14.0@ | @1.0@ | |
+| LabelJust | labeljust | GC | Cust "Justification" | | JCenter | @'JCenter'@ | | |
+| LabelLoc | labelloc | GCN | Cust "VerticalPlacement" | | VTop | @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes) | | |
+| LabelTarget | labeltarget | E | EStrng | | \"\" | none | | svg, map only |
+| LabelTooltip | labeltooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
+| Landscape | landscape | G | Bl | True | False | @'False'@ | | |
+| Layer | layer | ENC | Cust "LayerRange" | | [] | @[]@ | | |
+| LayerListSep | layerlistsep | G | Cust "LayerListSep" | | (LLSep \",\") | @'LLSep' \\\",\\\"@ | | requires Graphviz >= 2.30.0 |
+| Layers | layers | G | Cust "LayerList" | | (LL []) | @'LL' []@ | | |
+| LayerSelect | layerselect | G | Cust "LayerRange" | | [] | @[]@ | | |
+| LayerSep | layersep | G | Cust "LayerSep" | | (LSep \" :\\t\") | @'LSep' \\\" :\\t\\\"@ | | |
+| Layout | layout | G | Cust "GraphvizCommand" | | | | | |
+| Len | len | E | Dbl | | | @1.0@ ('Neato'), @0.3@ ('Fdp') | | 'Fdp', 'Neato' only |
+| Levels | levels | G | Integ | | maxBound | @'maxBound'@ | @0@ | 'Sfdp' only |
+| LevelsGap | levelsgap | G | Dbl | | 0.0 | @0.0@ | | 'Neato' only |
+| LHead | lhead | E | Strng | | \"\" | @\\\"\\\"@ | | 'Dot' only |
+| LHeight | LHeight | GC | Dbl | | | | | write only, requires Graphviz >= 2.28.0 |
+| LPos | lp | EGC | Cust "Point" | | | | | write only |
+| LTail | ltail | E | Strng | | \"\" | @\\\"\\\"@ | | 'Dot' only |
+| LWidth | lwidth | GC | Dbl | | | | | write only, requires Graphviz >= 2.28.0 |
+| Margin | margin | NGC | Cust "DPoint" | | | device dependent | | |
+| MaxIter | maxiter | G | Integ | | | @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ ('Fdp') | | 'Fdp', 'Neato' only |
+| MCLimit | mclimit | G | Dbl | | 1.0 | @1.0@ | | 'Dot' only |
+| MinDist | mindist | G | Dbl | | 1.0 | @1.0@ | @0.0@ | 'Circo' only |
+| MinLen | minlen | E | Integ | | 1 | @1@ | @0@ | 'Dot' only |
+| Mode | mode | G | Cust "ModeType" | | Major | @'Major'@ (actually @'Spring'@ for 'Sfdp', but this isn't used as a default in this library) | | 'Neato', 'Sfdp' only |
+| Model | model | G | Cust "Model" | | ShortPath | @'ShortPath'@ | | 'Neato' only |
+| Mosek | mosek | G | Bl | True | False | @'False'@ | | 'Neato' only; requires the Mosek software |
+| NodeSep | nodesep | G | Dbl | | 0.25 | @0.25@ | @0.02@ | |
+| NoJustify | nojustify | GCNE | Bl | True | False | @'False'@ | | |
+| Normalize | normalize | G | Cust "Normalized" | IsNormalized | NotNormalized | @'NotNormalized'@ | | not 'Dot' |
+| Nslimit | nslimit | G | Dbl | | | | | 'Dot' only |
+| Nslimit1 | nslimit1 | G | Dbl | | | | | 'Dot' only |
+| Ordering | ordering | GN | Cust "Order" | | | none | | 'Dot' only |
+| Orientation | orientation | N | Dbl | | 0.0 | @0.0@ | @360.0@ | |
+| OutputOrder | outputorder | G | Cust "OutputMode" | | BreadthFirst | @'BreadthFirst'@ | | |
+| Overlap | overlap | G | Cust "Overlap" | KeepOverlaps | KeepOverlaps | @'KeepOverlaps'@ | | not 'Dot' |
+| OverlapScaling | overlap_scaling | G | Dbl | | (-4) | @-4@ | @-1.0e10@ | 'PrismOverlap' only |
+| OverlapShrink | overlap_shrink | G | Bl | True | True | @'True'@ | | 'PrismOverlap' only, requires Graphviz >= 2.36.0 |
+| Pack | pack | G | Cust "Pack" | DoPack | DontPack | @'DontPack'@ | | |
+| PackMode | packmode | G | Cust "PackMode" | | PackNode | @'PackNode'@ | | |
+| Pad | pad | G | Cust "DPoint" | | (DVal 0.0555) | @'DVal' 0.0555@ (4 points) | | |
+| Page | page | G | Cust "Point" | | | | | |
+| PageDir | pagedir | G | Cust "PageDir" | | Bl | @'Bl'@ | | |
+| PenColor | pencolor | C | Cust "Color" | | (X11Color Black) | @'X11Color' 'Black'@ | | |
+| PenWidth | penwidth | CNE | Dbl | | 1.0 | @1.0@ | @0.0@ | |
+| Peripheries | peripheries | NC | Integ | | 1 | shape default (nodes), @1@ (clusters) | 0 | |
+| Pin | pin | N | Bl | True | False | @'False'@ | | 'Fdp', 'Neato' only |
+| Pos | pos | EN | Cust "Pos" | | | | | |
+| QuadTree | quadtree | G | Cust "QuadType" | NormalQT | NormalQT | @'NormalQT'@ | | 'Sfdp' only |
+| Quantum | quantum | G | Dbl | | 0 | @0.0@ | @0.0@ | |
+| Rank | rank | S | Cust "RankType" | | | | | 'Dot' only |
+| RankDir | rankdir | G | Cust "RankDir" | | FromTop | @'FromTop'@ | | 'Dot' only |
+| RankSep | ranksep | G | Cust "[Double]" | | | @[0.5]@ ('Dot'), @[1.0]@ ('Twopi') | @[0.02]@ | 'Twopi', 'Dot' only |
+| Ratio | ratio | G | Cust "Ratios" | | | | | |
+| Rects | rects | N | Cust "[Rect]" | | | | | write only |
+| Regular | regular | N | Bl | True | False | @'False'@ | | |
+| ReMinCross | remincross | G | Bl | True | False | @'False'@ | | 'Dot' only |
+| RepulsiveForce | repulsiveforce | G | Dbl | | 1.0 | @1.0@ | @0.0@ | 'Sfdp' only |
+| Root | root | GN | Cust "Root" | IsCentral | (NodeName \"\") | @'NodeName' \\\"\\\"@ (graphs), @'NotCentral'@ (nodes) | | 'Circo', 'Twopi' only |
+| Rotate | rotate | G | Integ | | 0 | @0@ | | |
+| Rotation | rotation | G | Dbl | | 0 | @0@ | | 'Sfdp' only, requires Graphviz >= 2.28.0 |
+| SameHead | samehead | E | Strng | | \"\" | @\\\"\\\"@ | | 'Dot' only |
+| SameTail | sametail | E | Strng | | \"\" | @\\\"\\\"@ | | 'Dot' only |
+| SamplePoints | samplepoints | N | Integ | | | @8@ (output), @20@ (overlap and image maps) | | |
+| Scale | scale | G | Cust "DPoint" | | | | | Not 'Dot', requires Graphviz >= 2.28.0 (>= 2.38.0 for anything except 'TwoPi') |
+| SearchSize | searchsize | G | Integ | | 30 | @30@ | | 'Dot' only |
+| Sep | sep | G | Cust "DPoint" | | (DVal 4) | @'DVal' 4@ | | not 'Dot' |
+| Shape | shape | N | Cust "Shape" | | Ellipse | @'Ellipse'@ | | |
+| ShowBoxes | showboxes | ENG | Integ | | 0 | @0@ | @0@ | 'Dot' only; used for debugging by printing PostScript guide boxes |
+| Sides | sides | N | Integ | | 4 | @4@ | @0@ | |
+| Size | size | G | Cust "GraphSize" | | | | | |
+| Skew | skew | N | Dbl | | 0.0 | @0.0@ | @-100.0@ | |
+| Smoothing | smoothing | G | Cust "SmoothType" | | NoSmooth | @'NoSmooth'@ | | 'Sfdp' only |
+| SortV | sortv | GCN | Cust "Word16" | | 0 | @0@ | @0@ | |
+| Splines | splines | G | Cust "EdgeType" | SplineEdges | | @'SplineEdges'@ ('Dot'), @'LineEdges'@ (other) | | |
+| Start | start | G | Cust "StartType" | | | @'StartStyleSeed' 'RandomStyle' seed@ for some unknown fixed seed. | | 'Fdp', 'Neato' only |
+| Style | style | ENCG | Cust "[StyleItem]" | | | | | |
+| StyleSheet | stylesheet | G | Strng | | \"\" | @\\\"\\\"@ | | svg only |
+| TailURL | tailURL tailhref | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, map only |
+| Tail_LP | tail_lp | E | Cust "Point" | | | | | write only, requires Graphviz >= 2.30.0 |
+| TailClip | tailclip | E | Bl | True | True | @'True'@ | | |
+| TailLabel | taillabel | E | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ | | |
+| TailPort | tailport | E | Cust "PortPos" | | (CompassPoint CenterPoint) | @'CompassPoint' 'CenterPoint'@ | | |
+| TailTarget | tailtarget | E | EStrng | | \"\" | none | | svg, map only |
+| TailTooltip | tailtooltip | E | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
+| Target | target | ENGC | EStrng | | \"\" | none | | svg, map only |
+| Tooltip | tooltip | NEC | EStrng | | \"\" | @\\\"\\\"@ | | svg, cmap only |
+| TrueColor | truecolor | G | Bl | True | | | | bitmap output only |
+| Vertices | vertices | N | Cust "[Point]" | | | | | write only |
+| ViewPort | viewport | G | Cust "ViewPort" | | | none | | |
+| VoroMargin | voro_margin | G | Dbl | | 0.05 | @0.05@ | @0.0@ | not 'Dot' |
+| Weight | weight | E | Cust "Number" | | (Int 1) | @'Int' 1@ | @'Int' 0@ ('Dot'), @'Int' 1@ ('Neato','Fdp','Sfdp') | as of Graphviz 2.30: weights for dot need to be 'Int's |
+| Width | width | N | Dbl | | 0.75 | @0.75@ | @0.01@ | |
+| XDotVersion | xdotversion | G | Cust "Version" | | | | | xdot only, requires Graphviz >= 2.34.0, equivalent to specifying version of xdot to be used |
+| XLabel | xlabel | EN | Cust "Label" | | (StrLabel \"\") | @'StrLabel' \\\"\\\"@ | | requires Graphviz >= 2.29.0 |
+| XLP | xlp | EN | Cust "Point" | | | | | write only, requires Graphviz >= 2.29.0 |
-}
diff --git a/utils/TestParsing.hs b/utils/TestParsing.hs
--- a/utils/TestParsing.hs
+++ b/utils/TestParsing.hs
@@ -1,4 +1,4 @@
-#!/usr/bin/runhaskell
+{-# LANGUAGE MultiParamTypeClasses #-}
{- |
Module : TestParsing
@@ -14,21 +14,21 @@
-}
module Main where
-import Data.GraphViz
+import Data.GraphViz
+import Data.GraphViz.Commands.IO (hGetStrict, toUTF8)
+import Data.GraphViz.Exception
+import Data.GraphViz.Parsing (runParser)
+import Data.GraphViz.PreProcessing (preProcess)
import qualified Data.GraphViz.Types.Generalised as G
-import Data.GraphViz.Parsing(runParser)
-import Data.GraphViz.PreProcessing(preProcess)
-import Data.GraphViz.Commands.IO(hGetStrict, toUTF8)
-import Data.GraphViz.Exception
-import qualified Data.Text.Lazy as T
-import Data.Text.Lazy(Text)
+import Control.Exception (SomeException, evaluate, try)
+import Control.Monad (filterM, liftM)
import qualified Data.ByteString.Lazy as B
-import Control.Exception(try, evaluate, SomeException)
-import Control.Monad(liftM, filterM)
-import System.Directory
-import System.FilePath
-import System.Environment(getArgs)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import System.Directory
+import System.Environment (getArgs)
+import System.FilePath
-- -----------------------------------------------------------------------------
@@ -41,7 +41,7 @@
\\n\
\One way of using this file:\n\t\
\$ locate -r \".*\\.\\(gv\\|dot\\)$\" -0\
- \ | xargs -0 runhaskell TestParsing.hs"
+ \ | xargs -0 TestParsing.hs"
tryParsing [fp] = do isDir <- doesDirectoryExist fp
if isDir
then mapM_ tryParseFile =<< getDContents fp