diff --git a/Changelog b/Changelog
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,56 @@
+Changes since 2999.1.0.2
+========================
+
+A major re-write occured; these are the highlights:
+
+* Re-write parsing and printing of Dot code using the new ParseDot and
+ PrintDot classes. This should finally fix all quoting issues, as
+ well as leaving Show as the code representation for hacking
+ purposes. As part of this, the Data.GraphViz.ParserCombinators
+ module has been moved to Data.GraphViz.Types.Parsing.
+
+* Re-write the various Dot* datatypes in Data.GraphViz.Types.
+ Sub-graphs/clusters are now their own entity rather than being part
+ of DotNode and the Node ID type is now a type parameter rather than
+ being just Int. Sub-graphs/clusters can now also be parsed.
+
+* The various conversion functions in Data.GraphViz now come in two
+ flavours: the unprimed versions take in a Bool indicating if the
+ graph is directed or not; the primed versions attempt to
+ automatically detect this. Also add cluster support for the graph
+ -> dot -> graph conversion-style functions, as requested by Nikolas
+ Mayr.
+
+* Allow custom arrow types as supported by GraphViz; as requested by
+ Han Joosten.
+
+* Fixed a bug in HSV-style Color values where Int was used instead of
+ Double; spotted by Michael deLorimier.
+
+* Properly resolved the situation initially spotted by Neil Brown:
+ Matthew Sackman was following Dot terminology for an edge `a -> b'
+ when using "head" for `b' and "tail" for `a' (this is presumably
+ because the head/tail of the arrow are at those nodes). DotEdge now
+ uses "from" and "to" avoid ambiguity; the various Attribute values
+ still follow upstream usage.
+
+Changes since 2999.1.0.1
+========================
+
+* Fix a bug spotted by Srihari Ramanathan where Color values were
+ double-quoted.
+
+Changes since 2999.1.0.0
+========================
+
+* The Color Attribute should take [Color], not just a single Color.
+
+Changes since 2999.0.0.0
+========================
+
+* Stop using Either for composite Attributes and use a custom type:
+ this avoids problems with the Show instance.
+
Changes since 2009.5.1
======================
diff --git a/Data/GraphViz.hs b/Data/GraphViz.hs
--- a/Data/GraphViz.hs
+++ b/Data/GraphViz.hs
@@ -6,22 +6,44 @@
Maintainer : Ivan.Miljenovic@gmail.com
This is the top-level module for the graphviz library. It provides
- functions to convert 'Data.Graph.Inductive.Graph.Graph's into
- the /Dot/ language used by the /GraphViz/ program (as well as a
- limited ability to perform the reverse operation).
+ functions to convert 'Data.Graph.Inductive.Graph.Graph's into the
+ /Dot/ language used by the /GraphViz/ suite of programs (as well as
+ a limited ability to perform the reverse operation).
Information about GraphViz and the Dot language can be found at:
- -}
+ Commands for converting graphs to Dot format have two options: one
+ in which the user specifies whether the graph is directed or
+ undirected, and a primed version which attempts to automatically
+ infer if the graph is directed or not. Note that these conversion
+ functions assume that undirected graphs have every edge being
+ duplicated (or at least that if there exists an edge from /n1/ to
+ /n2/, then /n1 <= n2/).
+ -}
module Data.GraphViz
- ( graphToDot
- , clusterGraphToDot
- , graphToGraph
- , dotizeGraph
+ ( -- * Conversion from graphs to /Dot/ format.
+ graphToDot
+ , graphToDot'
+ -- ** Conversion with support for clusters.
, NodeCluster(..)
+ , clusterGraphToDot
+ , clusterGraphToDot'
+ -- * Passing the graph through GraphViz.
+ -- ** Type aliases for @Node@ and @Edge@ labels.
, AttributeNode
, AttributeEdge
+ -- ** For normal graphs.
+ , graphToGraph
+ , graphToGraph'
+ , dotizeGraph
+ , dotizeGraph'
+ -- ** For clustered graphs.
+ , clusterGraphToGraph
+ , clusterGraphToGraph'
+ , dotizeClusterGraph
+ , dotizeClusterGraph'
+ -- * Re-exporting other modules.
, module Data.GraphViz.Types
, module Data.GraphViz.Attributes
, module Data.GraphViz.Commands
@@ -31,110 +53,239 @@
import Data.GraphViz.Types.Clustering
import Data.GraphViz.Attributes
import Data.GraphViz.Commands
-import Data.GraphViz.ParserCombinators(runParser)
import Data.Graph.Inductive.Graph
import qualified Data.Set as Set
import Control.Arrow((&&&))
-import Data.Maybe
+import Data.Maybe(mapMaybe, fromJust)
import qualified Data.Map as Map
import System.IO(hGetContents)
import System.IO.Unsafe(unsafePerformIO)
-- -----------------------------------------------------------------------------
--- | Determine if the given graph is undirected or directed.
-isUndir :: (Ord b, Graph g) => g a b -> Bool
-isUndir g = all hasFlip es
+-- | Determine if the given graph is undirected.
+isUndirected :: (Ord b, Graph g) => g a b -> Bool
+isUndirected g = all hasFlip es
where
es = labEdges g
eSet = Set.fromList es
hasFlip e = Set.member (flippedEdge e) eSet
flippedEdge (f,t,l) = (t,f,l)
+-- | Determine if the given graph is directed.
+isDirected :: (Ord b, Graph g) => g a b -> Bool
+isDirected = not . isUndirected
+
-- -----------------------------------------------------------------------------
--- | Convert a graph to GraphViz's /Dot/ format.
-graphToDot :: (Ord b, Graph gr) => gr a b -> [Attribute]
- -> (LNode a -> [Attribute]) -> (LEdge b -> [Attribute]) -> DotGraph
-graphToDot graph gAttributes fmtNode fmtEdge
- = clusterGraphToDot graph gAttributes clusterBy fmtCluster fmtNode fmtEdge
+-- | Convert a graph to GraphViz's /Dot/ format. The 'Bool' value is
+-- 'True' for directed graphs, 'False' otherwise.
+graphToDot :: (Graph gr) => Bool -> gr a b -> [GlobalAttributes]
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> DotGraph Node
+graphToDot isDir graph gAttributes
+ = clusterGraphToDot isDir graph gAttributes clustBy cID fmtClust
where
- clusterBy :: LNode a -> NodeCluster () a
- clusterBy = N
- fmtCluster _ = []
+ clustBy :: LNode a -> NodeCluster () a
+ clustBy = N
+ cID = const Nothing
+ fmtClust = const []
+-- | Convert a graph to GraphViz's /Dot/ format with automatic
+-- direction detection.
+graphToDot' :: (Ord b, Graph gr) => gr a b -> [GlobalAttributes]
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> DotGraph Node
+graphToDot' graph = graphToDot (isDirected graph) graph
+
-- | Convert a graph to /Dot/ format, using the specified clustering function
-- to group nodes into clusters.
-- Clusters can be nested to arbitrary depth.
-clusterGraphToDot :: (Ord c, Ord b, Graph gr) => gr a b
- -> [Attribute] -> (LNode a -> NodeCluster c a)
- -> (c -> [Attribute]) -> (LNode a -> [Attribute])
- -> (LEdge b -> [Attribute]) -> DotGraph
-clusterGraphToDot graph gAttrs clusterBy fmtCluster fmtNode fmtEdge
+-- The 'Bool' argument is 'True' for directed graphs, 'False' otherwise.
+clusterGraphToDot :: (Ord c, Graph gr) => Bool -> gr a b
+ -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)
+ -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> DotGraph Node
+clusterGraphToDot dirGraph graph gAttrs clusterBy cID fmtCluster fmtNode fmtEdge
= DotGraph { strictGraph = False
, directedGraph = dirGraph
, graphID = Nothing
- , graphAttributes = gAttrs
- , graphNodes = ns
- , graphEdges = es
+ , graphStatements = stmts
}
where
- dirGraph = not $ isUndir graph
- ns = clustersToNodes clusterBy fmtCluster fmtNode graph
+ stmts = DotStmts { attrStmts = gAttrs
+ , subGraphs = cs
+ , nodeStmts = ns
+ , edgeStmts = es
+ }
+ (cs, ns) = clustersToNodes clusterBy cID fmtCluster fmtNode graph
es = mapMaybe mkDotEdge . labEdges $ graph
mkDotEdge e@(f,t,_) = if dirGraph || f <= t
- then Just DotEdge {edgeHeadNodeID = f
- ,edgeTailNodeID = t
- ,edgeAttributes = fmtEdge e
- ,directedEdge = dirGraph}
+ then Just DotEdge { edgeFromNodeID = f
+ , edgeToNodeID = t
+ , edgeAttributes = fmtEdge e
+ , directedEdge = dirGraph
+ }
else Nothing
+-- | Convert a graph to /Dot/ format, using the specified clustering function
+-- to group nodes into clusters.
+-- Clusters can be nested to arbitrary depth.
+-- Graph direction is automatically inferred.
+clusterGraphToDot' :: (Ord c, Ord b, Graph gr) => gr a b
+ -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)
+ -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> DotGraph Node
+clusterGraphToDot' gr = clusterGraphToDot (isDirected gr) gr
+
-- -----------------------------------------------------------------------------
-type AttributeNode a = ([Attribute], a)
-type AttributeEdge b = ([Attribute], b)
+type AttributeNode a = (Attributes, a)
+type AttributeEdge b = (Attributes, b)
--- | Run the graph via dot to get positional information and then
--- combine that information back into the original graph.
--- Note that this doesn't support graphs with clusters.
-graphToGraph :: (Ord b, Graph gr) => gr a b -> [Attribute]
- -> (LNode a -> [Attribute]) -> (LEdge b -> [Attribute])
+-- | Run the appropriate GraphViz command on the graph to get
+-- positional information and then combine that information back
+-- into the original graph. Note that for the edge information to
+-- be parsed properly when using multiple edges, each edge between
+-- two nodes needs to have a unique label.
+--
+-- The 'Bool' argument is 'True' for directed graphs, 'False'
+-- otherwise. Directed graphs are passed through /dot/, and
+-- undirected graphs through /neato/.
+graphToGraph :: (Graph gr) => Bool -> gr a b -> [GlobalAttributes]
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
-> IO (gr (AttributeNode a) (AttributeEdge b))
-graphToGraph gr gAttributes fmtNode fmtEdge
+graphToGraph isDir gr gAttributes fmtNode fmtEdge
+ = dotAttributes isDir gr dot
+ where
+ dot = graphToDot isDir gr gAttributes fmtNode fmtEdge
+
+dotAttributes :: (Graph gr) => Bool -> gr a b -> DotGraph Node
+ -> IO (gr (AttributeNode a) (AttributeEdge b))
+dotAttributes isDir gr dot
= do output <- graphvizWithHandle command dot DotOutput hGetContents
let res = fromJust output
length res `seq` return ()
return $ rebuildGraphWithAttributes res
where
- undirected = isUndir gr
- command = if undirected then undirCommand else dirCommand
- dot = graphToDot gr gAttributes fmtNode fmtEdge
+ command = if isDir then dirCommand else undirCommand
rebuildGraphWithAttributes dotResult = mkGraph lnodes ledges
where
lnodes = map (\(n, l) -> (n, (fromJust $ Map.lookup n nodeMap, l)))
$ labNodes gr
ledges = map createEdges $ labEdges gr
- createEdges (f, t, l) = if undirected && f > t
- then (f, t, getLabel (t,f))
- else (f, t, getLabel (f,t))
+ createEdges (f, t, l) = if isDir || f <= t
+ then (f, t, getLabel (f,t))
+ else (f, t, getLabel (t,f))
where
getLabel c = (fromJust $ Map.lookup c edgeMap, l)
- DotGraph { graphNodes = ns, graphEdges = es}
- = fst . runParser parseDotGraph $ dotResult
+ g' = parseDotGraph dotResult
+ ns = graphNodes g'
+ es = graphEdges g'
nodeMap = Map.fromList $ map (nodeID &&& nodeAttributes) ns
- edgeMap = Map.fromList $ map (\e -> ( ( edgeTailNodeID e
- , edgeHeadNodeID e)
- , edgeAttributes e)
- ) es
+ edgeMap = Map.fromList $ map ( (edgeFromNodeID &&& edgeToNodeID)
+ &&& edgeAttributes) es
--- | Pass the plain graph through 'graphToGraph'. This is an @IO@ action,
--- however since the state doesn't change it's safe to use 'unsafePerformIO'
--- to convert this to a normal function.
-dotizeGraph :: (DynGraph gr, Ord b) => gr a b
- -> gr (AttributeNode a) (AttributeEdge b)
-dotizeGraph g = unsafePerformIO
- $ graphToGraph g gAttrs noAttrs noAttrs
+-- | Run the appropriate GraphViz command on the graph to get
+-- positional information and then combine that information back
+-- into the original graph.
+--
+-- Graph direction is automatically inferred.
+graphToGraph' :: (Ord b, Graph gr) => gr a b -> [GlobalAttributes]
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> IO (gr (AttributeNode a) (AttributeEdge b))
+graphToGraph' gr = graphToGraph (isDirected gr) gr
+
+-- | Run the appropriate GraphViz command on the clustered graph to
+-- get positional information and then combine that information back
+-- into the original graph. Note that for the edge information to
+-- be parsed properly when using multiple edges, each edge between
+-- two nodes needs to have a unique label.
+--
+-- The 'Bool' argument is 'True' for directed graphs, 'False'
+-- otherwise. Directed graphs are passed through /dot/, and
+-- undirected graphs through /neato/.
+clusterGraphToGraph :: (Ord c, Graph gr) => Bool -> gr a b
+ -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)
+ -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> IO (gr (AttributeNode a) (AttributeEdge b))
+clusterGraphToGraph isDir gr gAtts clBy cID fmtClust fmtNode fmtEdge
+ = dotAttributes isDir gr dot
where
+ dot = clusterGraphToDot isDir gr gAtts clBy cID fmtClust fmtNode fmtEdge
+
+-- | Run the appropriate GraphViz command on the clustered graph to
+-- get positional information and then combine that information back
+-- into the original graph.
+--
+-- Graph direction is automatically inferred.
+clusterGraphToGraph' :: (Ord b, Ord c, Graph gr) => gr a b
+ -> [GlobalAttributes] -> (LNode a -> NodeCluster c a)
+ -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> (LEdge b -> Attributes)
+ -> IO (gr (AttributeNode a) (AttributeEdge b))
+clusterGraphToGraph' gr = clusterGraphToGraph (isDirected gr) gr
+
+
+-- | Pass the graph through 'graphToGraph' with no 'Attribute's. This
+-- is an @'IO'@ action, however since the state doesn't change it's
+-- safe to use 'unsafePerformIO' to convert this to a normal
+-- function.
+--
+-- The 'Bool' argument is 'True' for directed graphs, 'False'
+-- otherwise. Directed graphs are passed through /dot/, and
+-- undirected graphs through /neato/.
+dotizeGraph :: (Graph gr) => Bool -> gr a b
+ -> gr (AttributeNode a) (AttributeEdge b)
+dotizeGraph isDir g = unsafePerformIO
+ $ graphToGraph isDir g gAttrs noAttrs noAttrs
+ where
gAttrs = []
noAttrs = const []
+
+-- | Pass the graph through 'graphToGraph' with no 'Attribute's. This
+-- is an @'IO'@ action, however since the state doesn't change it's
+-- safe to use 'unsafePerformIO' to convert this to a normal
+-- function.
+--
+-- The graph direction is automatically inferred.
+dotizeGraph' :: (Graph gr, Ord b) => gr a b
+ -> gr (AttributeNode a) (AttributeEdge b)
+dotizeGraph' g = dotizeGraph (isDirected g) g
+
+-- | Pass the clustered graph through 'clusterGraphToGraph' with no
+-- 'Attribute's. This is an @'IO'@ action, however since the state
+-- doesn't change it's safe to use 'unsafePerformIO' to convert this
+-- to a normal function.
+--
+-- The 'Bool' argument is 'True' for directed graphs, 'False'
+-- otherwise. Directed graphs are passed through /dot/, and
+-- undirected graphs through /neato/.
+dotizeClusterGraph :: (Ord c, Graph gr) => Bool -> gr a b
+ -> (LNode a -> NodeCluster c a)
+ -> gr (AttributeNode a) (AttributeEdge b)
+dotizeClusterGraph isDir g clustBy = unsafePerformIO
+ $ clusterGraphToGraph isDir g
+ gAttrs clustBy
+ cID cAttrs
+ noAttrs noAttrs
+ where
+ gAttrs = []
+ cID = const Nothing
+ cAttrs = const gAttrs
+ noAttrs = const []
+
+-- | Pass the clustered graph through 'graphToGraph' with no
+-- 'Attribute's. This is an @'IO'@ action, however since the state
+-- doesn't change it's safe to use 'unsafePerformIO' to convert this
+-- to a normal function.
+--
+-- The graph direction is automatically inferred.
+dotizeClusterGraph' :: (Ord b, Ord c, Graph gr) => gr a b
+ -> (LNode a -> NodeCluster c a)
+ -> gr (AttributeNode a) (AttributeEdge b)
+dotizeClusterGraph' g = dotizeClusterGraph (isDirected g) g
diff --git a/Data/GraphViz/Attributes.hs b/Data/GraphViz/Attributes.hs
--- a/Data/GraphViz/Attributes.hs
+++ b/Data/GraphViz/Attributes.hs
@@ -8,1852 +8,2198 @@
This module defines the various attributes that different parts of
a GraphViz graph can have. These attributes are based on the
documentation found at:
-
-
-
- For more information on usage, etc. please see that document.
-
- A summary of known current constraints\/limitations\/differences:
-
- * Parsing of quoted strings might not always work if they are a
- sub-part of another Attribute (e.g. a quoted name in 'LayerList').
- In fact, parsing with quotes is iffy for everything; specifically
- when they are and aren't allowed.
-
- * 'ColorScheme' is ignored when parsing 'Color' values
-
- * ColorList and PointfList are defined as actual lists (but
- 'LayerList' is not).
-
- * A lot of values have a possible value of @"none"@. These now
- have custom constructors. In fact, most constructors have been
- expanded upon to give an idea of what they represent rather than
- using generic terms.
-
- * @PointF@ and 'Point' have been combined, and feature support for pure
- 'Int'-based co-ordinates as well as 'Double' ones (i.e. no floating
- point-only points for Point). The optional '!' and third value
- for Point are not available.
-
- * 'Rect' uses two 'Point' values to denote the lower-left and
- top-right corners.
-
- * The two 'LabelLoc' attributes have been combined.
-
- * The defined 'LayerSep' is not used to parse 'LayerRange' or
- 'LayerList'; the default (@[' ', ':', '\t']@) is instead used.
-
- * @SplineType@ has been replaced with @['Spline']@.
-
- * Only polygon-based 'Shape's are available.
-
- * Device-dependent 'StyleName' values are not available.
-
- * 'PortPos' only has the 'CompassPoint' option, not
- @PortName[:CompassPoint]@ (since record shapes aren't allowed,
- and parsing HTML-like labels could be problematic).
-
- * Not every 'Attribute' is fully documented/described. In
- particular, a lot of them are listed as having a 'String' value,
- when actually only certain Strings are allowed.
-
- * Deprecated 'Overlap' algorithms are not defined.
-
- -}
-
-module Data.GraphViz.Attributes where
-
-import Data.GraphViz.ParserCombinators
-
-import Data.Char(isDigit, isHexDigit)
-import Data.Word
-import Numeric
-import Control.Monad
-import Data.Maybe
-
--- -----------------------------------------------------------------------------
-
-{- |
-
- These attributes have been implemented in a /permissive/ manner:
- that is, rather than split them up based on which type of value
- they are allowed, they have all been included in the one data type,
- with functions to determine if they are indeed valid for what
- they're being applied to.
-
- To interpret the /Valid for/ listings:
-
- [@G@] Valid for Graphs.
-
- [@C@] Valid for Clusters.
-
- [@S@] Valid for Sub-Graphs (and also Clusters).
-
- [@N@] Valid for Nodes.
-
- [@E@] Valid for Edges.
-
- Note also that the default values are taken from the specification
- page listed above, and might not correspond fully with the names of
- the permitted values.
--}
-data Attribute
- = Damping Double -- ^ /Valid for/: G; /Default/: 0.99; /Minimum/: 0.0; /Notes/: neato only
- | K Double -- ^ /Valid for/: GC; /Default/: 0.3; /Minimum/: 0; /Notes/: sfdp, fdp only
- | URL URL -- ^ /Valid for/: ENGC; /Default/: \; /Notes/: svg, postscript, map only
- | ArrowHead ArrowType -- ^ /Valid for/: E; /Default/: Normal
- | ArrowSize Double -- ^ /Valid for/: E; /Default/: 1.0; /Minimum/: 0.0
- | ArrowTail ArrowType -- ^ /Valid for/: E; /Default/: Normal
- | Aspect AspectType -- ^ /Valid for/: G; /Notes/: dot only
- | Bb Rect -- ^ /Valid for/: G; /Notes/: write only
- | BgColor Color -- ^ /Valid for/: GC; /Default/: \
- | Center Bool -- ^ /Valid for/: G; /Default/: false
- | Charset String -- ^ /Valid for/: G; /Default/: \"UTF-8\"
- | ClusterRank ClusterMode -- ^ /Valid for/: G; /Default/: local; /Notes/: dot only
- | Color [Color] -- ^ /Valid for/: ENC; /Default/: black
- | ColorScheme String -- ^ /Valid for/: ENCG; /Default/: \"\"
- | Comment String -- ^ /Valid for/: ENG; /Default/: \"\"
- | Compound Bool -- ^ /Valid for/: G; /Default/: false; /Notes/: dot only
- | Concentrate Bool -- ^ /Valid for/: G; /Default/: false
- | Constraint Bool -- ^ /Valid for/: E; /Default/: true; /Notes/: dot only
- | Decorate Bool -- ^ /Valid for/: E; /Default/: false
- | DefaultDist Double -- ^ /Valid for/: G; /Default/: 1+(avg. len)*sqrt(|V|); /Minimum/: epsilon; /Notes/: neato only
- | Dim Int -- ^ /Valid for/: G; /Default/: 2; /Minimum/: 2; /Notes/: sfdp, fdp, neato only
- | Dimen Int -- ^ /Valid for/: G; /Default/: 2; /Minimum/: 2; /Notes/: sfdp, fdp, neato only
- | Dir DirType -- ^ /Valid for/: E; /Default/: forward(directed)/none(undirected)
- | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: false; /Notes/: neato only
- | Distortion Double -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: -100.0
- | DPI Double -- ^ /Valid for/: G; /Default/: 96.0 | 0.0; /Notes/: svg, bitmap output only
- | EdgeURL URL -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only
- | EdgeTarget String -- ^ /Valid for/: E; /Default/: \; /Notes/: svg, map only
- | EdgeTooltip String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only
- | Epsilon Double -- ^ /Valid for/: G; /Default/: .0001 * # nodes(mode == KK) | .0001(mode == major); /Notes/: neato only
- | ESep DPoint -- ^ /Valid for/: G; /Default/: +3; /Notes/: not dot
- | FillColor Color -- ^ /Valid for/: NC; /Default/: lightgrey(nodes) | black(clusters)
- | FixedSize Bool -- ^ /Valid for/: N; /Default/: false
- | FontColor Color -- ^ /Valid for/: ENGC; /Default/: black
- | FontName String -- ^ /Valid for/: ENGC; /Default/: \"Times-Roman\"
- | FontNames String -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: svg only
- | FontPath String -- ^ /Valid for/: G; /Default/: system-dependent
- | FontSize Double -- ^ /Valid for/: ENGC; /Default/: 14.0; /Minimum/: 1.0
- | Group String -- ^ /Valid for/: N; /Default/: \"\"; /Notes/: dot only
- | HeadURL URL -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only
- | HeadClip Bool -- ^ /Valid for/: E; /Default/: true
- | HeadLabel Label -- ^ /Valid for/: E; /Default/: \"\"
- | HeadPort PortPos -- ^ /Valid for/: E; /Default/: center
- | HeadTarget QuotedString -- ^ /Valid for/: E; /Default/: \; /Notes/: svg, map only
- | HeadTooltip QuotedString -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only
- | Height Double -- ^ /Valid for/: N; /Default/: 0.5; /Minimum/: 0.02
- | ID Label -- ^ /Valid for/: GNE; /Default/: \"\"; /Notes/: svg, postscript, map only
- | Image String -- ^ /Valid for/: N; /Default/: \"\"
- | ImageScale ScaleType -- ^ /Valid for/: N; /Default/: false
- | Label Label -- ^ /Valid for/: ENGC; /Default/: \"\N\" (nodes) Nothing | \"\" (otherwise) Nothing
- | LabelURL URL -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only
- | LabelAngle Double -- ^ /Valid for/: E; /Default/: -25.0; /Minimum/: -180.0
- | LabelDistance Double -- ^ /Valid for/: E; /Default/: 1.0; /Minimum/: 0.0
- | LabelFloat Bool -- ^ /Valid for/: E; /Default/: false
- | LabelFontColor Color -- ^ /Valid for/: E; /Default/: black
- | LabelFontName String -- ^ /Valid for/: E; /Default/: \"Times-Roman\"
- | LabelFontSize Double -- ^ /Valid for/: E; /Default/: 14.0; /Minimum/: 1.0
- | LabelJust Justification -- ^ /Valid for/: GC; /Default/: \"c\"
- | LabelLoc VerticalPlacement -- ^ /Valid for/: GCN; /Default/: \"t\"(clusters) | \"b\"(root graphs) | \"c\"(clusters)
- | LabelTarget String -- ^ /Valid for/: E; /Default/: \; /Notes/: svg, map only
- | LabelTooltip String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only
- | Landscape Bool -- ^ /Valid for/: G; /Default/: false
- | Layer LayerRange -- ^ /Valid for/: EN; /Default/: \"\"
- | Layers LayerList -- ^ /Valid for/: G; /Default/: \"\"
- | LayerSep String -- ^ /Valid for/: G; /Default/: \" :\t\"
- | Layout String -- ^ /Valid for/: G; /Default/: \"\"
- | Len Double -- ^ /Valid for/: E; /Default/: 1.0(neato)/0.3(fdp); /Notes/: fdp, neato only
- | Levels Int -- ^ /Valid for/: G; /Default/: MAXINT; /Minimum/: 0.0; /Notes/: sfdp only
- | LevelsGap Double -- ^ /Valid for/: G; /Default/: 0.0; /Notes/: neato only
- | LHead String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only
- | LP Point -- ^ /Valid for/: EGC; /Notes/: write only
- | LTail String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only
- | Margin DPoint -- ^ /Valid for/: NG; /Default/: \
- | MaxIter Int -- ^ /Valid for/: G; /Default/: 100 * # nodes(mode == KK) | 200(mode == major) | 600(fdp); /Notes/: fdp, neato only
- | MCLimit Double -- ^ /Valid for/: G; /Default/: 1.0; /Notes/: dot only
- | MinDist Double -- ^ /Valid for/: G; /Default/: 1.0; /Minimum/: 0.0; /Notes/: circo only
- | MinLen Int -- ^ /Valid for/: E; /Default/: 1; /Minimum/: 0; /Notes/: dot only
- | Mode String -- ^ /Valid for/: G; /Default/: \"major\"; /Notes/: neato only
- | Model String -- ^ /Valid for/: G; /Default/: \"shortpath\"; /Notes/: neato only
- | Mosek Bool -- ^ /Valid for/: G; /Default/: false; /Notes/: neato only; requires the Mosek software
- | NodeSep Double -- ^ /Valid for/: G; /Default/: 0.25; /Minimum/: 0.02; /Notes/: dot only
- | NoJustify Bool -- ^ /Valid for/: GCNE; /Default/: false
- | Normalize Bool -- ^ /Valid for/: G; /Default/: false; /Notes/: not dot
- | Nslimit Double -- ^ /Valid for/: G; /Notes/: dot only
- | Nslimit1 Double -- ^ /Valid for/: G; /Notes/: dot only
- | Ordering String -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: dot only
- | Orientation Double -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: 360.0
- | OrientationGraph String -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: Landscape if \"[lL]*\" and rotate not defined
- | OutputOrder OutputMode -- ^ /Valid for/: G; /Default/: breadthfirst
- | Overlap Overlap -- ^ /Valid for/: G; /Default/: true; /Notes/: not dot
- | OverlapScaling Double -- ^ /Valid for/: G; /Default/: -4; /Minimum/: -1.0e10; /Notes/: prism only
- | Pack Pack -- ^ /Valid for/: G; /Default/: false; /Notes/: not dot
- | PackMode PackMode -- ^ /Valid for/: G; /Default/: node; /Notes/: not dot
- | Pad DPoint -- ^ /Valid for/: G; /Default/: 0.0555 (4 points)
- | Page Point -- ^ /Valid for/: G
- | PageDir PageDir -- ^ /Valid for/: G; /Default/: BL
- | PenColor Color -- ^ /Valid for/: C; /Default/: black
- | PenWidth Double -- ^ /Valid for/: CNE; /Default/: 1.0; /Minimum/: 0.0
- | Peripheries Int -- ^ /Valid for/: NC; /Default/: shape default(nodes) | 1(clusters); /Minimum/: 0
- | Pin Bool -- ^ /Valid for/: N; /Default/: false; /Notes/: fdp, neato only
- | Pos Pos -- ^ /Valid for/: EN
- | QuadTree QuadType -- ^ /Valid for/: G; /Default/: \"normal\"; /Notes/: sfdp only
- | Quantum Double -- ^ /Valid for/: G; /Default/: 0.0; /Minimum/: 0.0
- | Rank RankType -- ^ /Valid for/: S; /Notes/: dot only
- | RankDir RankDir -- ^ /Valid for/: G; /Default/: TB; /Notes/: dot only
- | Ranksep Double -- ^ /Valid for/: G; /Default/: 0.5(dot) | 1.0(twopi); /Minimum/: 0.02; /Notes/: twopi, dot only
- | Ratio Ratios -- ^ /Valid for/: G
- | Rects Rect -- ^ /Valid for/: N; /Notes/: write only
- | Regular Bool -- ^ /Valid for/: N; /Default/: false
- | ReMinCross Bool -- ^ /Valid for/: G; /Default/: false; /Notes/: dot only
- | RepulsiveForce Double -- ^ /Valid for/: G; /Default/: 1.0; /Minimum/: 0.0; /Notes/: sfdp only
- | Resolution Double -- ^ /Valid for/: G; /Default/: 96.0 | 0.0; /Notes/: svg, bitmap output only
- | Root Root -- ^ /Valid for/: GN; /Default/: \"\"(graphs) | false(nodes); /Notes/: circo, twopi only
- | Rotate Int -- ^ /Valid for/: G; /Default/: 0
- | SameHead String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only
- | SameTail String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only
- | SamplePoints Int -- ^ /Valid for/: N; /Default/: 8(output) | 20(overlap and image maps)
- | SearchSize Int -- ^ /Valid for/: G; /Default/: 30; /Notes/: dot only
- | Sep DPoint -- ^ /Valid for/: G; /Default/: +4; /Notes/: not dot
- | Shape Shape -- ^ /Valid for/: N; /Default/: ellipse
- | ShapeFile String -- ^ /Valid for/: N; /Default/: \"\"
- | ShowBoxes Int -- ^ /Valid for/: ENG; /Default/: 0; /Minimum/: 0; /Notes/: dot only
- | Sides Int -- ^ /Valid for/: N; /Default/: 4; /Minimum/: 0
- | Size Point -- ^ /Valid for/: G
- | Skew Double -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: -100.0
- | Smoothing SmoothType -- ^ /Valid for/: G; /Default/: \"none\"; /Notes/: sfdp only
- | SortV Int -- ^ /Valid for/: GCN; /Default/: 0; /Minimum/: 0
- | Splines EdgeType -- ^ /Valid for/: G
- | Start StartType -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: fdp, neato only
- | Style Style -- ^ /Valid for/: ENC
- | StyleSheet String -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: svg only
- | TailURL URL -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only
- | TailClip Bool -- ^ /Valid for/: E; /Default/: true
- | TailLabel Label -- ^ /Valid for/: E; /Default/: \"\"
- | TailPort PortPos -- ^ /Valid for/: E; /Default/: center
- | TailTarget String -- ^ /Valid for/: E; /Default/: \; /Notes/: svg, map only
- | TailTooltip String -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only
- | Target String -- ^ /Valid for/: ENGC; /Default/: \; /Notes/: svg, map only
- | Tooltip String -- ^ /Valid for/: NEC; /Default/: \"\"; /Notes/: svg, cmap only
- | TrueColor Bool -- ^ /Valid for/: G; /Notes/: bitmap output only
- | Vertices [Point] -- ^ /Valid for/: N; /Notes/: write only
- | ViewPort ViewPort -- ^ /Valid for/: G; /Default/: \"\"
- | VoroMargin Double -- ^ /Valid for/: G; /Default/: 0.05; /Minimum/: 0.0; /Notes/: not dot
- | Weight Double -- ^ /Valid for/: E; /Default/: 1.0; /Minimum/: 0(dot) | 1(neato,fdp,sfdp)
- | Width Double -- ^ /Valid for/: N; /Default/: 0.75; /Minimum/: 0.01
- | Z Double -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: -MAXFLOAT | -1000
- deriving (Eq, Read)
-
-instance Show Attribute where
- show (Damping v) = "Damping=" ++ show v
- show (K v) = "K=" ++ show v
- show (URL v) = "URL=" ++ show v
- show (ArrowHead v) = "arrowhead=" ++ show v
- show (ArrowSize v) = "arrowsize=" ++ show v
- show (ArrowTail v) = "arrowtail=" ++ show v
- show (Aspect v) = "aspect=" ++ show v
- show (Bb v) = "bb=" ++ show v
- show (BgColor v) = "bgcolor=" ++ show v
- show (Center v) = "center=" ++ show v
- show (Charset v) = "charset=" ++ v
- show (ClusterRank v) = "clusterrank=" ++ show v
- show (Color v) = "color=" ++ show v
- show (ColorScheme v) = "colorscheme=" ++ v
- show (Comment v) = "comment=" ++ v
- show (Compound v) = "compound=" ++ show v
- show (Concentrate v) = "concentrate=" ++ show v
- show (Constraint v) = "constraint=" ++ show v
- show (Decorate v) = "decorate=" ++ show v
- show (DefaultDist v) = "defaultdist=" ++ show v
- show (Dim v) = "dim=" ++ show v
- show (Dimen v) = "dimen=" ++ show v
- show (Dir v) = "dir=" ++ show v
- show (DirEdgeConstraints v) = "diredgeconstraints=" ++ show v
- show (Distortion v) = "distortion=" ++ show v
- show (DPI v) = "dpi=" ++ show v
- show (EdgeURL v) = "edgeURL=" ++ show v
- show (EdgeTarget v) = "edgetarget=" ++ v
- show (EdgeTooltip v) = "edgetooltip=" ++ v
- show (Epsilon v) = "epsilon=" ++ show v
- show (ESep v) = "esep=" ++ show v
- show (FillColor v) = "fillcolor=" ++ show v
- show (FixedSize v) = "fixedsize=" ++ show v
- show (FontColor v) = "fontcolor=" ++ show v
- show (FontName v) = "fontname=" ++ v
- show (FontNames v) = "fontnames=" ++ v
- show (FontPath v) = "fontpath=" ++ v
- show (FontSize v) = "fontsize=" ++ show v
- show (Group v) = "group=" ++ v
- show (HeadURL v) = "headURL=" ++ show v
- show (HeadClip v) = "headclip=" ++ show v
- show (HeadLabel v) = "headlabel=" ++ show v
- show (HeadPort v) = "headport=" ++ show v
- show (HeadTarget v) = "headtarget=" ++ show v
- show (HeadTooltip v) = "headtooltip=" ++ show v
- show (Height v) = "height=" ++ show v
- show (ID v) = "id=" ++ show v
- show (Image v) = "image=" ++ v
- show (ImageScale v) = "imagescale=" ++ show v
- show (Label v) = "label=" ++ show v
- show (LabelURL v) = "labelURL=" ++ show v
- show (LabelAngle v) = "labelangle=" ++ show v
- show (LabelDistance v) = "labeldistance=" ++ show v
- show (LabelFloat v) = "labelfloat=" ++ show v
- show (LabelFontColor v) = "labelfontcolor=" ++ show v
- show (LabelFontName v) = "labelfontname=" ++ v
- show (LabelFontSize v) = "labelfontsize=" ++ show v
- show (LabelJust v) = "labeljust=" ++ show v
- show (LabelLoc v) = "labelloc=" ++ show v
- show (LabelTarget v) = "labeltarget=" ++ v
- show (LabelTooltip v) = "labeltooltip=" ++ v
- show (Landscape v) = "landscape=" ++ show v
- show (Layer v) = "layer=" ++ show v
- show (Layers v) = "layers=" ++ show v
- show (LayerSep v) = "layersep=" ++ v
- show (Layout v) = "layout=" ++ v
- show (Len v) = "len=" ++ show v
- show (Levels v) = "levels=" ++ show v
- show (LevelsGap v) = "levelsgap=" ++ show v
- show (LHead v) = "lhead=" ++ v
- show (LP v) = "lp=" ++ show v
- show (LTail v) = "ltail=" ++ v
- show (Margin v) = "margin=" ++ show v
- show (MaxIter v) = "maxiter=" ++ show v
- show (MCLimit v) = "mclimit=" ++ show v
- show (MinDist v) = "mindist=" ++ show v
- show (MinLen v) = "minlen=" ++ show v
- show (Mode v) = "mode=" ++ v
- show (Model v) = "model=" ++ v
- show (Mosek v) = "mosek=" ++ show v
- show (NodeSep v) = "nodesep=" ++ show v
- show (NoJustify v) = "nojustify=" ++ show v
- show (Normalize v) = "normalize=" ++ show v
- show (Nslimit v) = "nslimit=" ++ show v
- show (Nslimit1 v) = "nslimit1=" ++ show v
- show (Ordering v) = "ordering=" ++ v
- show (Orientation v) = "orientation=" ++ show v
- show (OrientationGraph v) = "orientation=" ++ v
- show (OutputOrder v) = "outputorder=" ++ show v
- show (Overlap v) = "overlap=" ++ show v
- show (OverlapScaling v) = "overlap_scaling=" ++ show v
- show (Pack v) = "pack=" ++ show v
- show (PackMode v) = "packmode=" ++ show v
- show (Pad v) = "pad=" ++ show v
- show (Page v) = "page=" ++ show v
- show (PageDir v) = "pagedir=" ++ show v
- show (PenColor v) = "pencolor=" ++ show v
- show (PenWidth v) = "penwidth=" ++ show v
- show (Peripheries v) = "peripheries=" ++ show v
- show (Pin v) = "pin=" ++ show v
- show (Pos v) = "pos=" ++ show v
- show (QuadTree v) = "quadtree=" ++ show v
- show (Quantum v) = "quantum=" ++ show v
- show (Rank v) = "rank=" ++ show v
- show (RankDir v) = "rankdir=" ++ show v
- show (Ranksep v) = "ranksep=" ++ show v
- show (Ratio v) = "ratio=" ++ show v
- show (Rects v) = "rects=" ++ show v
- show (Regular v) = "regular=" ++ show v
- show (ReMinCross v) = "remincross=" ++ show v
- show (RepulsiveForce v) = "repulsiveforce=" ++ show v
- show (Resolution v) = "resolution=" ++ show v
- show (Root v) = "root=" ++ show v
- show (Rotate v) = "rotate=" ++ show v
- show (SameHead v) = "samehead=" ++ v
- show (SameTail v) = "sametail=" ++ v
- show (SamplePoints v) = "samplepoints=" ++ show v
- show (SearchSize v) = "searchsize=" ++ show v
- show (Sep v) = "sep=" ++ show v
- show (Shape v) = "shape=" ++ show v
- show (ShapeFile v) = "shapefile=" ++ v
- show (ShowBoxes v) = "showboxes=" ++ show v
- show (Sides v) = "sides=" ++ show v
- show (Size v) = "size=" ++ show v
- show (Skew v) = "skew=" ++ show v
- show (Smoothing v) = "smoothing=" ++ show v
- show (SortV v) = "sortv=" ++ show v
- show (Splines v) = "splines=" ++ show v
- show (Start v) = "start=" ++ show v
- show (Style v) = "style=" ++ show v
- show (StyleSheet v) = "stylesheet=" ++ v
- show (TailURL v) = "tailURL=" ++ show v
- show (TailClip v) = "tailclip=" ++ show v
- show (TailLabel v) = "taillabel=" ++ show v
- show (TailPort v) = "tailport=" ++ show v
- show (TailTarget v) = "tailtarget=" ++ v
- show (TailTooltip v) = "tailtooltip=" ++ v
- show (Target v) = "target=" ++ v
- show (Tooltip v) = "tooltip=" ++ v
- show (TrueColor v) = "truecolor=" ++ show v
- show (Vertices v) = "vertices=" ++ show v
- show (ViewPort v) = "viewport=" ++ show v
- show (VoroMargin v) = "voro_margin=" ++ show v
- show (Weight v) = "weight=" ++ show v
- show (Width v) = "width=" ++ show v
- show (Z v) = "z=" ++ show v
-
-instance Parseable Attribute where
- parse = oneOf [ liftM Damping $ parseField "Damping"
- , liftM K $ parseField "K"
- , liftM URL $ oneOf (map parseField ["URL", "href"])
- , liftM ArrowHead $ parseField "arrowhead"
- , liftM ArrowSize $ parseField "arrowsize"
- , liftM ArrowTail $ parseField "arrowtail"
- , liftM Aspect $ parseField "aspect"
- , liftM Bb $ parseField "bb"
- , liftM BgColor $ parseField "bgcolor"
- , liftM Center $ parseBoolField "center"
- , liftM Charset $ parseField "charset"
- , liftM ClusterRank $ parseField "clusterrank"
- , liftM Color $ parseField "color"
- , liftM ColorScheme $ parseField "colorscheme"
- , liftM Comment $ parseField "comment"
- , liftM Compound $ parseBoolField "compound"
- , liftM Concentrate $ parseBoolField "concentrate"
- , liftM Constraint $ parseBoolField "constraint"
- , liftM Decorate $ parseBoolField "decorate"
- , liftM DefaultDist $ parseField "defaultdist"
- , liftM Dim $ parseField "dim"
- , liftM Dimen $ parseField "dimen"
- , liftM Dir $ parseField "dir"
- , liftM DirEdgeConstraints $ parseFieldDef (DEBool True) "diredgeconstraints"
- , liftM Distortion $ parseField "distortion"
- , liftM DPI $ parseField "dpi"
- , liftM EdgeURL $ oneOf (map parseField ["edgeURL", "edgehref"])
- , liftM EdgeTarget $ parseField "edgetarget"
- , liftM EdgeTooltip $ parseField "edgetooltip"
- , liftM Epsilon $ parseField "epsilon"
- , liftM ESep $ parseField "esep"
- , liftM FillColor $ parseField "fillcolor"
- , liftM FixedSize $ parseBoolField "fixedsize"
- , liftM FontColor $ parseField "fontcolor"
- , liftM FontName $ parseField "fontname"
- , liftM FontNames $ parseField "fontnames"
- , liftM FontPath $ parseField "fontpath"
- , liftM FontSize $ parseField "fontsize"
- , liftM Group $ parseField "group"
- , liftM HeadURL $ oneOf (map parseField ["headURL", "headhref"])
- , liftM HeadClip $ parseBoolField "headclip"
- , liftM HeadLabel $ parseField "headlabel"
- , liftM HeadPort $ parseField "headport"
- , liftM HeadTarget $ parseField "headtarget"
- , liftM HeadTooltip $ parseField "headtooltip"
- , liftM Height $ parseField "height"
- , liftM ID $ parseField "id"
- , liftM Image $ parseField "image"
- , liftM ImageScale $ parseFieldDef UniformScale "imagescale"
- , liftM Label $ parseField "label"
- , liftM LabelURL $ oneOf (map parseField ["labelURL", "labelhref"])
- , liftM LabelAngle $ parseField "labelangle"
- , liftM LabelDistance $ parseField "labeldistance"
- , liftM LabelFloat $ parseBoolField "labelfloat"
- , liftM LabelFontColor $ parseField "labelfontcolor"
- , liftM LabelFontName $ parseField "labelfontname"
- , liftM LabelFontSize $ parseField "labelfontsize"
- , liftM LabelJust $ parseField "labeljust"
- , liftM LabelLoc $ parseField "labelloc"
- , liftM LabelTarget $ parseField "labeltarget"
- , liftM LabelTooltip $ parseField "labeltooltip"
- , liftM Landscape $ parseBoolField "landscape"
- , liftM Layer $ parseField "layer"
- , liftM Layers $ parseField "layers"
- , liftM LayerSep $ parseField "layersep"
- , liftM Layout $ parseField "layout"
- , liftM Len $ parseField "len"
- , liftM Levels $ parseField "levels"
- , liftM LevelsGap $ parseField "levelsgap"
- , liftM LHead $ parseField "lhead"
- , liftM LP $ parseField "lp"
- , liftM LTail $ parseField "ltail"
- , liftM Margin $ parseField "margin"
- , liftM MaxIter $ parseField "maxiter"
- , liftM MCLimit $ parseField "mclimit"
- , liftM MinDist $ parseField "mindist"
- , liftM MinLen $ parseField "minlen"
- , liftM Mode $ parseField "mode"
- , liftM Model $ parseField "model"
- , liftM Mosek $ parseBoolField "mosek"
- , liftM NodeSep $ parseField "nodesep"
- , liftM NoJustify $ parseBoolField "nojustify"
- , liftM Normalize $ parseBoolField "normalize"
- , liftM Nslimit $ parseField "nslimit"
- , liftM Nslimit1 $ parseField "nslimit1"
- , liftM Ordering $ parseField "ordering"
- , liftM Orientation $ parseField "orientation"
- , liftM OrientationGraph $ parseField "orientation"
- , liftM OutputOrder $ parseField "outputorder"
- , liftM Overlap $ parseFieldDef KeepOverlaps "overlap"
- , liftM OverlapScaling $ parseField "overlap_scaling"
- , liftM Pack $ parseFieldDef DoPack "pack"
- , liftM PackMode $ parseField "packmode"
- , liftM Pad $ parseField "pad"
- , liftM Page $ parseField "page"
- , liftM PageDir $ parseField "pagedir"
- , liftM PenColor $ parseField "pencolor"
- , liftM PenWidth $ parseField "penwidth"
- , liftM Peripheries $ parseField "peripheries"
- , liftM Pin $ parseBoolField "pin"
- , liftM Pos $ parseField "pos"
- , liftM QuadTree $ parseFieldDef NormalQT "quadtree"
- , liftM Quantum $ parseField "quantum"
- , liftM Rank $ parseField "rank"
- , liftM RankDir $ parseField "rankdir"
- , liftM Ranksep $ parseField "ranksep"
- , liftM Ratio $ parseField "ratio"
- , liftM Rects $ parseField "rects"
- , liftM Regular $ parseBoolField "regular"
- , liftM ReMinCross $ parseBoolField "remincross"
- , liftM RepulsiveForce $ parseField "repulsiveforce"
- , liftM Resolution $ parseField "resolution"
- , liftM Root $ parseFieldDef IsCentral "root"
- , liftM Rotate $ parseField "rotate"
- , liftM SameHead $ parseField "samehead"
- , liftM SameTail $ parseField "sametail"
- , liftM SamplePoints $ parseField "samplepoints"
- , liftM SearchSize $ parseField "searchsize"
- , liftM Sep $ parseField "sep"
- , liftM Shape $ parseField "shape"
- , liftM ShapeFile $ parseField "shapefile"
- , liftM ShowBoxes $ parseField "showboxes"
- , liftM Sides $ parseField "sides"
- , liftM Size $ parseField "size"
- , liftM Skew $ parseField "skew"
- , liftM Smoothing $ parseField "smoothing"
- , liftM SortV $ parseField "sortv"
- , liftM Splines $ parseFieldDef SplineEdges "splines"
- , liftM Start $ parseField "start"
- , liftM Style $ parseField "style"
- , liftM StyleSheet $ parseField "stylesheet"
- , liftM TailURL $ oneOf (map parseField ["tailURL", "tailhref"])
- , liftM TailClip $ parseBoolField "tailclip"
- , liftM TailLabel $ parseField "taillabel"
- , liftM TailPort $ parseField "tailport"
- , liftM TailTarget $ parseField "tailtarget"
- , liftM TailTooltip $ parseField "tailtooltip"
- , liftM Target $ parseField "target"
- , liftM Tooltip $ parseField "tooltip"
- , liftM TrueColor $ parseBoolField "truecolor"
- , liftM Vertices $ parseField "vertices"
- , liftM ViewPort $ parseField "viewport"
- , liftM VoroMargin $ parseField "voro_margin"
- , liftM Weight $ parseField "weight"
- , liftM Width $ parseField "width"
- , liftM Z $ parseField "z"
- ]
-
--- | Determine if this Attribute is valid for use with Graphs.
-usedByGraphs :: Attribute -> Bool
-usedByGraphs Damping{} = True
-usedByGraphs K{} = True
-usedByGraphs URL{} = True
-usedByGraphs Aspect{} = True
-usedByGraphs Bb{} = True
-usedByGraphs BgColor{} = True
-usedByGraphs Center{} = True
-usedByGraphs Charset{} = True
-usedByGraphs ClusterRank{} = True
-usedByGraphs ColorScheme{} = True
-usedByGraphs Comment{} = True
-usedByGraphs Compound{} = True
-usedByGraphs Concentrate{} = True
-usedByGraphs DefaultDist{} = True
-usedByGraphs Dim{} = True
-usedByGraphs Dimen{} = True
-usedByGraphs DirEdgeConstraints{} = True
-usedByGraphs DPI{} = True
-usedByGraphs Epsilon{} = True
-usedByGraphs ESep{} = True
-usedByGraphs FontColor{} = True
-usedByGraphs FontName{} = True
-usedByGraphs FontNames{} = True
-usedByGraphs FontPath{} = True
-usedByGraphs FontSize{} = True
-usedByGraphs ID{} = True
-usedByGraphs Label{} = True
-usedByGraphs LabelJust{} = True
-usedByGraphs LabelLoc{} = True
-usedByGraphs Landscape{} = True
-usedByGraphs Layers{} = True
-usedByGraphs LayerSep{} = True
-usedByGraphs Layout{} = True
-usedByGraphs Levels{} = True
-usedByGraphs LevelsGap{} = True
-usedByGraphs LP{} = True
-usedByGraphs Margin{} = True
-usedByGraphs MaxIter{} = True
-usedByGraphs MCLimit{} = True
-usedByGraphs MinDist{} = True
-usedByGraphs Mode{} = True
-usedByGraphs Model{} = True
-usedByGraphs Mosek{} = True
-usedByGraphs NodeSep{} = True
-usedByGraphs NoJustify{} = True
-usedByGraphs Normalize{} = True
-usedByGraphs Nslimit{} = True
-usedByGraphs Nslimit1{} = True
-usedByGraphs Ordering{} = True
-usedByGraphs OrientationGraph{} = True
-usedByGraphs OutputOrder{} = True
-usedByGraphs Overlap{} = True
-usedByGraphs OverlapScaling{} = True
-usedByGraphs Pack{} = True
-usedByGraphs PackMode{} = True
-usedByGraphs Pad{} = True
-usedByGraphs Page{} = True
-usedByGraphs PageDir{} = True
-usedByGraphs QuadTree{} = True
-usedByGraphs Quantum{} = True
-usedByGraphs RankDir{} = True
-usedByGraphs Ranksep{} = True
-usedByGraphs Ratio{} = True
-usedByGraphs ReMinCross{} = True
-usedByGraphs RepulsiveForce{} = True
-usedByGraphs Resolution{} = True
-usedByGraphs Root{} = True
-usedByGraphs Rotate{} = True
-usedByGraphs SearchSize{} = True
-usedByGraphs Sep{} = True
-usedByGraphs ShowBoxes{} = True
-usedByGraphs Size{} = True
-usedByGraphs Smoothing{} = True
-usedByGraphs SortV{} = True
-usedByGraphs Splines{} = True
-usedByGraphs Start{} = True
-usedByGraphs StyleSheet{} = True
-usedByGraphs Target{} = True
-usedByGraphs TrueColor{} = True
-usedByGraphs ViewPort{} = True
-usedByGraphs VoroMargin{} = True
-usedByGraphs _ = False
-
--- | Determine if this Attribute is valid for use with Clusters.
-usedByClusters :: Attribute -> Bool
-usedByClusters K{} = True
-usedByClusters URL{} = True
-usedByClusters BgColor{} = True
-usedByClusters Color{} = True
-usedByClusters ColorScheme{} = True
-usedByClusters FillColor{} = True
-usedByClusters FontColor{} = True
-usedByClusters FontName{} = True
-usedByClusters FontSize{} = True
-usedByClusters Label{} = True
-usedByClusters LabelJust{} = True
-usedByClusters LabelLoc{} = True
-usedByClusters LP{} = True
-usedByClusters NoJustify{} = True
-usedByClusters PenColor{} = True
-usedByClusters PenWidth{} = True
-usedByClusters Peripheries{} = True
-usedByClusters Rank{} = True
-usedByClusters SortV{} = True
-usedByClusters Style{} = True
-usedByClusters Target{} = True
-usedByClusters Tooltip{} = True
-usedByClusters _ = False
-
--- | Determine if this Attribute is valid for use with SubGraphs.
-usedBySubGraphs :: Attribute -> Bool
-usedBySubGraphs Rank{} = True
-usedBySubGraphs _ = False
-
--- | Determine if this Attribute is valid for use with Nodes.
-usedByNodes :: Attribute -> Bool
-usedByNodes URL{} = True
-usedByNodes Color{} = True
-usedByNodes ColorScheme{} = True
-usedByNodes Comment{} = True
-usedByNodes Distortion{} = True
-usedByNodes FillColor{} = True
-usedByNodes FixedSize{} = True
-usedByNodes FontColor{} = True
-usedByNodes FontName{} = True
-usedByNodes FontSize{} = True
-usedByNodes Group{} = True
-usedByNodes Height{} = True
-usedByNodes ID{} = True
-usedByNodes Image{} = True
-usedByNodes ImageScale{} = True
-usedByNodes Label{} = True
-usedByNodes LabelLoc{} = True
-usedByNodes Layer{} = True
-usedByNodes Margin{} = True
-usedByNodes NoJustify{} = True
-usedByNodes Orientation{} = True
-usedByNodes PenWidth{} = True
-usedByNodes Peripheries{} = True
-usedByNodes Pin{} = True
-usedByNodes Pos{} = True
-usedByNodes Rects{} = True
-usedByNodes Regular{} = True
-usedByNodes Root{} = True
-usedByNodes SamplePoints{} = True
-usedByNodes Shape{} = True
-usedByNodes ShapeFile{} = True
-usedByNodes ShowBoxes{} = True
-usedByNodes Sides{} = True
-usedByNodes Skew{} = True
-usedByNodes SortV{} = True
-usedByNodes Style{} = True
-usedByNodes Target{} = True
-usedByNodes Tooltip{} = True
-usedByNodes Vertices{} = True
-usedByNodes Width{} = True
-usedByNodes Z{} = True
-usedByNodes _ = False
-
--- | Determine if this Attribute is valid for use with Edges.
-usedByEdges :: Attribute -> Bool
-usedByEdges URL{} = True
-usedByEdges ArrowHead{} = True
-usedByEdges ArrowSize{} = True
-usedByEdges ArrowTail{} = True
-usedByEdges Color{} = True
-usedByEdges ColorScheme{} = True
-usedByEdges Comment{} = True
-usedByEdges Constraint{} = True
-usedByEdges Decorate{} = True
-usedByEdges Dir{} = True
-usedByEdges EdgeURL{} = True
-usedByEdges EdgeTarget{} = True
-usedByEdges EdgeTooltip{} = True
-usedByEdges FontColor{} = True
-usedByEdges FontName{} = True
-usedByEdges FontSize{} = True
-usedByEdges HeadURL{} = True
-usedByEdges HeadClip{} = True
-usedByEdges HeadLabel{} = True
-usedByEdges HeadPort{} = True
-usedByEdges HeadTarget{} = True
-usedByEdges HeadTooltip{} = True
-usedByEdges ID{} = True
-usedByEdges Label{} = True
-usedByEdges LabelURL{} = True
-usedByEdges LabelAngle{} = True
-usedByEdges LabelDistance{} = True
-usedByEdges LabelFloat{} = True
-usedByEdges LabelFontColor{} = True
-usedByEdges LabelFontName{} = True
-usedByEdges LabelFontSize{} = True
-usedByEdges LabelTarget{} = True
-usedByEdges LabelTooltip{} = True
-usedByEdges Layer{} = True
-usedByEdges Len{} = True
-usedByEdges LHead{} = True
-usedByEdges LP{} = True
-usedByEdges LTail{} = True
-usedByEdges MinLen{} = True
-usedByEdges NoJustify{} = True
-usedByEdges PenWidth{} = True
-usedByEdges Pos{} = True
-usedByEdges SameHead{} = True
-usedByEdges SameTail{} = True
-usedByEdges ShowBoxes{} = True
-usedByEdges Style{} = True
-usedByEdges TailURL{} = True
-usedByEdges TailClip{} = True
-usedByEdges TailLabel{} = True
-usedByEdges TailPort{} = True
-usedByEdges TailTarget{} = True
-usedByEdges TailTooltip{} = True
-usedByEdges Target{} = True
-usedByEdges Tooltip{} = True
-usedByEdges Weight{} = True
-usedByEdges _ = False
-
--- -----------------------------------------------------------------------------
-
-newtype URL = UStr { urlString :: String }
- deriving (Eq, Read)
-
-instance Show URL where
- show u = '<' : urlString u ++ ">"
-
-instance Parseable URL where
- parse = do char open
- cnt <- many1 $ satisfy ((/=) close)
- char close
- return $ UStr cnt
- where
- open = '<'
- close = '>'
-
--- -----------------------------------------------------------------------------
-
-data ArrowType = Normal | Inv
- | DotArrow | InvDot
- | ODot | InvODot
- | NoArrow | Tee
- | Empty | InvEmpty
- | Diamond | ODiamond
- | EDiamond | Crow
- | Box | OBox
- | Open | HalfOpen
- | Vee
- deriving (Eq, Read)
-
-instance Show ArrowType where
- show Normal = "normal"
- show Inv = "inv"
- show DotArrow = "dot"
- show InvDot = "invdot"
- show ODot = "odot"
- show InvODot = "invodot"
- show NoArrow = "none"
- show Tee = "tee"
- show Empty = "empty"
- show InvEmpty = "invempty"
- show Diamond = "diamond"
- show ODiamond = "odiamond"
- show EDiamond = "ediamond"
- show Crow = "crow"
- show Box = "box"
- show OBox = "obox"
- show Open = "open"
- show HalfOpen = "halfopen"
- show Vee = "vee"
-
-instance Parseable ArrowType where
- parse = optionalQuoted
- $ oneOf [ string "normal" >> return Normal
- , string "inv" >> return Inv
- , string "dot" >> return DotArrow
- , string "invdot" >> return InvDot
- , string "odot" >> return ODot
- , string "invodot" >> return InvODot
- , string "none" >> return NoArrow
- , string "tee" >> return Tee
- , string "empty" >> return Empty
- , string "invempty" >> return InvEmpty
- , string "diamond" >> return Diamond
- , string "odiamond" >> return ODiamond
- , string "ediamond" >> return EDiamond
- , string "crow" >> return Crow
- , string "box" >> return Box
- , string "obox" >> return OBox
- , string "open" >> return Open
- , string "halfopen" >> return HalfOpen
- , string "vee" >> return Vee
- ]
-
--- -----------------------------------------------------------------------------
-
-data AspectType = RatioOnly Double
- | RatioPassCount Double Int
- deriving (Eq, Read)
-
-instance Show AspectType where
- show (RatioOnly r) = show r
- show (RatioPassCount r p) = show $ show r ++ ',' : show p
-
-instance Parseable AspectType where
- parse = oneOf [ liftM RatioOnly parse
- , quotedParse $ do r <- parse
- char ','
- whitespace'
- p <- parse
- return $ RatioPassCount r p
- ]
-
--- -----------------------------------------------------------------------------
-
-data Rect = Rect Point Point
- deriving (Eq, Read)
-
-instance Show Rect where
- show (Rect p1 p2) = show $ show p1 ++ ',' : show p2
-
-instance Parseable Rect where
- parse = liftM (uncurry Rect) . quotedParse
- $ commaSep' parsePoint parsePoint
-
--- -----------------------------------------------------------------------------
-
-data Color = RGB { red :: Word8
- , green :: Word8
- , blue :: Word8
- }
- | RGBA { red :: Word8
- , green :: Word8
- , blue :: Word8
- , alpha :: Word8
- }
- | HSV { hue :: Int
- , saturation :: Int
- , value :: Int
- }
- | ColorName String
- deriving (Eq, Read)
-
-instance Show Color where
- show = show . showColor
-
- showList cs s = show $ go cs
- where
- go [] = s
- go [c] = showColor c ++ s
- go (c:cs') = showColor c ++ ':' : go cs'
-
-showColor :: Color -> String
-showColor (RGB r g b) = '#' : foldr showWord8Pad "" [r,g,b]
-showColor (RGBA r g b a) = '#' : foldr showWord8Pad "" [r,g,b,a]
-showColor (HSV h s v) = show h ++ " " ++ show s ++ " " ++ show v
-showColor (ColorName name) = name
-
-showWord8Pad :: Word8 -> String -> String
-showWord8Pad w s = padding ++ simple ++ s
- where
- simple = showHex w ""
- padding = replicate count '0'
- count = 2 - findCols 1 w
- findCols :: Int -> Word8 -> Int
- findCols c n
- | n < 16 = c
- | otherwise = findCols (c+1) (n `div` 16)
-
-instance Parseable Color where
- parse = quotedParse parseColor
-
- parseList = quotedParse $ sepBy1 parseColor (char ':')
-
-parseColor :: Parse Color
-parseColor = oneOf [ parseHexBased
- , parseHSV
- , liftM ColorName parse -- Should we check it is a colour?
- ]
- where
- parseHexBased
- = do char '#'
- cs <- many1 parse2Hex
- return $ case cs of
- [r,g,b] -> RGB r g b
- [r,g,b,a] -> RGBA r g b a
- _ -> error $ "Not a valid hex Color specification: "
- ++ show cs
- parseHSV = do h <- parse
- parseSep
- s <- parse
- parseSep
- v <- parse
- return $ HSV h s v
- parseSep = oneOf [ string ","
- , whitespace
- ]
- parse2Hex = do c1 <- satisfy isHexDigit
- c2 <- satisfy isHexDigit
- let [(n, [])] = readHex [c1, c2]
- return n
-
--- -----------------------------------------------------------------------------
-
-data ClusterMode = Local
- | Global
- | NoCluster
- deriving (Eq, Read)
-
-instance Show ClusterMode where
- show Local = "local"
- show Global = "global"
- show NoCluster = "none"
-
-instance Parseable ClusterMode where
- parse = optionalQuoted
- . oneOf
- $ [ string "local" >> return Local
- , string "global" >> return Global
- , string "none" >> return NoCluster
- ]
-
--- -----------------------------------------------------------------------------
-
-data DirType = Forward | Back | Both | NoDir
- deriving (Eq, Read)
-
-instance Show DirType where
- show Forward = "forward"
- show Back = "back"
- show Both = "both"
- show NoDir = "none"
-
-instance Parseable DirType where
- parse = optionalQuoted
- $ oneOf [ string "forward" >> return Forward
- , string "back" >> return Back
- , string "both" >> return Both
- , string "none" >> return NoDir
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Only when @mode=ipsep@.
-data DEConstraints = DEBool Bool
- | Hier
- deriving (Eq, Read)
-
-instance Show DEConstraints where
- show (DEBool b) = show b
- show Hier = "hier"
-
-instance Parseable DEConstraints where
- parse = optionalQuoted
- $ oneOf [ liftM DEBool parse
- , string "hier" >> return Hier
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Either a 'Double' or a 'Point'.
-data DPoint = DVal Double
- | PVal Point
- deriving (Eq, Read)
-
-instance Show DPoint where
- show (DVal d) = show d
- show (PVal p) = show p
-
-instance Parseable DPoint where
- parse = oneOf [ liftM DVal parse
- , liftM PVal parsePoint
- ]
-
--- -----------------------------------------------------------------------------
-
-data Label = StrLabel String
- | URLLabel URL
- deriving (Eq, Read)
-
-instance Show Label where
- show (StrLabel s) = s
- show (URLLabel u) = show u
-
-instance Parseable Label where
- parse = oneOf [ liftM StrLabel parse
- , liftM URLLabel parse
- ]
-
--- -----------------------------------------------------------------------------
-
-data Point = Point Int Int
- | PointD Double Double
- deriving (Eq, Read)
-
-instance Show Point where
- show = show . showPoint
-
- showList ps s = unwords (map showPoint ps) ++ s
-
-showPoint :: Point -> String
-showPoint (Point x y) = show x ++ ',' : show y
-showPoint (PointD x y) = show x ++ ',' : show y
-
-instance Parseable Point where
- parse = quotedParse parsePoint
-
- parseList = quotedParse $ sepBy1 parsePoint whitespace
-
-parsePoint :: Parse Point
-parsePoint = oneOf [ liftM (uncurry Point) commaSep
- , liftM (uncurry PointD) commaSep
- ]
-
--- -----------------------------------------------------------------------------
-
-data Overlap = KeepOverlaps
- | RemoveOverlaps
- | ScaleOverlaps
- | ScaleXYOverlaps
- | PrismOverlap (Maybe Int) -- ^ Only when sfdp is available, @Int@ is non-negative
- | CompressOverlap
- | VpscOverlap
- | IpsepOverlap -- ^ Only when @mode="ipsep"@
- deriving (Eq, Read)
-
-instance Show Overlap where
- show KeepOverlaps = "true"
- show RemoveOverlaps = "false"
- show ScaleOverlaps = "scale"
- show ScaleXYOverlaps = "scalexy"
- show (PrismOverlap i) = maybe id (flip (++) . show) i $ "prism"
- show CompressOverlap = "compress"
- show VpscOverlap = "vpsc"
- show IpsepOverlap = "ipsep"
-
-instance Parseable Overlap where
- parse = optionalQuoted
- $ oneOf [ string "true" >> return KeepOverlaps
- , string "false" >> return RemoveOverlaps
- , string "scale" >> return ScaleOverlaps
- , string "scalexy" >> return ScaleXYOverlaps
- , string "prism" >> liftM PrismOverlap (optional parse)
- , string "compress" >> return CompressOverlap
- , string "vpsc" >> return VpscOverlap
- , string "ipsep" >> return IpsepOverlap
- ]
-
--- -----------------------------------------------------------------------------
-
-data LayerRange = LRID LayerID
- | LRS LayerID String LayerID
- deriving (Eq, Read)
-
-instance Show LayerRange where
- show (LRID lid) = show lid
- show (LRS id1 sep id2) = show $ show id1 ++ sep ++ show id2
-
-instance Parseable LayerRange where
- parse = oneOf [ liftM LRID parse
- , do id1 <- parse
- sep <- parseLayerSep
- id2 <- parse
- return $ LRS id1 sep id2
- ]
-
-parseLayerSep :: Parse String
-parseLayerSep = many1 . oneOf
- $ map char defLayerSep
-
-defLayerSep :: [Char]
-defLayerSep = [' ', ':', '\t']
-
-parseLayerName :: Parse String
-parseLayerName = many1 $ satisfy (flip notElem defLayerSep)
-
-data LayerID = AllLayers
- | LRInt Int
- | LRName String
- deriving (Eq, Read)
-
-instance Show LayerID where
- show AllLayers = "all"
- show (LRInt n) = show n
- show (LRName nm) = nm
-
-instance Parseable LayerID where
- parse = oneOf [ optionalQuotedString "all" >> return AllLayers
- , liftM LRInt $ optionalQuoted parse
- , liftM LRName parseLayerName
- ]
-
--- | The list represent (Separator, Name)
-data LayerList = LL String [(String, String)]
- deriving (Eq, Read)
-
-instance Show LayerList where
- show (LL l1 ols) = l1 ++ concatMap (uncurry (++)) ols
-
-instance Parseable LayerList where
- parse = do l1 <- parseLayerName
- ols <- many $ do sep <- parseLayerSep
- lnm <- parseLayerName
- return (sep, lnm)
- return $ LL l1 ols
-
--- -----------------------------------------------------------------------------
-
-data OutputMode = BreadthFirst | NodesFirst | EdgesFirst
- deriving (Eq, Read)
-
-instance Show OutputMode where
- show BreadthFirst = "breadthfirst"
- show NodesFirst = "nodesfirst"
- show EdgesFirst = "edgesfirst"
-
-instance Parseable OutputMode where
- parse = optionalQuoted
- $ oneOf [ string "breadthfirst" >> return BreadthFirst
- , string "nodesfirst" >> return NodesFirst
- , string "edgesfirst" >> return EdgesFirst
- ]
-
--- -----------------------------------------------------------------------------
-
-data Pack = DoPack
- | DontPack
- | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.
- deriving (Eq, Read)
-
-instance Show Pack where
- show DoPack = "true"
- show DontPack = "false"
- show (PackMargin m) = show m
-
-instance Parseable Pack where
- parse = optionalQuoted
- $ oneOf [ liftM (bool DoPack DontPack) parse
- , liftM PackMargin parse
- ]
-
--- -----------------------------------------------------------------------------
-
-data PackMode = PackNode
- | PackClust
- | PackGraph
- | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort
- -- by user, number of
- -- rows/cols
- deriving (Eq, Read)
-
-instance Show PackMode where
- show PackNode = "node"
- show PackClust = "clust"
- show PackGraph = "graph"
- show (PackArray c u mi) = addNum . isU . isC . isUnder
- $ "array"
- where
- addNum = maybe id (flip (++) . show) mi
- isUnder = if c || u
- then flip (++) "_"
- else id
- isC = if c
- then flip (++) "c"
- else id
- isU = if u
- then flip (++) "u"
- else id
-
-instance Parseable PackMode where
- parse = optionalQuoted
- $ oneOf [ string "node" >> return PackNode
- , string "clust" >> return PackClust
- , string "graph" >> return PackGraph
- , do string "array"
- mcu <- optional $ do char '_'
- many1 $ satisfy (not . isDigit)
- let c = hasChar mcu 'c'
- u = hasChar mcu 'u'
- mi <- optional parse
- return $ PackArray c u mi
- ]
- where
- hasChar ms c = maybe False (elem c) ms
-
--- -----------------------------------------------------------------------------
-
-data Pos = PointPos Point
- | SplinePos [Spline]
- deriving (Eq, Read)
-
-instance Show Pos where
- show (PointPos p) = show p
- show (SplinePos ss) = show ss
-
-instance Parseable Pos where
- -- [Spline] must be quoted, so use the quoted parser for Point as
- -- well.
- parse = oneOf [ liftM PointPos parse
- , liftM SplinePos parse
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Controls how (and if) edges are represented.
-data EdgeType = SplineEdges
- | LineEdges
- | NoEdges
- | PolyLine
- | CompoundEdge -- ^ fdp only
- deriving (Eq, Read)
-
-instance Show EdgeType where
- show SplineEdges = "true"
- show LineEdges = "false"
- show NoEdges = "\"\""
- show PolyLine = "polyline"
- show CompoundEdge = "compound"
-
-instance Parseable EdgeType where
- parse = optionalQuoted
- $ oneOf [ liftM (bool SplineEdges LineEdges) parse
- , string "spline" >> return SplineEdges
- , string "line" >> return LineEdges
- , string "\"\"" >> return NoEdges
- , string "polyline" >> return PolyLine
- , string "compound" >> return CompoundEdge
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Upper-case first character is major order;
--- lower-case second character is minor order.
-data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt
- deriving (Eq, Read)
-
-instance Show PageDir where
- show Bl = "BL"
- show Br = "BR"
- show Tl = "TL"
- show Tr = "TR"
- show Rb = "RB"
- show Rt = "RT"
- show Lb = "LB"
- show Lt = "LT"
-
-instance Parseable PageDir where
- parse = optionalQuoted
- $ oneOf [ string "BL" >> return Bl
- , string "BR" >> return Br
- , string "TL" >> return Tl
- , string "TR" >> return Tr
- , string "RB" >> return Rb
- , string "RT" >> return Rt
- , string "LB" >> return Lb
- , string "LT" >> return Lt
- ]
-
--- -----------------------------------------------------------------------------
-
--- | The number of points in the list must be equivalent to 1 mod 3;
--- note that this is not checked.
-data Spline = Spline (Maybe Point) (Maybe Point) [Point]
- deriving (Eq, Read)
-
-instance Show Spline where
- show = show . showSpline
-
- showList ss o = show $ go ss
- where
- go [] = o
- go [s] = showSpline s ++ o
- go (s:ss') = showSpline s ++ ';' : go ss'
-
-showSpline :: Spline -> String
-showSpline (Spline ms me ps) = addS . addE
- . unwords
- $ map showPoint ps
- where
- addP t = maybe id (\p -> (++) $ t : ',' : show p)
- addS = addP 's' ms
- addE = addP 'e' me
-
-instance Parseable Spline where
- parse = quotedParse parseSpline
-
- parseList = quotedParse $ sepBy1 parseSpline (char ';')
-
-parseSpline :: Parse Spline
-parseSpline = do ms <- parseP 's'
- whitespace
- me <- parseP 'e'
- whitespace
- ps <- sepBy1 parsePoint whitespace
- return $ Spline ms me ps
- where
- parseP t = optional $ do char t
- char ';'
- parse
-
--- -----------------------------------------------------------------------------
-
-data QuadType = NormalQT
- | FastQT
- | NoQT
- deriving (Eq, Read)
-
-instance Show QuadType where
- show NormalQT = "normal"
- show FastQT = "fast"
- show NoQT = "none"
-
-instance Parseable QuadType where
- -- Have to take into account the slightly different interpretation
- -- of Bool used as an option for parsing QuadType
- parse = optionalQuoted
- $ oneOf [ string "normal" >> return NormalQT
- , string "fast" >> return FastQT
- , string "none" >> return NoQT
- , char '2' >> return FastQT -- weird bool
- , liftM (bool NormalQT NoQT) parse
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Specify the root node either as a Node attribute or a Graph attribute.
-data Root = IsCentral -- ^ For Nodes only
- | NotCentral -- ^ For Nodes only
- | NodeName String -- ^ For Graphs only
- deriving (Eq, Read)
-
-instance Show Root where
- show IsCentral = "true"
- show NotCentral = "false"
- show (NodeName n) = n
-
-instance Parseable Root where
- parse = optionalQuoted
- $ oneOf [ liftM (bool IsCentral NotCentral) parse
- , liftM NodeName parse
- ]
-
--- -----------------------------------------------------------------------------
-
-data RankType = SameRank
- | MinRank
- | SourceRank
- | MaxRank
- | SinkRank
- deriving (Eq, Read)
-
-instance Show RankType where
- show SameRank = "same"
- show MinRank = "min"
- show SourceRank = "source"
- show MaxRank = "max"
- show SinkRank = "sink"
-
-instance Parseable RankType where
- parse = optionalQuoted
- $ oneOf [ string "same" >> return SameRank
- , string "min" >> return MinRank
- , string "source" >> return SourceRank
- , string "max" >> return MaxRank
- , string "sink" >> return SinkRank
- ]
-
--- -----------------------------------------------------------------------------
-
-data RankDir = FromTop
- | FromLeft
- | FromBottom
- | FromRight
- deriving (Eq, Read)
-
-instance Show RankDir where
- show FromTop = "TB"
- show FromLeft = "LR"
- show FromBottom = "BT"
- show FromRight = "RL"
-
-instance Parseable RankDir where
- parse = optionalQuoted
- $ oneOf [ string "TB" >> return FromTop
- , string "LR" >> return FromLeft
- , string "BT" >> return FromBottom
- , string "RL" >> return FromRight
- ]
-
--- -----------------------------------------------------------------------------
-
-data Shape
- = BoxShape
- | Polygon
- | Ellipse
- | Circle
- | PointShape
- | Egg
- | Triangle
- | Plaintext
- | DiamondShape
- | Trapezium
- | Parallelogram
- | House
- | Pentagon
- | Hexagon
- | Septagon
- | Octagon
- | Doublecircle
- | Doubleoctagon
- | Tripleoctagon
- | Invtriangle
- | Invtrapezium
- | Invhouse
- | Mdiamond
- | Msquare
- | Mcircle
- | Rectangle
- | NoShape
- | Note
- | Tab
- | Folder
- | Box3d
- | Component
- deriving (Eq, Read)
-
-instance Show Shape where
- show BoxShape = "box"
- show Polygon = "polygon"
- show Ellipse = "ellipse"
- show Circle = "circle"
- show PointShape = "point"
- show Egg = "egg"
- show Triangle = "triangle"
- show Plaintext = "plaintext"
- show DiamondShape = "diamond"
- show Trapezium = "trapezium"
- show Parallelogram = "parallelogram"
- show House = "house"
- show Pentagon = "pentagon"
- show Hexagon = "hexagon"
- show Septagon = "septagon"
- show Octagon = "octagon"
- show Doublecircle = "doublecircle"
- show Doubleoctagon = "doubleoctagon"
- show Tripleoctagon = "tripleoctagon"
- show Invtriangle = "invtriangle"
- show Invtrapezium = "invtrapezium"
- show Invhouse = "invhouse"
- show Mdiamond = "mdiamond"
- show Msquare = "msquare"
- show Mcircle = "mcircle"
- show Rectangle = "rectangle"
- show NoShape = "none"
- show Note = "note"
- show Tab = "tab"
- show Folder = "folder"
- show Box3d = "box3d"
- show Component = "component"
-
-instance Parseable Shape where
- parse = optionalQuoted
- $ oneOf [ string "box" >> return BoxShape
- , string "polygon" >> return Polygon
- , string "ellipse" >> return Ellipse
- , string "circle" >> return Circle
- , string "point" >> return PointShape
- , string "egg" >> return Egg
- , string "triangle" >> return Triangle
- , string "plaintext" >> return Plaintext
- , string "diamond" >> return DiamondShape
- , string "trapezium" >> return Trapezium
- , string "parallelogram" >> return Parallelogram
- , string "house" >> return House
- , string "pentagon" >> return Pentagon
- , string "hexagon" >> return Hexagon
- , string "septagon" >> return Septagon
- , string "octagon" >> return Octagon
- , string "doublecircle" >> return Doublecircle
- , string "doubleoctagon" >> return Doubleoctagon
- , string "tripleoctagon" >> return Tripleoctagon
- , string "invtriangle" >> return Invtriangle
- , string "invtrapezium" >> return Invtrapezium
- , string "invhouse" >> return Invhouse
- , string "mdiamond" >> return Mdiamond
- , string "msquare" >> return Msquare
- , string "mcircle" >> return Mcircle
- , string "rectangle" >> return Rectangle
- , string "none" >> return NoShape
- , string "note" >> return Note
- , string "tab" >> return Tab
- , string "folder" >> return Folder
- , string "box3d" >> return Box3d
- , string "component" >> return Component
- ]
-
--- -----------------------------------------------------------------------------
-
-data SmoothType = NoSmooth
- | AvgDist
- | GraphDist
- | PowerDist
- | RNG
- | Spring
- | TriangleSmooth
- deriving (Eq, Read)
-
-instance Show SmoothType where
- show NoSmooth = "none"
- show AvgDist = "avg_dist"
- show GraphDist = "graph_dist"
- show PowerDist = "power_dist"
- show RNG = "rng"
- show Spring = "spring"
- show TriangleSmooth = "triangle"
-
-instance Parseable SmoothType where
- parse = optionalQuoted
- $ oneOf [ string "none" >> return NoSmooth
- , string "avg_dist" >> return AvgDist
- , string "graph_dist" >> return GraphDist
- , string "power_dist" >> return PowerDist
- , string "rng" >> return RNG
- , string "spring" >> return Spring
- , string "triangle" >> return TriangleSmooth
- ]
-
--- -----------------------------------------------------------------------------
-
--- | It it assumed that at least one of these is @Just{}@.
-data StartType = ST (Maybe STStyle) (Maybe Int) -- Use a Word?
- deriving (Eq, Read)
-
-instance Show StartType where
- show (ST ms mi) = maybe id ((++) . show) ms
- $ maybe "" show mi
-
-instance Parseable StartType where
- parse = optionalQuoted
- $ do ms <- optional parse
- mi <- optional parse
- return $ ST ms mi
-
-data STStyle = RegularStyle
- | Self
- | Random
- deriving (Eq, Read)
-
-instance Show STStyle where
- show RegularStyle = "regular"
- show Self = "self"
- show Random = "random"
-
-instance Parseable STStyle where
- parse = oneOf [ string "regular" >> return RegularStyle
- , string "self" >> return Self
- , string "random" >> return Random
- ]
-
--- -----------------------------------------------------------------------------
-
-data Style = Stl StyleName (Maybe String)
- deriving (Eq, Read)
-
-instance Show Style where
- show (Stl nm marg) = maybe snm
- (\arg -> show $ snm ++ '(' : arg ++ ")")
- marg
- where
- snm = show nm
-
-instance Parseable Style where
- parse = oneOf [ optionalQuoted $ liftM (\nm -> Stl nm Nothing) parse
- , quotedParse $ do nm <- parse
- char '('
- arg <- many1
- $ satisfy (flip notElem "()")
-
- char ')'
- return $ Stl nm (Just arg)
- ]
-
-data StyleName = Dashed -- ^ Nodes and Edges
- | Dotted -- ^ Nodes and Edges
- | Solid -- ^ Nodes and Edges
- | Bold -- ^ Nodes and Edges
- | Invisible -- ^ Nodes and Edges
- | Filled -- ^ Nodes and Clusters
- | Diagonals -- ^ Nodes only
- | Rounded -- ^ Nodes and Clusters
- deriving (Eq, Read)
-
-instance Show StyleName where
- show Filled = "filled"
- show Invisible = "invis"
- show Diagonals = "diagonals"
- show Rounded = "rounded"
- show Dashed = "dashed"
- show Dotted = "dotted"
- show Solid = "solid"
- show Bold = "bold"
-
-instance Parseable StyleName where
- parse = optionalQuoted
- $ oneOf [ string "filled" >> return Filled
- , string "invis" >> return Invisible
- , string "diagonals" >> return Diagonals
- , string "rounded" >> return Rounded
- , string "dashed" >> return Dashed
- , string "dotted" >> return Dotted
- , string "solid" >> return Solid
- , string "bold" >> return Bold
- ]
-
--- -----------------------------------------------------------------------------
-
-newtype PortPos = PP CompassPoint
- deriving (Eq, Read)
-
-instance Show PortPos where
- show (PP cp) = show cp
-
-instance Parseable PortPos where
- parse = liftM PP parse
-
-data CompassPoint = North
- | NorthEast
- | East
- | SouthEast
- | South
- | SouthWest
- | West
- | NorthWest
- | CenterPoint
- | NoCP
- deriving (Eq, Read)
-
-instance Show CompassPoint where
- show North = "n"
- show NorthEast = "ne"
- show East = "e"
- show SouthEast = "se"
- show South = "s"
- show SouthWest = "sw"
- show West = "w"
- show NorthWest = "nw"
- show CenterPoint = "c"
- show NoCP = "_"
-
-instance Parseable CompassPoint where
- parse = optionalQuoted
- $ oneOf [ string "n" >> return North
- , string "ne" >> return NorthEast
- , string "e" >> return East
- , string "se" >> return SouthEast
- , string "s" >> return South
- , string "sw" >> return SouthWest
- , string "w" >> return West
- , string "nw" >> return NorthWest
- , string "c" >> return CenterPoint
- , string "_" >> return NoCP
- ]
-
--- -----------------------------------------------------------------------------
-
-data ViewPort = VP { wVal :: Double
- , hVal :: Double
- , zVal :: Double
- , focus :: Maybe FocusType
- }
- deriving (Eq, Read)
-
-instance Show ViewPort where
- show vp = show
- . maybe id (flip (++) . show) (focus vp)
- $ show (wVal vp)
- ++ ',' : show (hVal vp)
- ++ ',' : show (zVal vp)
-
-instance Parseable ViewPort where
- parse = quotedParse
- $ do wv <- parse
- char ','
- hv <- parse
- char ','
- zv <- parse
- mf <- optional $ char ',' >> parse
- return $ VP wv hv zv mf
-
-data FocusType = XY Point
- | NodeFocus String
- deriving (Eq, Read)
-
-instance Show FocusType where
- show (XY p) = showPoint p
- show (NodeFocus nm) = nm
-
-instance Parseable FocusType where
- parse = oneOf [ liftM XY parsePoint
- , liftM NodeFocus stringBlock
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Note that 'VCenter' is only valid for Nodes.
-data VerticalPlacement = VTop
- | VCenter
- | VBottom
- deriving (Eq, Read)
-
-instance Show VerticalPlacement where
- show VTop = "t"
- show VCenter = "c"
- show VBottom = "b"
-
-instance Parseable VerticalPlacement where
- parse = optionalQuoted
- $ oneOf [ string "t" >> return VTop
- , string "c" >> return VCenter
- , string "b" >> return VBottom
- ]
-
-
--- -----------------------------------------------------------------------------
-
-data ScaleType = UniformScale
- | NoScale
- | FillWidth
- | FillHeight
- | FillBoth
- deriving (Eq, Read)
-
-instance Show ScaleType where
- show UniformScale = "true"
- show NoScale = "false"
- show FillWidth = "width"
- show FillHeight = "height"
- show FillBoth = "both"
-
-instance Parseable ScaleType where
- parse = optionalQuoted
- $ oneOf [ string "true" >> return UniformScale
- , string "false" >> return NoScale
- , string "width" >> return FillWidth
- , string "height" >> return FillHeight
- , string "both" >> return FillBoth
- ]
-
--- -----------------------------------------------------------------------------
-
-data Justification = JLeft
- | JRight
- | JCenter
- deriving (Eq, Read)
-
-instance Show Justification where
- show JLeft = "l"
- show JRight = "r"
- show JCenter = "c"
-
-instance Parseable Justification where
- parse = optionalQuoted
- $ oneOf [ string "l" >> return JLeft
- , string "r" >> return JRight
- , string "c" >> return JCenter
- ]
-
--- -----------------------------------------------------------------------------
-
-data Ratios = AspectRatio Double
- | FillRatio
- | CompressRatio
- | ExpandRatio
- | AutoRatio
- deriving (Eq, Read)
-
-instance Show Ratios where
- show (AspectRatio r) = show r
- show FillRatio = "fill"
- show CompressRatio = "compress"
- show ExpandRatio = "expand"
- show AutoRatio = "auto"
-
-instance Parseable Ratios where
- parse = optionalQuoted
- $ oneOf [ liftM AspectRatio parse
- , string "fill" >> return FillRatio
- , string "compress" >> return CompressRatio
- , string "expand" >> return ExpandRatio
- , string "auto" >> return AutoRatio
- ]
-
--- -----------------------------------------------------------------------------
-
--- | Represents 'String's that definitely have quotes around them.
-newtype QuotedString = QS { qStr :: String }
- deriving (Eq, Read)
-
-instance Show QuotedString where
- show = show . qStr
-
-instance Parseable QuotedString where
- parse = liftM (QS . tail . init) quotedString
-
--- -----------------------------------------------------------------------------
-
--- Utility Functions
-
--- | Fold over 'Bool's.
-bool :: a -> a -> Bool -> a
-bool t f b = if b
- then t
- else f
+
+
+ For more information on usage, etc. please see that document.
+
+ A summary of known current constraints\/limitations\/differences:
+
+ * There might still be a few cases where quotes are still not
+ escaped/parsed correctly; if you find such a situation, please
+ let me know; however, you should be able to use 'String' values
+ directly without having to worry about when quotes are required
+ or extra escaping of quote characters as 'PrintDot' and
+ 'ParseDot' instances for 'String' should take care of that
+ for you.
+
+ * Note that for an edge, in /Dot/ parlance if the edge goes from
+ /A/ to /B/, then /A/ is the tail node and /B/ is the head node
+ (since /A/ is at the tail end of the arrow).
+
+ * GraphViz says that a number like @/.02/@ is valid; this library
+ disagrees.
+
+ * When parsing named 'Color' values, the entire value entered is
+ kept as-is; this library as yet has no understanding of different
+ color schemes, etc.
+
+ * ColorList and PointfList are defined as actual lists (but
+ 'LayerList' is not). Note that for the Color 'Attribute' for
+ node values, only a single Color is valid; edges are allowed
+ multiple colors with one spline/arrow per color in the list (but
+ you must have at least one 'Color' in the list). This might be
+ changed in future.
+
+ * Style is implemented as a list of 'StyleItem' values; note that
+ empty lists are not allowed.
+
+ * A lot of values have a possible value of @none@. These now
+ have custom constructors. In fact, most constructors have been
+ expanded upon to give an idea of what they represent rather than
+ using generic terms.
+
+ * @PointF@ and 'Point' have been combined, and feature support for pure
+ 'Int'-based co-ordinates as well as 'Double' ones (i.e. no floating
+ point-only points for Point). The optional '!' and third value
+ for Point are not available.
+
+ * 'Rect' uses two 'Point' values to denote the lower-left and
+ top-right corners.
+
+ * The two 'LabelLoc' attributes have been combined.
+
+ * The defined 'LayerSep' is not used to parse 'LayerRange' or
+ 'LayerList'; the default (@[' ', ':', '\t']@) is instead used.
+
+ * @SplineType@ has been replaced with @['Spline']@.
+
+ * Only polygon-based 'Shape's are available.
+
+ * 'PortPos' only has the 'CompassPoint' option, not
+ @PortName[:CompassPoint]@ (since record shapes aren't allowed,
+ and parsing HTML-like labels could be problematic).
+
+ * Not every 'Attribute' is fully documented/described. However,
+ all those which have specific allowed values should be covered.
+
+ * Deprecated 'Overlap' algorithms are not defined.
+
+ -}
+module Data.GraphViz.Attributes
+ ( -- * The actual /Dot/ attributes.
+ Attribute(..)
+ , Attributes
+ -- ** Validity functions on @Attribute@ values.
+ , usedByGraphs
+ , usedBySubGraphs
+ , usedByClusters
+ , usedByNodes
+ , usedByEdges
+ -- * Value types for @Attribute@s.
+ , EscString
+ , URL(..)
+ , ArrowType(..)
+ , AspectType(..)
+ , Rect(..)
+ , Color(..)
+ , ClusterMode(..)
+ , DirType(..)
+ , DEConstraints(..)
+ , DPoint(..)
+ , ModeType(..)
+ , Model(..)
+ , Label(..)
+ , Point(..)
+ , Overlap(..)
+ , LayerRange(..)
+ , LayerID(..)
+ , LayerList(..)
+ , OutputMode(..)
+ , Pack(..)
+ , PackMode(..)
+ , Pos(..)
+ , EdgeType(..)
+ , PageDir(..)
+ , Spline(..)
+ , QuadType(..)
+ , Root(..)
+ , RankType(..)
+ , RankDir(..)
+ , Shape(..)
+ , SmoothType(..)
+ , StartType(..)
+ , STStyle(..)
+ , StyleItem(..)
+ , StyleName(..)
+ , PortPos(..)
+ , CompassPoint(..)
+ , ViewPort(..)
+ , FocusType(..)
+ , VerticalPlacement(..)
+ , ScaleType(..)
+ , Justification(..)
+ , Ratios(..)
+ -- * Types representing the Dot grammar for @ArrowType@.
+ , ArrowShape(..)
+ , ArrowModifier(..)
+ , ArrowFill(..)
+ , ArrowSide(..)
+ -- ** Default @ArrowType@ aliases.
+ -- *** The 9 primitive @ArrowShape@s.
+ , box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee
+ -- *** 5 derived Arrows.
+ , oDot, invDot, invODot, oBox, oDiamond
+ -- *** 5 supported cases for backwards compatibility
+ , eDiamond, openArr, halfOpen, emptyArr, invEmpty
+ -- ** @ArrowModifier@ instances
+ , noMods, openMod
+ ) where
+
+import Data.GraphViz.Types.Internal
+import Data.GraphViz.Types.Parsing
+import Data.GraphViz.Types.Printing
+
+import Data.Char(isDigit, isHexDigit)
+import Data.Maybe(isJust, maybe)
+import Data.Word(Word8)
+import Numeric(showHex, readHex)
+import Control.Monad(liftM)
+
+-- -----------------------------------------------------------------------------
+
+{- |
+
+ These attributes have been implemented in a /permissive/ manner:
+ that is, rather than split them up based on which type of value
+ they are allowed, they have all been included in the one data type,
+ with functions to determine if they are indeed valid for what
+ they're being applied to.
+
+ To interpret the /Valid for/ listings:
+
+ [@G@] Valid for Graphs.
+
+ [@C@] Valid for Clusters.
+
+ [@S@] Valid for Sub-Graphs (and also Clusters).
+
+ [@N@] Valid for Nodes.
+
+ [@E@] Valid for Edges.
+
+ The /Default/ listings are those that the various GraphViz commands
+ use if that 'Attribute' isn't specified (in cases where this is
+ /none/, this is equivalent to a 'Nothing' value; that is, no value
+ is used). The /Parsing Default/ listings represent what value is
+ used (i.e. corresponds to 'True') when the 'Attribute' name is
+ listed on its own in /Dot/ source code.
+-}
+data Attribute
+ = Damping Double -- ^ /Valid for/: G; /Default/: @0.99@; /Minimum/: @0.0@; /Notes/: neato only
+ | K Double -- ^ /Valid for/: GC; /Default/: @0.3@; /Minimum/: @0@; /Notes/: sfdp, fdp only
+ | URL URL -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, postscript, map only
+ | ArrowHead ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@
+ | ArrowSize Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
+ | ArrowTail ArrowType -- ^ /Valid for/: E; /Default/: @'normal'@
+ | Aspect AspectType -- ^ /Valid for/: G; /Notes/: dot only
+ | Bb Rect -- ^ /Valid for/: G; /Notes/: write only
+ | BgColor Color -- ^ /Valid for/: GC; /Default/: none
+ | Center Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Charset String -- ^ /Valid for/: G; /Default/: @\"UTF-8\"@
+ | ClusterRank ClusterMode -- ^ /Valid for/: G; /Default/: @'Local'@; /Notes/: dot only
+ | Color [Color] -- ^ /Valid for/: ENC; /Default/: @black@
+ | ColorScheme String -- ^ /Valid for/: ENCG; /Default/: @\"\"@
+ | Comment String -- ^ /Valid for/: ENG; /Default/: @\"\"@
+ | Compound Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only
+ | Concentrate Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Constraint Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'; /Notes/: dot only
+ | Decorate Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
+ | DefaultDist Double -- ^ /Valid for/: G; /Default/: @1+(avg. len)*sqrt(|V|)@; /Minimum/: @epsilon@; /Notes/: neato only
+ | Dim Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only
+ | Dimen Int -- ^ /Valid for/: G; /Default/: @2@; /Minimum/: @2@; /Notes/: sfdp, fdp, neato only
+ | Dir DirType -- ^ /Valid for/: E; /Default/: @'Forward'@ (directed), @'NoDir'@ (undirected)
+ | DirEdgeConstraints DEConstraints -- ^ /Valid for/: G; /Default/: @'NoConstraints'@; /Parsing Default/: 'EdgeConstraints'; /Notes/: neato only
+ | Distortion Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
+ | DPI Double -- ^ /Valid for/: G; /Default/: @96.0@, @0.0@; /Notes/: svg, bitmap output only; \"resolution\" is a synonym
+ | EdgeURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | EdgeTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | EdgeTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Epsilon Double -- ^ /Valid for/: G; /Default/: @.0001 * # nodes@ (@mode == 'KK'@), @.0001@ (@mode == 'Major'@); /Notes/: neato only
+ | ESep DPoint -- ^ /Valid for/: G; /Default/: @+3@; /Notes/: not dot
+ | FillColor Color -- ^ /Valid for/: NC; /Default/: @lightgrey@ (nodes), @black@ (clusters)
+ | FixedSize Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'
+ | FontColor Color -- ^ /Valid for/: ENGC; /Default/: @black@
+ | FontName String -- ^ /Valid for/: ENGC; /Default/: @\"Times-Roman\"@
+ | FontNames String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only
+ | FontPath String -- ^ /Valid for/: G; /Default/: system-dependent
+ | FontSize Double -- ^ /Valid for/: ENGC; /Default/: @14.0@; /Minimum/: @1.0@
+ | Group String -- ^ /Valid for/: N; /Default/: @\"\"@; /Notes/: dot only
+ | HeadURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | HeadClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
+ | HeadLabel Label -- ^ /Valid for/: E; /Default/: @\"\"@
+ | HeadPort PortPos -- ^ /Valid for/: E; /Default/: @'PP' 'CenterPoint'@
+ | HeadTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | HeadTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Height Double -- ^ /Valid for/: N; /Default/: @0.5@; /Minimum/: @0.02@
+ | ID Label -- ^ /Valid for/: GNE; /Default/: @\"\"@; /Notes/: svg, postscript, map only
+ | Image String -- ^ /Valid for/: N; /Default/: @\"\"@
+ | ImageScale ScaleType -- ^ /Valid for/: N; /Default/: @'NoScale'@; /Parsing Default/: 'UniformScale'
+ | Label Label -- ^ /Valid for/: ENGC; /Default/: @'StrLabel' \"\N\"@ (nodes), @'StrLabel' \"\"@ (otherwise)
+ | LabelURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | LabelAngle Double -- ^ /Valid for/: E; /Default/: @-25.0@; /Minimum/: @-180.0@
+ | LabelDistance Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0.0@
+ | LabelFloat Bool -- ^ /Valid for/: E; /Default/: @'False'@; /Parsing Default/: 'True'
+ | LabelFontColor Color -- ^ /Valid for/: E; /Default/: @black@
+ | LabelFontName String -- ^ /Valid for/: E; /Default/: @\"Times-Roman\"@
+ | LabelFontSize Double -- ^ /Valid for/: E; /Default/: @14.0@; /Minimum/: @1.0@
+ | LabelJust Justification -- ^ /Valid for/: GC; /Default/: @'JCenter'@
+ | LabelLoc VerticalPlacement -- ^ /Valid for/: GCN; /Default/: @'VTop'@ (clusters), @'VBottom'@ (root graphs), @'VCenter'@ (nodes)
+ | LabelTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | LabelTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Landscape Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Layer LayerRange -- ^ /Valid for/: EN; /Default/: @\"\"@
+ | Layers LayerList -- ^ /Valid for/: G; /Default/: @\"\"@
+ | LayerSep String -- ^ /Valid for/: G; /Default/: @\" :\t\"@
+ | Layout String -- ^ /Valid for/: G; /Default/: @\"\"@
+ | Len Double -- ^ /Valid for/: E; /Default/: @1.0@ (neato), @0.3@ (fdp); /Notes/: fdp, neato only
+ | Levels Int -- ^ /Valid for/: G; /Default/: @MAXINT@; /Minimum/: @0@; /Notes/: sfdp only
+ | LevelsGap Double -- ^ /Valid for/: G; /Default/: @0.0@; /Notes/: neato only
+ | LHead String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
+ | LPos Point -- ^ /Valid for/: EGC; /Notes/: write only
+ | LTail String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
+ | Margin DPoint -- ^ /Valid for/: NG; /Default/: device-dependent
+ | MaxIter Int -- ^ /Valid for/: G; /Default/: @100 * # nodes@ (@mode == 'KK'@), @200@ (@mode == 'Major'@), @600@ (fdp); /Notes/: fdp, neato only
+ | MCLimit Double -- ^ /Valid for/: G; /Default/: @1.0@; /Notes/: dot only
+ | MinDist Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: circo only
+ | MinLen Int -- ^ /Valid for/: E; /Default/: @1@; /Minimum/: @0@; /Notes/: dot only
+ | Mode ModeType -- ^ /Valid for/: G; /Default/: @'Major'@; /Notes/: neato only
+ | Model Model -- ^ /Valid for/: G; /Default/: @'ShortPath'@; /Notes/: neato only
+ | Mosek Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: neato only; requires the Mosek software
+ | NodeSep Double -- ^ /Valid for/: G; /Default/: @0.25@; /Minimum/: @0.02@; /Notes/: dot only
+ | NoJustify Bool -- ^ /Valid for/: GCNE; /Default/: @'False'@; /Parsing Default/: 'True'
+ | Normalize Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: not dot
+ | Nslimit Double -- ^ /Valid for/: G; /Notes/: dot only
+ | Nslimit1 Double -- ^ /Valid for/: G; /Notes/: dot only
+ | Ordering String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: dot only
+ | Orientation Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @360.0@
+ | OrientationGraph String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: Landscape if \"[lL]*\" and rotate not defined
+ | OutputOrder OutputMode -- ^ /Valid for/: G; /Default/: @'BreadthFirst'@
+ | Overlap Overlap -- ^ /Valid for/: G; /Default/: @'KeepOverlaps'@; /Parsing Default/: 'KeepOverlaps'; /Notes/: not dot
+ | OverlapScaling Double -- ^ /Valid for/: G; /Default/: @-4@; /Minimum/: @-1.0e10@; /Notes/: prism only
+ | Pack Pack -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'DoPack'; /Notes/: not dot
+ | PackMode PackMode -- ^ /Valid for/: G; /Default/: @'PackNode'@; /Notes/: not dot
+ | Pad DPoint -- ^ /Valid for/: G; /Default/: @'DVal' 0.0555@ (4 points)
+ | Page Point -- ^ /Valid for/: G
+ | PageDir PageDir -- ^ /Valid for/: G; /Default/: @'BL'@
+ | PenColor Color -- ^ /Valid for/: C; /Default/: @black@
+ | PenWidth Double -- ^ /Valid for/: CNE; /Default/: @1.0@; /Minimum/: @0.0@
+ | Peripheries Int -- ^ /Valid for/: NC; /Default/: shape default (nodes), @1@ (clusters); /Minimum/: 0
+ | Pin Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: fdp, neato only
+ | Pos Pos -- ^ /Valid for/: EN
+ | QuadTree QuadType -- ^ /Valid for/: G; /Default/: @'NormalQT'@; /Parsing Default/: 'NormalQT'; /Notes/: sfdp only
+ | Quantum Double -- ^ /Valid for/: G; /Default/: @0.0@; /Minimum/: @0.0@
+ | Rank RankType -- ^ /Valid for/: S; /Notes/: dot only
+ | RankDir RankDir -- ^ /Valid for/: G; /Default/: @'TB'@; /Notes/: dot only
+ | Ranksep Double -- ^ /Valid for/: G; /Default/: @0.5@ (dot), @1.0@ (twopi); /Minimum/: 0.02; /Notes/: twopi, dot only
+ | Ratio Ratios -- ^ /Valid for/: G
+ | Rects Rect -- ^ /Valid for/: N; /Notes/: write only
+ | Regular Bool -- ^ /Valid for/: N; /Default/: @'False'@; /Parsing Default/: 'True'
+ | ReMinCross Bool -- ^ /Valid for/: G; /Default/: @'False'@; /Parsing Default/: 'True'; /Notes/: dot only
+ | RepulsiveForce Double -- ^ /Valid for/: G; /Default/: @1.0@; /Minimum/: @0.0@; /Notes/: sfdp only
+ | Root Root -- ^ /Valid for/: GN; /Default/: @'NodeName' \"\"@ (graphs), @'NotCentral'@ (nodes); /Parsing Default/: 'IsCentral'; /Notes/: circo, twopi only
+ | Rotate Int -- ^ /Valid for/: G; /Default/: @0@
+ | SameHead String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
+ | SameTail String -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: dot only
+ | SamplePoints Int -- ^ /Valid for/: N; /Default/: @8@ (output), @20@ (overlap and image maps)
+ | SearchSize Int -- ^ /Valid for/: G; /Default/: @30@; /Notes/: dot only
+ | Sep DPoint -- ^ /Valid for/: G; /Default/: @+4@; /Notes/: not dot
+ | Shape Shape -- ^ /Valid for/: N; /Default/: @'Ellipse'@
+ | ShapeFile String -- ^ /Valid for/: N; /Default/: @\"\"@
+ | ShowBoxes Int -- ^ /Valid for/: ENG; /Default/: @0@; /Minimum/: @0@; /Notes/: dot only
+ | Sides Int -- ^ /Valid for/: N; /Default/: @4@; /Minimum/: @0@
+ | Size Point -- ^ /Valid for/: G
+ | Skew Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-100.0@
+ | Smoothing SmoothType -- ^ /Valid for/: G; /Default/: @'NoSmooth'@; /Notes/: sfdp only
+ | SortV Int -- ^ /Valid for/: GCN; /Default/: @0@; /Minimum/: @0@
+ | Splines EdgeType -- ^ /Valid for/: G; /Parsing Default/: 'SplineEdges'
+ | Start StartType -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: fdp, neato only
+ | Style [StyleItem] -- ^ /Valid for/: ENC
+ | StyleSheet String -- ^ /Valid for/: G; /Default/: @\"\"@; /Notes/: svg only
+ | TailURL URL -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, map only
+ | TailClip Bool -- ^ /Valid for/: E; /Default/: @'True'@; /Parsing Default/: 'True'
+ | TailLabel Label -- ^ /Valid for/: E; /Default/: @\"\"@
+ | TailPort PortPos -- ^ /Valid for/: E; /Default/: center
+ | TailTarget EscString -- ^ /Valid for/: E; /Default/: none; /Notes/: svg, map only
+ | TailTooltip EscString -- ^ /Valid for/: E; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | Target EscString -- ^ /Valid for/: ENGC; /Default/: none; /Notes/: svg, map only
+ | Tooltip EscString -- ^ /Valid for/: NEC; /Default/: @\"\"@; /Notes/: svg, cmap only
+ | TrueColor Bool -- ^ /Valid for/: G; /Parsing Default/: 'True'; /Notes/: bitmap output only
+ | Vertices [Point] -- ^ /Valid for/: N; /Notes/: write only
+ | ViewPort ViewPort -- ^ /Valid for/: G; /Default/: none
+ | VoroMargin Double -- ^ /Valid for/: G; /Default/: @0.05@; /Minimum/: @0.0@; /Notes/: not dot
+ | Weight Double -- ^ /Valid for/: E; /Default/: @1.0@; /Minimum/: @0@ (dot), @1@ (neato,fdp,sfdp)
+ | Width Double -- ^ /Valid for/: N; /Default/: @0.75@; /Minimum/: @0.01@
+ | Z Double -- ^ /Valid for/: N; /Default/: @0.0@; /Minimum/: @-MAXFLOAT@, @-1000@
+ deriving (Eq, Show, Read)
+
+type Attributes = [Attribute]
+
+instance PrintDot Attribute where
+ unqtDot (Damping v) = printField "Damping" v
+ unqtDot (K v) = printField "K" v
+ unqtDot (URL v) = printField "URL" v
+ unqtDot (ArrowHead v) = printField "arrowhead" v
+ unqtDot (ArrowSize v) = printField "arrowsize" v
+ unqtDot (ArrowTail v) = printField "arrowtail" v
+ unqtDot (Aspect v) = printField "aspect" v
+ unqtDot (Bb v) = printField "bb" v
+ unqtDot (BgColor v) = printField "bgcolor" v
+ unqtDot (Center v) = printField "center" v
+ unqtDot (Charset v) = printField "charset" v
+ unqtDot (ClusterRank v) = printField "clusterrank" v
+ unqtDot (Color v) = printField "color" v
+ unqtDot (ColorScheme v) = printField "colorscheme" v
+ unqtDot (Comment v) = printField "comment" v
+ unqtDot (Compound v) = printField "compound" v
+ unqtDot (Concentrate v) = printField "concentrate" v
+ unqtDot (Constraint v) = printField "constraint" v
+ unqtDot (Decorate v) = printField "decorate" v
+ unqtDot (DefaultDist v) = printField "defaultdist" v
+ unqtDot (Dim v) = printField "dim" v
+ unqtDot (Dimen v) = printField "dimen" v
+ unqtDot (Dir v) = printField "dir" v
+ unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v
+ unqtDot (Distortion v) = printField "distortion" v
+ unqtDot (DPI v) = printField "dpi" v
+ unqtDot (EdgeURL v) = printField "edgeURL" v
+ unqtDot (EdgeTarget v) = printField "edgetarget" v
+ unqtDot (EdgeTooltip v) = printField "edgetooltip" v
+ unqtDot (Epsilon v) = printField "epsilon" v
+ unqtDot (ESep v) = printField "esep" v
+ unqtDot (FillColor v) = printField "fillcolor" v
+ unqtDot (FixedSize v) = printField "fixedsize" v
+ unqtDot (FontColor v) = printField "fontcolor" v
+ unqtDot (FontName v) = printField "fontname" v
+ unqtDot (FontNames v) = printField "fontnames" v
+ unqtDot (FontPath v) = printField "fontpath" v
+ unqtDot (FontSize v) = printField "fontsize" v
+ unqtDot (Group v) = printField "group" v
+ unqtDot (HeadURL v) = printField "headURL" v
+ unqtDot (HeadClip v) = printField "headclip" v
+ unqtDot (HeadLabel v) = printField "headlabel" v
+ unqtDot (HeadPort v) = printField "headport" v
+ unqtDot (HeadTarget v) = printField "headtarget" v
+ unqtDot (HeadTooltip v) = printField "headtooltip" v
+ unqtDot (Height v) = printField "height" v
+ unqtDot (ID v) = printField "id" v
+ unqtDot (Image v) = printField "image" v
+ unqtDot (ImageScale v) = printField "imagescale" v
+ unqtDot (Label v) = printField "label" v
+ unqtDot (LabelURL v) = printField "labelURL" v
+ unqtDot (LabelAngle v) = printField "labelangle" v
+ unqtDot (LabelDistance v) = printField "labeldistance" v
+ unqtDot (LabelFloat v) = printField "labelfloat" v
+ unqtDot (LabelFontColor v) = printField "labelfontcolor" v
+ unqtDot (LabelFontName v) = printField "labelfontname" v
+ unqtDot (LabelFontSize v) = printField "labelfontsize" v
+ unqtDot (LabelJust v) = printField "labeljust" v
+ unqtDot (LabelLoc v) = printField "labelloc" v
+ unqtDot (LabelTarget v) = printField "labeltarget" v
+ unqtDot (LabelTooltip v) = printField "labeltooltip" v
+ unqtDot (Landscape v) = printField "landscape" v
+ unqtDot (Layer v) = printField "layer" v
+ unqtDot (Layers v) = printField "layers" v
+ unqtDot (LayerSep v) = printField "layersep" v
+ unqtDot (Layout v) = printField "layout" v
+ unqtDot (Len v) = printField "len" v
+ unqtDot (Levels v) = printField "levels" v
+ unqtDot (LevelsGap v) = printField "levelsgap" v
+ unqtDot (LHead v) = printField "lhead" v
+ unqtDot (LPos v) = printField "lp" v
+ unqtDot (LTail v) = printField "ltail" v
+ unqtDot (Margin v) = printField "margin" v
+ unqtDot (MaxIter v) = printField "maxiter" v
+ unqtDot (MCLimit v) = printField "mclimit" v
+ unqtDot (MinDist v) = printField "mindist" v
+ unqtDot (MinLen v) = printField "minlen" v
+ unqtDot (Mode v) = printField "mode" v
+ unqtDot (Model v) = printField "model" v
+ unqtDot (Mosek v) = printField "mosek" v
+ unqtDot (NodeSep v) = printField "nodesep" v
+ unqtDot (NoJustify v) = printField "nojustify" v
+ unqtDot (Normalize v) = printField "normalize" v
+ unqtDot (Nslimit v) = printField "nslimit" v
+ unqtDot (Nslimit1 v) = printField "nslimit1" v
+ unqtDot (Ordering v) = printField "ordering" v
+ unqtDot (Orientation v) = printField "orientation" v
+ unqtDot (OrientationGraph v) = printField "orientation" v
+ unqtDot (OutputOrder v) = printField "outputorder" v
+ unqtDot (Overlap v) = printField "overlap" v
+ unqtDot (OverlapScaling v) = printField "overlap_scaling" v
+ unqtDot (Pack v) = printField "pack" v
+ unqtDot (PackMode v) = printField "packmode" v
+ unqtDot (Pad v) = printField "pad" v
+ unqtDot (Page v) = printField "page" v
+ unqtDot (PageDir v) = printField "pagedir" v
+ unqtDot (PenColor v) = printField "pencolor" v
+ unqtDot (PenWidth v) = printField "penwidth" v
+ unqtDot (Peripheries v) = printField "peripheries" v
+ unqtDot (Pin v) = printField "pin" v
+ unqtDot (Pos v) = printField "pos" v
+ unqtDot (QuadTree v) = printField "quadtree" v
+ unqtDot (Quantum v) = printField "quantum" v
+ unqtDot (Rank v) = printField "rank" v
+ unqtDot (RankDir v) = printField "rankdir" v
+ unqtDot (Ranksep v) = printField "ranksep" v
+ unqtDot (Ratio v) = printField "ratio" v
+ unqtDot (Rects v) = printField "rects" v
+ unqtDot (Regular v) = printField "regular" v
+ unqtDot (ReMinCross v) = printField "remincross" v
+ unqtDot (RepulsiveForce v) = printField "repulsiveforce" v
+ unqtDot (Root v) = printField "root" v
+ unqtDot (Rotate v) = printField "rotate" v
+ unqtDot (SameHead v) = printField "samehead" v
+ unqtDot (SameTail v) = printField "sametail" v
+ unqtDot (SamplePoints v) = printField "samplepoints" v
+ unqtDot (SearchSize v) = printField "searchsize" v
+ unqtDot (Sep v) = printField "sep" v
+ unqtDot (Shape v) = printField "shape" v
+ unqtDot (ShapeFile v) = printField "shapefile" v
+ unqtDot (ShowBoxes v) = printField "showboxes" v
+ unqtDot (Sides v) = printField "sides" v
+ unqtDot (Size v) = printField "size" v
+ unqtDot (Skew v) = printField "skew" v
+ unqtDot (Smoothing v) = printField "smoothing" v
+ unqtDot (SortV v) = printField "sortv" v
+ unqtDot (Splines v) = printField "splines" v
+ unqtDot (Start v) = printField "start" v
+ unqtDot (Style v) = printField "style" v
+ unqtDot (StyleSheet v) = printField "stylesheet" v
+ unqtDot (TailURL v) = printField "tailURL" v
+ unqtDot (TailClip v) = printField "tailclip" v
+ unqtDot (TailLabel v) = printField "taillabel" v
+ unqtDot (TailPort v) = printField "tailport" v
+ unqtDot (TailTarget v) = printField "tailtarget" v
+ unqtDot (TailTooltip v) = printField "tailtooltip" v
+ unqtDot (Target v) = printField "target" v
+ unqtDot (Tooltip v) = printField "tooltip" v
+ unqtDot (TrueColor v) = printField "truecolor" v
+ unqtDot (Vertices v) = printField "vertices" v
+ unqtDot (ViewPort v) = printField "viewport" v
+ unqtDot (VoroMargin v) = printField "voro_margin" v
+ unqtDot (Weight v) = printField "weight" v
+ unqtDot (Width v) = printField "width" v
+ unqtDot (Z v) = printField "z" v
+
+ listToDot = unqtListToDot
+
+instance ParseDot Attribute where
+ parseUnqt = oneOf [ liftM Damping $ parseField "Damping"
+ , liftM K $ parseField "K"
+ , liftM URL $ parseFields ["URL", "href"]
+ , liftM ArrowHead $ parseField "arrowhead"
+ , liftM ArrowSize $ parseField "arrowsize"
+ , liftM ArrowTail $ parseField "arrowtail"
+ , liftM Aspect $ parseField "aspect"
+ , liftM Bb $ parseField "bb"
+ , liftM BgColor $ parseField "bgcolor"
+ , liftM Center $ parseFieldBool "center"
+ , liftM Charset $ parseField "charset"
+ , liftM ClusterRank $ parseField "clusterrank"
+ , liftM Color $ parseField "color"
+ , liftM ColorScheme $ parseField "colorscheme"
+ , liftM Comment $ parseField "comment"
+ , liftM Compound $ parseFieldBool "compound"
+ , liftM Concentrate $ parseFieldBool "concentrate"
+ , liftM Constraint $ parseFieldBool "constraint"
+ , liftM Decorate $ parseFieldBool "decorate"
+ , liftM DefaultDist $ parseField "defaultdist"
+ , liftM Dim $ parseField "dim"
+ , liftM Dimen $ parseField "dimen"
+ , liftM Dir $ parseField "dir"
+ , liftM DirEdgeConstraints $ parseFieldDef EdgeConstraints "diredgeconstraints"
+ , liftM Distortion $ parseField "distortion"
+ , liftM DPI $ parseFields ["dpi", "resolution"]
+ , liftM EdgeURL $ parseFields ["edgeURL", "edgehref"]
+ , liftM EdgeTarget $ parseField "edgetarget"
+ , liftM EdgeTooltip $ parseField "edgetooltip"
+ , liftM Epsilon $ parseField "epsilon"
+ , liftM ESep $ parseField "esep"
+ , liftM FillColor $ parseField "fillcolor"
+ , liftM FixedSize $ parseFieldBool "fixedsize"
+ , liftM FontColor $ parseField "fontcolor"
+ , liftM FontName $ parseField "fontname"
+ , liftM FontNames $ parseField "fontnames"
+ , liftM FontPath $ parseField "fontpath"
+ , liftM FontSize $ parseField "fontsize"
+ , liftM Group $ parseField "group"
+ , liftM HeadURL $ parseFields ["headURL", "headhref"]
+ , liftM HeadClip $ parseFieldBool "headclip"
+ , liftM HeadLabel $ parseField "headlabel"
+ , liftM HeadPort $ parseField "headport"
+ , liftM HeadTarget $ parseField "headtarget"
+ , liftM HeadTooltip $ parseField "headtooltip"
+ , liftM Height $ parseField "height"
+ , liftM ID $ parseField "id"
+ , liftM Image $ parseField "image"
+ , liftM ImageScale $ parseFieldDef UniformScale "imagescale"
+ , liftM Label $ parseField "label"
+ , liftM LabelURL $ parseFields ["labelURL", "labelhref"]
+ , liftM LabelAngle $ parseField "labelangle"
+ , liftM LabelDistance $ parseField "labeldistance"
+ , liftM LabelFloat $ parseFieldBool "labelfloat"
+ , liftM LabelFontColor $ parseField "labelfontcolor"
+ , liftM LabelFontName $ parseField "labelfontname"
+ , liftM LabelFontSize $ parseField "labelfontsize"
+ , liftM LabelJust $ parseField "labeljust"
+ , liftM LabelLoc $ parseField "labelloc"
+ , liftM LabelTarget $ parseField "labeltarget"
+ , liftM LabelTooltip $ parseField "labeltooltip"
+ , liftM Landscape $ parseFieldBool "landscape"
+ , liftM Layer $ parseField "layer"
+ , liftM Layers $ parseField "layers"
+ , liftM LayerSep $ parseField "layersep"
+ , liftM Layout $ parseField "layout"
+ , liftM Len $ parseField "len"
+ , liftM Levels $ parseField "levels"
+ , liftM LevelsGap $ parseField "levelsgap"
+ , liftM LHead $ parseField "lhead"
+ , liftM LPos $ parseField "lp"
+ , liftM LTail $ parseField "ltail"
+ , liftM Margin $ parseField "margin"
+ , liftM MaxIter $ parseField "maxiter"
+ , liftM MCLimit $ parseField "mclimit"
+ , liftM MinDist $ parseField "mindist"
+ , liftM MinLen $ parseField "minlen"
+ , liftM Mode $ parseField "mode"
+ , liftM Model $ parseField "model"
+ , liftM Mosek $ parseFieldBool "mosek"
+ , liftM NodeSep $ parseField "nodesep"
+ , liftM NoJustify $ parseFieldBool "nojustify"
+ , liftM Normalize $ parseFieldBool "normalize"
+ , liftM Nslimit $ parseField "nslimit"
+ , liftM Nslimit1 $ parseField "nslimit1"
+ , liftM Ordering $ parseField "ordering"
+ , liftM Orientation $ parseField "orientation"
+ , liftM OrientationGraph $ parseField "orientation"
+ , liftM OutputOrder $ parseField "outputorder"
+ , liftM Overlap $ parseFieldDef KeepOverlaps "overlap"
+ , liftM OverlapScaling $ parseField "overlap_scaling"
+ , liftM Pack $ parseFieldDef DoPack "pack"
+ , liftM PackMode $ parseField "packmode"
+ , liftM Pad $ parseField "pad"
+ , liftM Page $ parseField "page"
+ , liftM PageDir $ parseField "pagedir"
+ , liftM PenColor $ parseField "pencolor"
+ , liftM PenWidth $ parseField "penwidth"
+ , liftM Peripheries $ parseField "peripheries"
+ , liftM Pin $ parseFieldBool "pin"
+ , liftM Pos $ parseField "pos"
+ , liftM QuadTree $ parseFieldDef NormalQT "quadtree"
+ , liftM Quantum $ parseField "quantum"
+ , liftM Rank $ parseField "rank"
+ , liftM RankDir $ parseField "rankdir"
+ , liftM Ranksep $ parseField "ranksep"
+ , liftM Ratio $ parseField "ratio"
+ , liftM Rects $ parseField "rects"
+ , liftM Regular $ parseFieldBool "regular"
+ , liftM ReMinCross $ parseFieldBool "remincross"
+ , liftM RepulsiveForce $ parseField "repulsiveforce"
+ , liftM Root $ parseFieldDef IsCentral "root"
+ , liftM Rotate $ parseField "rotate"
+ , liftM SameHead $ parseField "samehead"
+ , liftM SameTail $ parseField "sametail"
+ , liftM SamplePoints $ parseField "samplepoints"
+ , liftM SearchSize $ parseField "searchsize"
+ , liftM Sep $ parseField "sep"
+ , liftM Shape $ parseField "shape"
+ , liftM ShapeFile $ parseField "shapefile"
+ , liftM ShowBoxes $ parseField "showboxes"
+ , liftM Sides $ parseField "sides"
+ , liftM Size $ parseField "size"
+ , liftM Skew $ parseField "skew"
+ , liftM Smoothing $ parseField "smoothing"
+ , liftM SortV $ parseField "sortv"
+ , liftM Splines $ parseFieldDef SplineEdges "splines"
+ , liftM Start $ parseField "start"
+ , liftM Style $ parseField "style"
+ , liftM StyleSheet $ parseField "stylesheet"
+ , liftM TailURL $ parseFields ["tailURL", "tailhref"]
+ , liftM TailClip $ parseFieldBool "tailclip"
+ , liftM TailLabel $ parseField "taillabel"
+ , liftM TailPort $ parseField "tailport"
+ , liftM TailTarget $ parseField "tailtarget"
+ , liftM TailTooltip $ parseField "tailtooltip"
+ , liftM Target $ parseField "target"
+ , liftM Tooltip $ parseField "tooltip"
+ , liftM TrueColor $ parseFieldBool "truecolor"
+ , liftM Vertices $ parseField "vertices"
+ , liftM ViewPort $ parseField "viewport"
+ , liftM VoroMargin $ parseField "voro_margin"
+ , liftM Weight $ parseField "weight"
+ , liftM Width $ parseField "width"
+ , liftM Z $ parseField "z"
+ ]
+
+ parse = parseUnqt
+
+ parseList = parseUnqtList
+
+-- | Determine if this Attribute is valid for use with Graphs.
+usedByGraphs :: Attribute -> Bool
+usedByGraphs Damping{} = True
+usedByGraphs K{} = True
+usedByGraphs URL{} = True
+usedByGraphs Aspect{} = True
+usedByGraphs Bb{} = True
+usedByGraphs BgColor{} = True
+usedByGraphs Center{} = True
+usedByGraphs Charset{} = True
+usedByGraphs ClusterRank{} = True
+usedByGraphs ColorScheme{} = True
+usedByGraphs Comment{} = True
+usedByGraphs Compound{} = True
+usedByGraphs Concentrate{} = True
+usedByGraphs DefaultDist{} = True
+usedByGraphs Dim{} = True
+usedByGraphs Dimen{} = True
+usedByGraphs DirEdgeConstraints{} = True
+usedByGraphs DPI{} = True
+usedByGraphs Epsilon{} = True
+usedByGraphs ESep{} = True
+usedByGraphs FontColor{} = True
+usedByGraphs FontName{} = True
+usedByGraphs FontNames{} = True
+usedByGraphs FontPath{} = True
+usedByGraphs FontSize{} = True
+usedByGraphs ID{} = True
+usedByGraphs Label{} = True
+usedByGraphs LabelJust{} = True
+usedByGraphs LabelLoc{} = True
+usedByGraphs Landscape{} = True
+usedByGraphs Layers{} = True
+usedByGraphs LayerSep{} = True
+usedByGraphs Layout{} = True
+usedByGraphs Levels{} = True
+usedByGraphs LevelsGap{} = True
+usedByGraphs LPos{} = True
+usedByGraphs Margin{} = True
+usedByGraphs MaxIter{} = True
+usedByGraphs MCLimit{} = True
+usedByGraphs MinDist{} = True
+usedByGraphs Mode{} = True
+usedByGraphs Model{} = True
+usedByGraphs Mosek{} = True
+usedByGraphs NodeSep{} = True
+usedByGraphs NoJustify{} = True
+usedByGraphs Normalize{} = True
+usedByGraphs Nslimit{} = True
+usedByGraphs Nslimit1{} = True
+usedByGraphs Ordering{} = True
+usedByGraphs OrientationGraph{} = True
+usedByGraphs OutputOrder{} = True
+usedByGraphs Overlap{} = True
+usedByGraphs OverlapScaling{} = True
+usedByGraphs Pack{} = True
+usedByGraphs PackMode{} = True
+usedByGraphs Pad{} = True
+usedByGraphs Page{} = True
+usedByGraphs PageDir{} = True
+usedByGraphs QuadTree{} = True
+usedByGraphs Quantum{} = True
+usedByGraphs RankDir{} = True
+usedByGraphs Ranksep{} = True
+usedByGraphs Ratio{} = True
+usedByGraphs ReMinCross{} = True
+usedByGraphs RepulsiveForce{} = True
+usedByGraphs Root{} = True
+usedByGraphs Rotate{} = True
+usedByGraphs SearchSize{} = True
+usedByGraphs Sep{} = True
+usedByGraphs ShowBoxes{} = True
+usedByGraphs Size{} = True
+usedByGraphs Smoothing{} = True
+usedByGraphs SortV{} = True
+usedByGraphs Splines{} = True
+usedByGraphs Start{} = True
+usedByGraphs StyleSheet{} = True
+usedByGraphs Target{} = True
+usedByGraphs TrueColor{} = True
+usedByGraphs ViewPort{} = True
+usedByGraphs VoroMargin{} = True
+usedByGraphs _ = False
+
+-- | Determine if this Attribute is valid for use with Clusters.
+usedByClusters :: Attribute -> Bool
+usedByClusters K{} = True
+usedByClusters URL{} = True
+usedByClusters BgColor{} = True
+usedByClusters Color{} = True
+usedByClusters ColorScheme{} = True
+usedByClusters FillColor{} = True
+usedByClusters FontColor{} = True
+usedByClusters FontName{} = True
+usedByClusters FontSize{} = True
+usedByClusters Label{} = True
+usedByClusters LabelJust{} = True
+usedByClusters LabelLoc{} = True
+usedByClusters LPos{} = True
+usedByClusters NoJustify{} = True
+usedByClusters PenColor{} = True
+usedByClusters PenWidth{} = True
+usedByClusters Peripheries{} = True
+usedByClusters Rank{} = True
+usedByClusters SortV{} = True
+usedByClusters Style{} = True
+usedByClusters Target{} = True
+usedByClusters Tooltip{} = True
+usedByClusters _ = False
+
+-- | Determine if this Attribute is valid for use with SubGraphs.
+usedBySubGraphs :: Attribute -> Bool
+usedBySubGraphs Rank{} = True
+usedBySubGraphs _ = False
+
+-- | Determine if this Attribute is valid for use with Nodes.
+usedByNodes :: Attribute -> Bool
+usedByNodes URL{} = True
+usedByNodes Color{} = True
+usedByNodes ColorScheme{} = True
+usedByNodes Comment{} = True
+usedByNodes Distortion{} = True
+usedByNodes FillColor{} = True
+usedByNodes FixedSize{} = True
+usedByNodes FontColor{} = True
+usedByNodes FontName{} = True
+usedByNodes FontSize{} = True
+usedByNodes Group{} = True
+usedByNodes Height{} = True
+usedByNodes ID{} = True
+usedByNodes Image{} = True
+usedByNodes ImageScale{} = True
+usedByNodes Label{} = True
+usedByNodes LabelLoc{} = True
+usedByNodes Layer{} = True
+usedByNodes Margin{} = True
+usedByNodes NoJustify{} = True
+usedByNodes Orientation{} = True
+usedByNodes PenWidth{} = True
+usedByNodes Peripheries{} = True
+usedByNodes Pin{} = True
+usedByNodes Pos{} = True
+usedByNodes Rects{} = True
+usedByNodes Regular{} = True
+usedByNodes Root{} = True
+usedByNodes SamplePoints{} = True
+usedByNodes Shape{} = True
+usedByNodes ShapeFile{} = True
+usedByNodes ShowBoxes{} = True
+usedByNodes Sides{} = True
+usedByNodes Skew{} = True
+usedByNodes SortV{} = True
+usedByNodes Style{} = True
+usedByNodes Target{} = True
+usedByNodes Tooltip{} = True
+usedByNodes Vertices{} = True
+usedByNodes Width{} = True
+usedByNodes Z{} = True
+usedByNodes _ = False
+
+-- | Determine if this Attribute is valid for use with Edges.
+usedByEdges :: Attribute -> Bool
+usedByEdges URL{} = True
+usedByEdges ArrowHead{} = True
+usedByEdges ArrowSize{} = True
+usedByEdges ArrowTail{} = True
+usedByEdges Color{} = True
+usedByEdges ColorScheme{} = True
+usedByEdges Comment{} = True
+usedByEdges Constraint{} = True
+usedByEdges Decorate{} = True
+usedByEdges Dir{} = True
+usedByEdges EdgeURL{} = True
+usedByEdges EdgeTarget{} = True
+usedByEdges EdgeTooltip{} = True
+usedByEdges FontColor{} = True
+usedByEdges FontName{} = True
+usedByEdges FontSize{} = True
+usedByEdges HeadURL{} = True
+usedByEdges HeadClip{} = True
+usedByEdges HeadLabel{} = True
+usedByEdges HeadPort{} = True
+usedByEdges HeadTarget{} = True
+usedByEdges HeadTooltip{} = True
+usedByEdges ID{} = True
+usedByEdges Label{} = True
+usedByEdges LabelURL{} = True
+usedByEdges LabelAngle{} = True
+usedByEdges LabelDistance{} = True
+usedByEdges LabelFloat{} = True
+usedByEdges LabelFontColor{} = True
+usedByEdges LabelFontName{} = True
+usedByEdges LabelFontSize{} = True
+usedByEdges LabelTarget{} = True
+usedByEdges LabelTooltip{} = True
+usedByEdges Layer{} = True
+usedByEdges Len{} = True
+usedByEdges LHead{} = True
+usedByEdges LPos{} = True
+usedByEdges LTail{} = True
+usedByEdges MinLen{} = True
+usedByEdges NoJustify{} = True
+usedByEdges PenWidth{} = True
+usedByEdges Pos{} = True
+usedByEdges SameHead{} = True
+usedByEdges SameTail{} = True
+usedByEdges ShowBoxes{} = True
+usedByEdges Style{} = True
+usedByEdges TailURL{} = True
+usedByEdges TailClip{} = True
+usedByEdges TailLabel{} = True
+usedByEdges TailPort{} = True
+usedByEdges TailTarget{} = True
+usedByEdges TailTooltip{} = True
+usedByEdges Target{} = True
+usedByEdges Tooltip{} = True
+usedByEdges Weight{} = True
+usedByEdges _ = False
+
+{- Delete to here -}
+-- -----------------------------------------------------------------------------
+
+{- |
+
+ Some 'Attribute's (mainly label-like ones) take a 'String' argument
+ that allows for extra escape codes. This library doesn't do any
+ extra checks or special parsing for these escape codes, but usage
+ of 'EscString' rather than 'String' indicates that the GraphViz
+ tools will recognise these extra escape codes for these
+ 'Attribute's.
+
+ The extra escape codes include (note that these are all 'String's):
+
+ [@\\N@] Replace with the name of the node (for Node 'Attribute's).
+
+ [@\\G@] Replace with the name of the graph (for Node 'Attribute's)
+ or the name of the graph or cluster, whichever is
+ applicable (for Graph, Cluster and Edge 'Attribute's).
+
+ [@\\E@] Replace with the name of the edge, formed by the two
+ adjoining nodes and the edge type (for Edge 'Attribute's).
+
+ [@\\T@] Replace with the name of the tail node (for Edge
+ 'Attribute's).
+
+ [@\\H@] Replace with the name of the head node (for Edge
+ 'Attribute's).
+
+ [@\\L@] Replace with the object's label (for all 'Attribute's).
+
+ Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or
+ 'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines
+ centered, left-justified and right-justified respectively.
+
+ -}
+type EscString = String
+
+-- -----------------------------------------------------------------------------
+
+newtype URL = UStr { urlString :: EscString }
+ deriving (Eq, Show, Read)
+
+instance PrintDot URL where
+ unqtDot = wrap (char '<') (char '>')
+ -- Explicitly use text here... no quotes!
+ . text . urlString
+
+instance ParseDot URL where
+ parseUnqt = liftM UStr
+ $ bracket (character open)
+ (character close)
+ (liftM return $ satisfy ((/=) close))
+ where
+ open = '<'
+ close = '>'
+
+ -- No quotes
+ parse = parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | /Dot/ has a basic grammar of arrow shapes which allows usage of
+-- up to 1,544,761 different shapes from 9 different basic
+-- 'ArrowShape's. Note that whilst an explicit list is used in the
+-- definition of 'ArrowType', there must be at least one tuple and a
+-- maximum of 4 (since that is what is required by Dot). For more
+-- information, see:
+--
+-- The 19 basic arrows shown on the overall attributes page have
+-- been defined below as a convenience. Parsing of the 5
+-- backward-compatible special cases is also supported.
+newtype ArrowType = AType [(ArrowModifier, ArrowShape)]
+ deriving (Eq, Show, Read)
+
+box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: ArrowType
+oDot, invDot, invODot, oBox, oDiamond :: ArrowType
+eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType
+
+normal = AType [(noMods, Normal)]
+inv = AType [(noMods, Inv)]
+dotArrow = AType [(noMods, DotArrow)]
+invDot = AType [ (noMods, Inv)
+ , (noMods, DotArrow)]
+oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)]
+invODot = AType [ (noMods, Inv)
+ , (openMod, DotArrow)]
+noArrow = AType [(noMods, NoArrow)]
+tee = AType [(noMods, Tee)]
+emptyArr = AType [(openMod, Normal)]
+invEmpty = AType [ (noMods, Inv)
+ , (openMod, Normal)]
+diamond = AType [(noMods, Diamond)]
+oDiamond = AType [(openMod, Diamond)]
+eDiamond = oDiamond
+crow = AType [(noMods, Crow)]
+box = AType [(noMods, Box)]
+oBox = AType [(openMod, Box)]
+openArr = vee
+halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]
+vee = AType [(noMods, Vee)]
+
+instance PrintDot ArrowType where
+ unqtDot (AType mas) = hcat $ map appMod mas
+ where
+ appMod (m, a) = unqtDot m <> unqtDot a
+
+instance ParseDot ArrowType where
+ parseUnqt = do mas <- many1 $ do m <- parseUnqt
+ a <- parseUnqt
+ return (m,a)
+ return $ AType mas
+ `onFail`
+ specialArrowParse
+
+specialArrowParse :: Parse ArrowType
+specialArrowParse = oneOf [ stringRep eDiamond "ediamond"
+ , stringRep openArr "open"
+ , stringRep halfOpen "halfopen"
+ , stringRep emptyArr "empty"
+ , stringRep invEmpty "invempty"
+ ]
+
+data ArrowShape = Box
+ | Crow
+ | Diamond
+ | DotArrow
+ | Inv
+ | NoArrow
+ | Normal
+ | Tee
+ | Vee
+ deriving (Eq, Show, Read)
+
+instance PrintDot ArrowShape where
+ unqtDot Box = unqtDot "box"
+ unqtDot Crow = unqtDot "crow"
+ unqtDot Diamond = unqtDot "diamond"
+ unqtDot DotArrow = unqtDot "dot"
+ unqtDot Inv = unqtDot "inv"
+ unqtDot NoArrow = unqtDot "none"
+ unqtDot Normal = unqtDot "normal"
+ unqtDot Tee = unqtDot "tee"
+ unqtDot Vee = unqtDot "vee"
+
+instance ParseDot ArrowShape where
+ parseUnqt = oneOf [ stringRep Box "box"
+ , stringRep Crow "crow"
+ , stringRep Diamond "diamond"
+ , stringRep DotArrow "dot"
+ , stringRep Inv "inv"
+ , stringRep NoArrow "none"
+ , stringRep Normal "normal"
+ , stringRep Tee "tee"
+ , stringRep Vee "vee"
+ ]
+
+-- | What modifications to apply to an 'ArrowShape'.
+data ArrowModifier = ArrMod { arrowFill :: ArrowFill
+ , arrowSide :: ArrowSide
+ }
+ deriving (Eq, Show, Read)
+
+-- | Apply no modifications to an 'ArrowShape'.
+noMods :: ArrowModifier
+noMods = ArrMod FilledArrow BothSides
+
+-- | 'OpenArrow' and 'BothSides'
+openMod :: ArrowModifier
+openMod = ArrMod OpenArrow BothSides
+
+instance PrintDot ArrowModifier where
+ unqtDot (ArrMod f s) = unqtDot f <> unqtDot s
+
+instance ParseDot ArrowModifier where
+ parseUnqt = do f <- parseUnqt
+ s <- parseUnqt
+ return $ ArrMod f s
+
+data ArrowFill = OpenArrow
+ | FilledArrow
+ deriving (Eq, Show, Read)
+
+instance PrintDot ArrowFill where
+ unqtDot OpenArrow = char 'o'
+ unqtDot FilledArrow = empty
+
+instance ParseDot ArrowFill where
+ parseUnqt = liftM (bool OpenArrow FilledArrow . isJust)
+ $ optional (character 'o')
+
+ -- Not used individually
+ parse = parseUnqt
+
+-- | Represents which side (when looking towards the node the arrow is
+-- pointing to) is drawn.
+data ArrowSide = LeftSide
+ | RightSide
+ | BothSides
+ deriving (Eq, Show, Read)
+
+instance PrintDot ArrowSide where
+ unqtDot LeftSide = char 'l'
+ unqtDot RightSide = char 'r'
+ unqtDot BothSides = empty
+
+instance ParseDot ArrowSide where
+ parseUnqt = liftM getSideType
+ $ optional (oneOf $ map character ['l', 'r'])
+ where
+ getSideType = maybe BothSides
+ (bool LeftSide RightSide . (==) 'l')
+
+ -- Not used individually
+ parse = parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+data AspectType = RatioOnly Double
+ | RatioPassCount Double Int
+ deriving (Eq, Show, Read)
+
+instance PrintDot AspectType where
+ unqtDot (RatioOnly r) = unqtDot r
+ unqtDot (RatioPassCount r p) = commaDel r p
+
+ toDot at@RatioOnly{} = unqtDot at
+ toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at
+
+instance ParseDot AspectType where
+ parseUnqt = liftM (uncurry RatioPassCount) commaSep
+ `onFail`
+ liftM RatioOnly parse
+
+
+ parse = quotedParse (liftM (uncurry RatioPassCount) commaSep)
+ `onFail`
+ optionalQuoted (liftM RatioOnly parse)
+
+-- -----------------------------------------------------------------------------
+
+data Rect = Rect Point Point
+ deriving (Eq, Show, Read)
+
+instance PrintDot Rect where
+ unqtDot (Rect p1 p2) = commaDel p1 p2
+
+ toDot = doubleQuotes . unqtDot
+
+instance ParseDot Rect where
+ parseUnqt = liftM (uncurry Rect)
+ $ commaSep' parseUnqt parseUnqt
+
+ parse = liftM (uncurry Rect) . quotedParse
+ $ commaSep' parseUnqt parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+data Color = RGB { red :: Word8
+ , green :: Word8
+ , blue :: Word8
+ }
+ | RGBA { red :: Word8
+ , green :: Word8
+ , blue :: Word8
+ , alpha :: Word8
+ }
+ | HSV { hue :: Double
+ , saturation :: Double
+ , value :: Double
+ }
+ | ColorName String
+ deriving (Eq, Show, Read)
+
+instance PrintDot Color where
+ unqtDot (RGB r g b) = hexColor [r,g,b]
+ unqtDot (RGBA r g b a) = hexColor [r,g,b,a]
+ unqtDot (HSV h s v) = hcat . punctuate comma $ map unqtDot [h,s,v]
+ unqtDot (ColorName name) = unqtDot name
+
+ toDot (ColorName name) = toDot name
+ toDot c = doubleQuotes $ unqtDot c
+
+ unqtListToDot = hcat . punctuate colon . map unqtDot
+
+ listToDot [ColorName nm] = toDot nm
+ listToDot cs = doubleQuotes $ unqtListToDot cs
+
+hexColor :: [Word8] -> DotCode
+hexColor = (<>) (char '#') . hcat . map word8Doc
+
+word8Doc :: Word8 -> DotCode
+word8Doc w = text $ padding ++ simple
+ where
+ simple = showHex w ""
+ padding = replicate count '0'
+ count = 2 - findCols 1 w
+ findCols :: Int -> Word8 -> Int
+ findCols c n
+ | n < 16 = c
+ | otherwise = findCols (c+1) (n `div` 16)
+
+instance ParseDot Color where
+ parseUnqt = oneOf [ parseHexBased
+ , parseHSV
+ , liftM ColorName parse -- Should we check it
+ -- is a colour?
+ ]
+ where
+ parseHexBased
+ = do character '#'
+ cs <- many1 parse2Hex
+ return $ case cs of
+ [r,g,b] -> RGB r g b
+ [r,g,b,a] -> RGBA r g b a
+ _ -> error $ "Not a valid hex Color specification: "
+ ++ show cs
+ parseHSV = do h <- parse
+ parseSep
+ s <- parse
+ parseSep
+ v <- parse
+ return $ HSV h s v
+ parseSep = oneOf [ string ","
+ , whitespace
+ ]
+ parse2Hex = do c1 <- satisfy isHexDigit
+ c2 <- satisfy isHexDigit
+ let [(n, [])] = readHex [c1, c2]
+ return n
+
+
+ parse = liftM ColorName stringBlock -- unquoted Color Name
+ `onFail`
+ quotedParse parseUnqt
+
+ parseUnqtList = sepBy1 parseUnqt (character ':')
+
+ parseList = liftM (return . ColorName) stringBlock -- unquoted single
+ -- ColorName
+ `onFail`
+ quotedParse parseUnqtList
+
+-- -----------------------------------------------------------------------------
+
+data ClusterMode = Local
+ | Global
+ | NoCluster
+ deriving (Eq, Show, Read)
+
+instance PrintDot ClusterMode where
+ unqtDot Local = unqtDot "local"
+ unqtDot Global = unqtDot "global"
+ unqtDot NoCluster = unqtDot "none"
+
+
+
+instance ParseDot ClusterMode where
+ parseUnqt = oneOf [ stringRep Local "local"
+ , stringRep Global "global"
+ , stringRep NoCluster "none"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data DirType = Forward | Back | Both | NoDir
+ deriving (Eq, Show, Read)
+
+instance PrintDot DirType where
+ unqtDot Forward = unqtDot "forward"
+ unqtDot Back = unqtDot "back"
+ unqtDot Both = unqtDot "both"
+ unqtDot NoDir = unqtDot "none"
+
+instance ParseDot DirType where
+ parseUnqt = oneOf [ stringRep Forward "forward"
+ , stringRep Back "back"
+ , stringRep Both "both"
+ , stringRep NoDir "none"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | Only when @mode == 'IpSep'@.
+data DEConstraints = EdgeConstraints
+ | NoConstraints
+ | HierConstraints
+ deriving (Eq, Show, Read)
+
+instance PrintDot DEConstraints where
+ unqtDot EdgeConstraints = unqtDot True
+ unqtDot NoConstraints = unqtDot False
+ unqtDot HierConstraints = text "hier"
+
+instance ParseDot DEConstraints where
+ parseUnqt = liftM (bool EdgeConstraints NoConstraints) parse
+ `onFail`
+ stringRep HierConstraints "hier"
+
+-- -----------------------------------------------------------------------------
+
+-- | Either a 'Double' or a 'Point'.
+data DPoint = DVal Double
+ | PVal Point
+ deriving (Eq, Show, Read)
+
+instance PrintDot DPoint where
+ unqtDot (DVal d) = unqtDot d
+ unqtDot (PVal p) = unqtDot p
+
+ toDot (DVal d) = toDot d
+ toDot (PVal p) = toDot p
+
+instance ParseDot DPoint where
+ parseUnqt = liftM DVal parseUnqt
+ `onFail`
+ liftM PVal parseUnqt
+
+ parse = liftM DVal parse
+ `onFail`
+ liftM PVal parse
+
+-- -----------------------------------------------------------------------------
+
+data ModeType = Major
+ | KK
+ | Hier
+ | IpSep
+ deriving (Eq, Show, Read)
+
+instance PrintDot ModeType where
+ unqtDot Major = text "major"
+ unqtDot KK = text "KK"
+ unqtDot Hier = text "hier"
+ unqtDot IpSep = text "ipsep"
+
+instance ParseDot ModeType where
+ parseUnqt = oneOf [ stringRep Major "major"
+ , stringRep KK "KK"
+ , stringRep Hier "hier"
+ , stringRep IpSep "ipsep"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Model = ShortPath
+ | SubSet
+ | Circuit
+ deriving (Eq, Show, Read)
+
+instance PrintDot Model where
+ unqtDot ShortPath = text "shortpath"
+ unqtDot SubSet = text "subset"
+ unqtDot Circuit = text "circuit"
+
+instance ParseDot Model where
+ parseUnqt = oneOf [ stringRep ShortPath "shortpath"
+ , stringRep SubSet "subset"
+ , stringRep Circuit "circuit"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Label = StrLabel EscString
+ | URLLabel URL
+ deriving (Eq, Show, Read)
+
+instance PrintDot Label where
+ unqtDot (StrLabel s) = unqtDot s
+ unqtDot (URLLabel u) = unqtDot u
+
+ toDot (StrLabel s) = toDot s
+ toDot (URLLabel u) = toDot u
+
+instance ParseDot Label where
+ parseUnqt = liftM StrLabel parseUnqt
+ `onFail`
+ liftM URLLabel parseUnqt
+
+ parse = liftM StrLabel parse
+ `onFail`
+ liftM URLLabel parse
+
+-- -----------------------------------------------------------------------------
+
+data Point = Point Int Int
+ | PointD Double Double
+ deriving (Eq, Show, Read)
+
+instance PrintDot Point where
+ unqtDot (Point x y) = commaDel x y
+ unqtDot (PointD x y) = commaDel x y
+
+ toDot = doubleQuotes . unqtDot
+
+ unqtListToDot = hsep . map unqtDot
+
+ listToDot = doubleQuotes . unqtListToDot
+
+instance ParseDot Point where
+ parseUnqt = liftM (uncurry Point) commaSep
+ `onFail`
+ liftM (uncurry PointD) commaSep
+
+ parse = quotedParse parseUnqt
+
+ parseUnqtList = sepBy1 parseUnqt whitespace
+
+-- -----------------------------------------------------------------------------
+
+data Overlap = KeepOverlaps
+ | RemoveOverlaps
+ | ScaleOverlaps
+ | ScaleXYOverlaps
+ | PrismOverlap (Maybe Int) -- ^ Only when sfdp is available, 'Int' is non-negative
+ | CompressOverlap
+ | VpscOverlap
+ | IpsepOverlap -- ^ Only when @mode == 'IpSep'@
+ deriving (Eq, Show, Read)
+
+instance PrintDot Overlap where
+ unqtDot KeepOverlaps = unqtDot True
+ unqtDot RemoveOverlaps = unqtDot False
+ unqtDot ScaleOverlaps = text "scale"
+ unqtDot ScaleXYOverlaps = text "scalexy"
+ unqtDot (PrismOverlap i) = maybe id (flip (<>) . unqtDot) i $ text "prism"
+ unqtDot CompressOverlap = text "compress"
+ unqtDot VpscOverlap = text "vpsc"
+ unqtDot IpsepOverlap = text "ipsep"
+
+instance ParseDot Overlap where
+ parseUnqt = oneOf [ stringRep KeepOverlaps "true"
+ , stringRep RemoveOverlaps "false"
+ , stringRep ScaleOverlaps "scale"
+ , stringRep ScaleXYOverlaps "scalexy"
+ , string "prism" >> liftM PrismOverlap (optional parse)
+ , stringRep CompressOverlap "compress"
+ , stringRep VpscOverlap "vpsc"
+ , stringRep IpsepOverlap "ipsep"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data LayerRange = LRID LayerID
+ | LRS LayerID String LayerID
+ deriving (Eq, Show, Read)
+
+instance PrintDot LayerRange where
+ unqtDot (LRID lid) = unqtDot lid
+ unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2
+
+ toDot (LRID lid) = toDot lid
+ toDot lrs = doubleQuotes $ unqtDot lrs
+
+instance ParseDot LayerRange where
+ parseUnqt = liftM LRID parseUnqt
+ `onFail`
+ do id1 <- parseUnqt
+ s <- parseLayerSep
+ id2 <- parseUnqt
+ return $ LRS id1 s id2
+
+ parse = liftM LRID parse
+ `onFail`
+ quotedParse ( do id1 <- parseUnqt
+ s <- parseLayerSep
+ id2 <- parseUnqt
+ return $ LRS id1 s id2
+ )
+
+
+parseLayerSep :: Parse String
+parseLayerSep = many1 . oneOf
+ $ map character defLayerSep
+
+defLayerSep :: [Char]
+defLayerSep = [' ', ':', '\t']
+
+parseLayerName :: Parse String
+parseLayerName = many1 $ satisfy (flip notElem defLayerSep)
+
+data LayerID = AllLayers
+ | LRInt Int
+ | LRName String
+ deriving (Eq, Show, Read)
+
+instance PrintDot LayerID where
+ unqtDot AllLayers = text "all"
+ unqtDot (LRInt n) = unqtDot n
+ unqtDot (LRName nm) = unqtDot nm
+
+ toDot (LRName nm) = toDot nm
+ -- Other two don't need quotes
+ toDot li = unqtDot li
+
+instance ParseDot LayerID where
+ parseUnqt = oneOf [ stringRep AllLayers "all"
+ , liftM LRInt parseUnqt
+ , liftM LRName parseLayerName
+ ]
+
+ parse = oneOf [ optionalQuoted $ stringRep AllLayers "all"
+ , liftM LRInt parse -- Has optionalQuoted in it
+ , quotedParse $ liftM LRName parseLayerName
+ ]
+
+-- | The list represent (Separator, Name)
+data LayerList = LL String [(String, String)]
+ deriving (Eq, Show, Read)
+
+instance PrintDot LayerList where
+ unqtDot (LL l1 ols) = unqtDot l1 <> hsep (map subLL ols)
+ where
+ subLL (s, l) = unqtDot s <> unqtDot l
+
+ -- Might not need quotes, but probably will.
+ toDot = doubleQuotes . unqtDot
+
+instance ParseDot LayerList where
+ parseUnqt = do l1 <- parseLayerName
+ ols <- many $ do s <- parseLayerSep
+ lnm <- parseLayerName
+ return (s, lnm)
+ return $ LL l1 ols
+
+ parse = quotedParse parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+data OutputMode = BreadthFirst | NodesFirst | EdgesFirst
+ deriving (Eq, Show, Read)
+
+instance PrintDot OutputMode where
+ unqtDot BreadthFirst = text "breadthfirst"
+ unqtDot NodesFirst = text "nodesfirst"
+ unqtDot EdgesFirst = text "edgesfirst"
+
+instance ParseDot OutputMode where
+ parseUnqt = oneOf [ stringRep BreadthFirst "breadthfirst"
+ , stringRep NodesFirst "nodesfirst"
+ , stringRep EdgesFirst "edgesfirst"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Pack = DoPack
+ | DontPack
+ | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.
+ deriving (Eq, Show, Read)
+
+instance PrintDot Pack where
+ unqtDot DoPack = unqtDot True
+ unqtDot DontPack = unqtDot False
+ unqtDot (PackMargin m) = unqtDot m
+
+instance ParseDot Pack where
+ -- What happens if it parses 0? It's non-negative, but parses as False
+ parseUnqt = oneOf [ liftM (bool DoPack DontPack) parseUnqt
+ , liftM PackMargin parseUnqt
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data PackMode = PackNode
+ | PackClust
+ | PackGraph
+ | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort
+ -- by user, number of
+ -- rows/cols
+ deriving (Eq, Show, Read)
+
+instance PrintDot PackMode where
+ unqtDot PackNode = text "node"
+ unqtDot PackClust = text "clust"
+ unqtDot PackGraph = text "graph"
+ unqtDot (PackArray c u mi) = addNum . isU . isC . isUnder
+ $ text "array"
+ where
+ addNum = maybe id (flip (<>) . unqtDot) mi
+ isUnder = if c || u
+ then flip (<>) $ char '_'
+ else id
+ isC = if c
+ then flip (<>) $ char 'c'
+ else id
+ isU = if u
+ then flip (<>) $ char 'u'
+ else id
+
+instance ParseDot PackMode where
+ parseUnqt = oneOf [ stringRep PackNode "node"
+ , stringRep PackClust "clust"
+ , stringRep PackGraph "graph"
+ , do string "array"
+ mcu <- optional $ do character '_'
+ many1 $ satisfy (not . isDigit)
+ let c = hasCharacter mcu 'c'
+ u = hasCharacter mcu 'u'
+ mi <- optional parseUnqt
+ return $ PackArray c u mi
+ ]
+ where
+ hasCharacter ms c = maybe False (elem c) ms
+
+-- -----------------------------------------------------------------------------
+
+data Pos = PointPos Point
+ | SplinePos [Spline]
+ deriving (Eq, Show, Read)
+
+instance PrintDot Pos where
+ unqtDot (PointPos p) = unqtDot p
+ unqtDot (SplinePos ss) = unqtDot ss
+
+ toDot (PointPos p) = toDot p
+ toDot (SplinePos ss) = toDot ss
+
+instance ParseDot Pos where
+ parseUnqt = oneOf [ liftM PointPos parseUnqt
+ , liftM SplinePos parseUnqt
+ ]
+
+ parse = quotedParse parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | Controls how (and if) edges are represented.
+data EdgeType = SplineEdges
+ | LineEdges
+ | NoEdges
+ | PolyLine
+ | CompoundEdge -- ^ fdp only
+ deriving (Eq, Show, Read)
+
+instance PrintDot EdgeType where
+ unqtDot SplineEdges = toDot True
+ unqtDot LineEdges = toDot False
+ unqtDot NoEdges = empty
+ unqtDot PolyLine = text "polyline"
+ unqtDot CompoundEdge = text "compound"
+
+ toDot NoEdges = doubleQuotes empty
+ toDot et = unqtDot et
+
+instance ParseDot EdgeType where
+ -- Can't parse NoEdges without quotes.
+ parseUnqt = oneOf [ liftM (bool SplineEdges LineEdges) parse
+ , stringRep SplineEdges "spline"
+ , stringRep LineEdges "line"
+ , stringRep PolyLine "polyline"
+ , stringRep CompoundEdge "compound"
+ ]
+
+ parse = stringRep NoEdges "\"\""
+ `onFail`
+ optionalQuoted parseUnqt
+
+-- -----------------------------------------------------------------------------
+
+-- | Upper-case first character is major order;
+-- lower-case second character is minor order.
+data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt
+ deriving (Eq, Show, Read)
+
+instance PrintDot PageDir where
+ unqtDot Bl = text "BL"
+ unqtDot Br = text "BR"
+ unqtDot Tl = text "TL"
+ unqtDot Tr = text "TR"
+ unqtDot Rb = text "RB"
+ unqtDot Rt = text "RT"
+ unqtDot Lb = text "LB"
+ unqtDot Lt = text "LT"
+
+instance ParseDot PageDir where
+ parseUnqt = oneOf [ stringRep Bl "BL"
+ , stringRep Br "BR"
+ , stringRep Tl "TL"
+ , stringRep Tr "TR"
+ , stringRep Rb "RB"
+ , stringRep Rt "RT"
+ , stringRep Lb "LB"
+ , stringRep Lt "LT"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | The number of points in the list must be equivalent to 1 mod 3;
+-- note that this is not checked.
+data Spline = Spline (Maybe Point) (Maybe Point) [Point]
+ deriving (Eq, Show, Read)
+
+instance PrintDot Spline where
+ unqtDot (Spline ms me ps) = addS . addE
+ . hsep
+ $ map unqtDot ps
+ where
+ addP t = maybe id ((<>) . commaDel t)
+ addS = addP 's' ms
+ addE = addP 'e' me
+
+ toDot = doubleQuotes . unqtDot
+
+ unqtListToDot = hsep . punctuate semi . map unqtDot
+
+ listToDot = doubleQuotes . unqtListToDot
+
+instance ParseDot Spline where
+ parseUnqt = do ms <- parseP 's'
+ whitespace
+ me <- parseP 'e'
+ whitespace
+ ps <- sepBy1 parseUnqt whitespace
+ return $ Spline ms me ps
+ where
+ parseP t = optional $ do character t
+ character ';'
+ parse
+
+ parse = quotedParse parseUnqt
+
+ parseUnqtList = sepBy1 parseUnqt (character ';')
+
+-- -----------------------------------------------------------------------------
+
+data QuadType = NormalQT
+ | FastQT
+ | NoQT
+ deriving (Eq, Show, Read)
+
+instance PrintDot QuadType where
+ unqtDot NormalQT = text "normal"
+ unqtDot FastQT = text "fast"
+ unqtDot NoQT = text "none"
+
+instance ParseDot QuadType where
+ -- Have to take into account the slightly different interpretation
+ -- of Bool used as an option for parsing QuadType
+ parseUnqt = oneOf [ stringRep NormalQT "normal"
+ , stringRep FastQT "fast"
+ , stringRep NoQT "none"
+ , character '2' >> return FastQT -- weird bool
+ , liftM (bool NormalQT NoQT) parse
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | Specify the root node either as a Node attribute or a Graph attribute.
+data Root = IsCentral -- ^ For Nodes only
+ | NotCentral -- ^ For Nodes only
+ | NodeName String -- ^ For Graphs only
+ deriving (Eq, Show, Read)
+
+instance PrintDot Root where
+ unqtDot IsCentral = unqtDot True
+ unqtDot NotCentral = unqtDot False
+ unqtDot (NodeName n) = unqtDot n
+
+ toDot (NodeName n) = toDot n
+ toDot r = unqtDot r
+
+instance ParseDot Root where
+ parseUnqt = liftM (bool IsCentral NotCentral) parse
+ `onFail`
+ liftM NodeName parse
+
+-- -----------------------------------------------------------------------------
+
+data RankType = SameRank
+ | MinRank
+ | SourceRank
+ | MaxRank
+ | SinkRank
+ deriving (Eq, Show, Read)
+
+instance PrintDot RankType where
+ unqtDot SameRank = text "same"
+ unqtDot MinRank = text "min"
+ unqtDot SourceRank = text "source"
+ unqtDot MaxRank = text "max"
+ unqtDot SinkRank = text "sink"
+
+instance ParseDot RankType where
+ parseUnqt = oneOf [ stringRep SameRank "same"
+ , stringRep MinRank "min"
+ , stringRep SourceRank "source"
+ , stringRep MaxRank "max"
+ , stringRep SinkRank "sink"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data RankDir = FromTop
+ | FromLeft
+ | FromBottom
+ | FromRight
+ deriving (Eq, Show, Read)
+
+instance PrintDot RankDir where
+ unqtDot FromTop = text "TB"
+ unqtDot FromLeft = text "LR"
+ unqtDot FromBottom = text "BT"
+ unqtDot FromRight = text "RL"
+
+instance ParseDot RankDir where
+ parseUnqt = oneOf [ stringRep FromTop "TB"
+ , stringRep FromLeft "LR"
+ , stringRep FromBottom "BT"
+ , stringRep FromRight "RL"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Shape
+ = BoxShape
+ | Polygon
+ | Ellipse
+ | Circle
+ | PointShape
+ | Egg
+ | Triangle
+ | Plaintext
+ | DiamondShape
+ | Trapezium
+ | Parallelogram
+ | House
+ | Pentagon
+ | Hexagon
+ | Septagon
+ | Octagon
+ | Doublecircle
+ | Doubleoctagon
+ | Tripleoctagon
+ | Invtriangle
+ | Invtrapezium
+ | Invhouse
+ | Mdiamond
+ | Msquare
+ | Mcircle
+ | Rectangle
+ | NoShape
+ | Note
+ | Tab
+ | Folder
+ | Box3d
+ | Component
+ deriving (Eq, Show, Read)
+
+instance PrintDot Shape where
+ unqtDot BoxShape = text "box"
+ unqtDot Polygon = text "polygon"
+ unqtDot Ellipse = text "ellipse"
+ unqtDot Circle = text "circle"
+ unqtDot PointShape = text "point"
+ unqtDot Egg = text "egg"
+ unqtDot Triangle = text "triangle"
+ unqtDot Plaintext = text "plaintext"
+ unqtDot DiamondShape = text "diamond"
+ unqtDot Trapezium = text "trapezium"
+ unqtDot Parallelogram = text "parallelogram"
+ unqtDot House = text "house"
+ unqtDot Pentagon = text "pentagon"
+ unqtDot Hexagon = text "hexagon"
+ unqtDot Septagon = text "septagon"
+ unqtDot Octagon = text "octagon"
+ unqtDot Doublecircle = text "doublecircle"
+ unqtDot Doubleoctagon = text "doubleoctagon"
+ unqtDot Tripleoctagon = text "tripleoctagon"
+ unqtDot Invtriangle = text "invtriangle"
+ unqtDot Invtrapezium = text "invtrapezium"
+ unqtDot Invhouse = text "invhouse"
+ unqtDot Mdiamond = text "Mdiamond"
+ unqtDot Msquare = text "Msquare"
+ unqtDot Mcircle = text "Mcircle"
+ unqtDot Rectangle = text "rectangle"
+ unqtDot NoShape = text "none"
+ unqtDot Note = text "note"
+ unqtDot Tab = text "tab"
+ unqtDot Folder = text "folder"
+ unqtDot Box3d = text "box3d"
+ unqtDot Component = text "component"
+
+instance ParseDot Shape where
+ parseUnqt = oneOf [ stringRep BoxShape "box"
+ , stringRep Polygon "polygon"
+ , stringRep Ellipse "ellipse"
+ , stringRep Circle "circle"
+ , stringRep PointShape "point"
+ , stringRep Egg "egg"
+ , stringRep Triangle "triangle"
+ , stringRep Plaintext "plaintext"
+ , stringRep DiamondShape "diamond"
+ , stringRep Trapezium "trapezium"
+ , stringRep Parallelogram "parallelogram"
+ , stringRep House "house"
+ , stringRep Pentagon "pentagon"
+ , stringRep Hexagon "hexagon"
+ , stringRep Septagon "septagon"
+ , stringRep Octagon "octagon"
+ , stringRep Doublecircle "doublecircle"
+ , stringRep Doubleoctagon "doubleoctagon"
+ , stringRep Tripleoctagon "tripleoctagon"
+ , stringRep Invtriangle "invtriangle"
+ , stringRep Invtrapezium "invtrapezium"
+ , stringRep Invhouse "invhouse"
+ , stringRep Mdiamond "Mdiamond"
+ , stringRep Msquare "Msquare"
+ , stringRep Mcircle "Mcircle"
+ , stringRep Rectangle "rectangle"
+ , stringRep NoShape "none"
+ , stringRep Note "note"
+ , stringRep Tab "tab"
+ , stringRep Folder "folder"
+ , stringRep Box3d "box3d"
+ , stringRep Component "component"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data SmoothType = NoSmooth
+ | AvgDist
+ | GraphDist
+ | PowerDist
+ | RNG
+ | Spring
+ | TriangleSmooth
+ deriving (Eq, Show, Read)
+
+instance PrintDot SmoothType where
+ unqtDot NoSmooth = text "none"
+ unqtDot AvgDist = text "avg_dist"
+ unqtDot GraphDist = text "graph_dist"
+ unqtDot PowerDist = text "power_dist"
+ unqtDot RNG = text "rng"
+ unqtDot Spring = text "spring"
+ unqtDot TriangleSmooth = text "triangle"
+
+instance ParseDot SmoothType where
+ parseUnqt = oneOf [ stringRep NoSmooth "none"
+ , stringRep AvgDist "avg_dist"
+ , stringRep GraphDist "graph_dist"
+ , stringRep PowerDist "power_dist"
+ , stringRep RNG "rng"
+ , stringRep Spring "spring"
+ , stringRep TriangleSmooth "triangle"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+-- | It is assumed that at least one of these is @Just{}@.
+data StartType = StartStyle STStyle
+ | StartSeed Int
+ | StartStyleSeed STStyle Int
+ deriving (Eq, Show, Read)
+
+instance PrintDot StartType where
+ unqtDot (StartStyle ss) = unqtDot ss
+ unqtDot (StartSeed s) = unqtDot s
+ unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s
+
+instance ParseDot StartType where
+ parseUnqt = oneOf [ do ss <- parseUnqt
+ s <- parseUnqt
+ return $ StartStyleSeed ss s
+ , liftM StartStyle parseUnqt
+ , liftM StartSeed parseUnqt
+ ]
+
+data STStyle = RegularStyle
+ | SelfStyle
+ | RandomStyle
+ deriving (Eq, Show, Read)
+
+instance PrintDot STStyle where
+ unqtDot RegularStyle = text "regular"
+ unqtDot SelfStyle = text "self"
+ unqtDot RandomStyle = text "random"
+
+instance ParseDot STStyle where
+ parseUnqt = oneOf [ stringRep RegularStyle "regular"
+ , stringRep SelfStyle "self"
+ , stringRep RandomStyle "random"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data StyleItem = SItem StyleName [String]
+ deriving (Eq, Show, Read)
+
+instance PrintDot StyleItem where
+ unqtDot (SItem nm args)
+ | null args = dnm
+ | otherwise = dnm <> parens args'
+ where
+ dnm = unqtDot nm
+ args' = hcat . punctuate comma $ map unqtDot args
+
+ toDot si@(SItem nm args)
+ | null args = toDot nm
+ | otherwise = doubleQuotes $ unqtDot si
+
+ unqtListToDot = hcat . punctuate comma . map unqtDot
+
+ listToDot [SItem nm []] = toDot nm
+ listToDot sis = doubleQuotes $ unqtListToDot sis
+
+instance ParseDot StyleItem where
+ parseUnqt = do nm <- parseUnqt
+ args <- tryParseList' parseArgs
+ return $ SItem nm args
+ where
+ parseArgs = bracketSep (character '(')
+ parseComma
+ (character ')')
+ parseStyleName
+
+ -- Ignore quotations for the DD case atm, since I'm not sure how
+ -- to deal with it.
+
+ parseUnqtList = sepBy1 parseUnqt parseComma
+
+ -- Might not necessarily need to be quoted if a singleton...
+ parseList = liftM return parse
+ `onFail`
+ parseUnqtList
+
+data StyleName = Dashed -- ^ Nodes and Edges
+ | Dotted -- ^ Nodes and Edges
+ | Solid -- ^ Nodes and Edges
+ | Bold -- ^ Nodes and Edges
+ | Invisible -- ^ Nodes and Edges
+ | Filled -- ^ Nodes and Clusters
+ | Diagonals -- ^ Nodes only
+ | Rounded -- ^ Nodes and Clusters
+ | DD String -- ^ Device Dependent
+ deriving (Eq, Show, Read)
+
+instance PrintDot StyleName where
+ unqtDot Filled = text "filled"
+ unqtDot Invisible = text "invis"
+ unqtDot Diagonals = text "diagonals"
+ unqtDot Rounded = text "rounded"
+ unqtDot Dashed = text "dashed"
+ unqtDot Dotted = text "dotted"
+ unqtDot Solid = text "solid"
+ unqtDot Bold = text "bold"
+ unqtDot (DD nm) = unqtDot nm
+
+ toDot (DD nm) = toDot nm
+ toDot sn = unqtDot sn
+
+instance ParseDot StyleName where
+ parseUnqt = oneOf [ stringRep Filled "filled"
+ , stringRep Invisible "invis"
+ , stringRep Diagonals "diagonals"
+ , stringRep Rounded "rounded"
+ , stringRep Dashed "dashed"
+ , stringRep Dotted "dotted"
+ , stringRep Solid "solid"
+ , stringRep Bold "bold"
+ , liftM DD parseStyleName
+ ]
+
+ -- Never used on its own, so not bothering with a separate parse
+ -- implementation (which is iffy due to the DD case).
+
+parseStyleName :: Parse String
+parseStyleName = do f <- noneOf ['(', ')', ',', ' ']
+ r <- many (noneOf ['(', ')', ','])
+ return $ f:r
+
+-- -----------------------------------------------------------------------------
+
+newtype PortPos = PP CompassPoint
+ deriving (Eq, Show, Read)
+
+instance PrintDot PortPos where
+ unqtDot (PP cp) = unqtDot cp
+
+ toDot (PP cp) = toDot cp
+
+instance ParseDot PortPos where
+ parseUnqt = liftM PP parseUnqt
+
+data CompassPoint = North
+ | NorthEast
+ | East
+ | SouthEast
+ | South
+ | SouthWest
+ | West
+ | NorthWest
+ | CenterPoint
+ | NoCP
+ deriving (Eq, Show, Read)
+
+instance PrintDot CompassPoint where
+ unqtDot NorthEast = text "ne"
+ unqtDot NorthWest = text "nw"
+ unqtDot North = text "n"
+ unqtDot East = text "e"
+ unqtDot SouthEast = text "se"
+ unqtDot SouthWest = text "sw"
+ unqtDot South = text "s"
+ unqtDot West = text "w"
+ unqtDot CenterPoint = text "c"
+ unqtDot NoCP = text "_"
+
+instance ParseDot CompassPoint where
+ parseUnqt = oneOf [ stringRep North "n"
+ , stringRep NorthEast "ne"
+ , stringRep East "e"
+ , stringRep SouthEast "se"
+ , stringRep South "s"
+ , stringRep SouthWest "sw"
+ , stringRep West "w"
+ , stringRep NorthWest "nw"
+ , stringRep CenterPoint "c"
+ , stringRep NoCP "_"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data ViewPort = VP { wVal :: Double
+ , hVal :: Double
+ , zVal :: Double
+ , focus :: Maybe FocusType
+ }
+ deriving (Eq, Show, Read)
+
+instance PrintDot ViewPort where
+ unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot)
+ $ focus vp
+ where
+ vs = hcat . punctuate comma
+ $ map (unqtDot . flip ($) vp) [wVal, hVal, zVal]
+
+ toDot = doubleQuotes . unqtDot
+
+instance ParseDot ViewPort where
+ parseUnqt = do wv <- parseUnqt
+ parseComma
+ hv <- parseUnqt
+ parseComma
+ zv <- parseUnqt
+ mf <- optional $ parseComma >> parseUnqt
+ return $ VP wv hv zv mf
+
+ parse = quotedParse parseUnqt
+
+data FocusType = XY Point
+ | NodeFocus String
+ deriving (Eq, Show, Read)
+
+instance PrintDot FocusType where
+ unqtDot (XY p) = unqtDot p
+ unqtDot (NodeFocus nm) = unqtDot nm
+
+ toDot (XY p) = toDot p
+ toDot (NodeFocus nm) = toDot nm
+
+instance ParseDot FocusType where
+ parseUnqt = liftM XY parseUnqt
+ `onFail`
+ liftM NodeFocus stringBlock
+
+-- -----------------------------------------------------------------------------
+
+data VerticalPlacement = VTop
+ | VCenter -- ^ Only valid for Nodes.
+ | VBottom
+ deriving (Eq, Show, Read)
+
+instance PrintDot VerticalPlacement where
+ unqtDot VTop = char 't'
+ unqtDot VCenter = char 'c'
+ unqtDot VBottom = char 'b'
+
+instance ParseDot VerticalPlacement where
+ parseUnqt = oneOf [ stringRep VTop "t"
+ , stringRep VCenter "c"
+ , stringRep VBottom "b"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data ScaleType = UniformScale
+ | NoScale
+ | FillWidth
+ | FillHeight
+ | FillBoth
+ deriving (Eq, Show, Read)
+
+instance PrintDot ScaleType where
+ unqtDot UniformScale = unqtDot True
+ unqtDot NoScale = unqtDot False
+ unqtDot FillWidth = text "width"
+ unqtDot FillHeight = text "height"
+ unqtDot FillBoth = text "both"
+
+instance ParseDot ScaleType where
+ parseUnqt = oneOf [ stringRep UniformScale "true"
+ , stringRep NoScale "false"
+ , stringRep FillWidth "width"
+ , stringRep FillHeight "height"
+ , stringRep FillBoth "both"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Justification = JLeft
+ | JRight
+ | JCenter
+ deriving (Eq, Show, Read)
+
+instance PrintDot Justification where
+ unqtDot JLeft = char 'l'
+ unqtDot JRight = char 'r'
+ unqtDot JCenter = char 'c'
+
+instance ParseDot Justification where
+ parseUnqt = oneOf [ stringRep JLeft "l"
+ , stringRep JRight "r"
+ , stringRep JCenter "c"
+ ]
+
+-- -----------------------------------------------------------------------------
+
+data Ratios = AspectRatio Double
+ | FillRatio
+ | CompressRatio
+ | ExpandRatio
+ | AutoRatio
+ deriving (Eq, Show, Read)
+
+instance PrintDot Ratios where
+ unqtDot (AspectRatio r) = unqtDot r
+ unqtDot FillRatio = text "fill"
+ unqtDot CompressRatio = text "compress"
+ unqtDot ExpandRatio = text "expand"
+ unqtDot AutoRatio = text "auto"
+
+instance ParseDot Ratios where
+ parseUnqt = oneOf [ liftM AspectRatio parseUnqt
+ , stringRep FillRatio "fill"
+ , stringRep CompressRatio "compress"
+ , stringRep ExpandRatio "expand"
+ , stringRep AutoRatio "auto"
+ ]
diff --git a/Data/GraphViz/Commands.hs b/Data/GraphViz/Commands.hs
--- a/Data/GraphViz/Commands.hs
+++ b/Data/GraphViz/Commands.hs
@@ -33,6 +33,7 @@
import Control.Exception.Extensible
import Data.GraphViz.Types
+import Data.GraphViz.Types.Printing
-- | The available Graphviz commands.
data GraphvizCommand = Dot | Neato | TwoPi | Circo | Fdp
@@ -53,7 +54,7 @@
undirCommand = Neato
-- | The appropriate (default) GraphViz command for the given graph.
-commandFor :: DotGraph -> GraphvizCommand
+commandFor :: DotGraph a -> GraphvizCommand
commandFor dg = if (directedGraph dg)
then dirCommand
else undirCommand
@@ -149,14 +150,15 @@
-- | Run the recommended Graphviz command on this graph, saving the result
-- to the file provided (note: file extensions are /not/ checked).
-- Returns @True@ if successful, @False@ otherwise.
-runGraphviz :: DotGraph -> GraphvizOutput -> FilePath -> IO Bool
+runGraphviz :: (PrintDot n) => DotGraph n -> GraphvizOutput -> FilePath
+ -> IO Bool
runGraphviz gr t fp = runGraphvizCommand (commandFor gr) gr t fp
-- | Run the chosen Graphviz command on this graph, saving the result
-- to the file provided (note: file extensions are /not/ checked).
-- Returns @True@ if successful, @False@ otherwise.
-runGraphvizCommand :: GraphvizCommand -> DotGraph -> GraphvizOutput
- -> FilePath -> IO Bool
+runGraphvizCommand :: (PrintDot n) => GraphvizCommand -> DotGraph n
+ -> GraphvizOutput -> FilePath -> IO Bool
runGraphvizCommand cmd gr t fp
= do pipe <- tryJust (\(SomeException _) -> return ())
$ openFile fp WriteMode
@@ -174,11 +176,11 @@
-- | Run the chosen Graphviz command on this graph, but send the result to the
-- given handle rather than to a file.
-- The result is wrapped in 'Maybe' rather than throwing an error.
-graphvizWithHandle :: (Show a) => GraphvizCommand -> DotGraph -> GraphvizOutput
- -> (Handle -> IO a) -> IO (Maybe a)
+graphvizWithHandle :: (PrintDot n, Show a) => GraphvizCommand -> DotGraph n
+ -> GraphvizOutput -> (Handle -> IO a) -> IO (Maybe a)
graphvizWithHandle cmd gr t f
= do (inp, outp, errp, prc) <- runInteractiveCommand command
- forkIO $ hPrint inp gr >> hClose inp
+ forkIO $ hPutStrLn inp (printDotGraph gr) >> hClose inp
forkIO $ (hGetContents errp >>= hPutStr stderr >> hClose errp)
a <- f outp
-- Don't close outp until f finishes.
diff --git a/Data/GraphViz/ParserCombinators.hs b/Data/GraphViz/ParserCombinators.hs
deleted file mode 100644
--- a/Data/GraphViz/ParserCombinators.hs
+++ /dev/null
@@ -1,239 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-{- |
- Module : Data.GraphViz.ParserCombinators
- Description : Helper functions for Parsing.
- Copyright : (c) Matthew Sackman, Ivan Lazar Miljenovic
- License : 3-Clause BSD-style
- Maintainer : Ivan.Miljenovic@gmail.com
-
- This module defines simple helper functions for use with
- "Text.ParserCombinators.Poly.Lazy".
-
- Note that the 'Parseable' instances for 'Bool', etc. match those
- specified for use with GraphViz (e.g. non-zero integers are
- equivalent to 'True').
-
- You should not be using this module; rather, it is here for
- informative/documentative reasons. If you want to parse a
- @'Data.GraphViz.Types.DotGraph'@, you should use
- @'Data.GraphViz.Types.parseDotGraph'@ rather than its 'Parseable'
- instance.
-
--}
-
-module Data.GraphViz.ParserCombinators
- ( module Text.ParserCombinators.Poly.Lazy
- , Parse
- , Parseable(..)
- , stringBlock
- , quotedString
- , parseAndSpace
- , string
- , strings
- , hasString
- , char
- , whitespace
- , whitespace'
- , optionalQuotedString
- , optionalQuoted
- , quotedParse
- , newline
- , skipToNewline
- , parseField
- , parseBoolField
- , parseFieldDef
- , commaSep
- , commaSep'
- ) where
-
-import Text.ParserCombinators.Poly.Lazy
-import Data.Char( digitToInt
- , isAsciiLower
- , isAsciiUpper
- , isDigit
- , isSpace
- , toLower
- )
-import Data.Function(on)
-import Data.Maybe(isJust)
-import Data.Ratio((%))
-import Control.Monad
-
--- -----------------------------------------------------------------------------
--- Based off code from Text.Parse in the polyparse library
-
--- | A @ReadS@-like type alias.
-type Parse a = Parser Char a
-
-class Parseable a where
- parse :: Parse a
-
- parseList :: Parse [a]
- parseList = oneOf [ char '[' >> whitespace' >> char ']' >> return []
- , bracketSep (parseAndSpace $ char '[')
- (parseAndSpace $ char ',')
- (parseAndSpace $ char ']')
- (parseAndSpace parse)
- ]
-
-instance Parseable Int where
- parse = parseInt
-
-instance Parseable Double where
- parse = parseSigned parseFloat
-
-instance Parseable Bool where
- parse = oneOf [ string "true" >> return True
- , string "false" >> return False
- , liftM (zero /=) parseInt
- ]
- where
- zero :: Int
- zero = 0
-
-instance Parseable Char where
- parse = next
-
- parseList = oneOf [ stringBlock
- , quotedString
- ]
-
--- | Used when quotes are explicitly required;
--- note that the quotes are not stripped off.
-
-instance (Parseable a) => Parseable [a] where
- parse = parseList
-
-stringBlock :: Parse String
-stringBlock = do frst <- satisfy frstCond
- rest <- many (satisfy restCond)
- return $ frst : rest
- where
- frstCond c = any ($c) [ isAsciiUpper
- , isAsciiLower
- , (==) '_'
- , \ x -> x >= '\200' && x <= '\377'
- ]
- restCond c = frstCond c || isDigit c
-
-quotedString :: Parse String
-quotedString = do w <- word
- if head w == '"'
- then return w
- else fail $ "Not a quoted string: " ++ w
-
-word :: Parse String
-word = P (\s-> case lex s of
- [] -> Failure s "no input? (impossible)"
- [("","")] -> Failure "" "no input?"
- [("",s')] -> Failure s' "lexing failed?"
- ((x,s'):_) -> Success s' x
- )
-
-parseSigned :: Real a => Parse a -> Parse a
-parseSigned p = do '-' <- next; commit (fmap negate p)
- `onFail`
- p
-
-parseInt :: (Integral a) => Parse a
-parseInt = do cs <- many1 (satisfy isDigit)
- return (foldl1 (\n d-> n*radix+d)
- (map (fromIntegral . digitToInt) cs))
- `adjustErr` (++ "\nexpected one or more digits")
- where
- radix = 10
-
-parseFloat :: (RealFrac a) => Parse a
-parseFloat = do ds <- many1 (satisfy isDigit)
- frac <- (do '.' <- next
- many (satisfy isDigit)
- `adjustErrBad` (++"expected digit after .")
- `onFail` return [] )
- expn <- parseExp `onFail` return 0
- ( return . fromRational . (* (10^^(expn - length frac)))
- . (%1) . fst
- . runParser parseInt) (ds++frac)
- `onFail`
- do w <- many (satisfy (not.isSpace))
- case map toLower w of
- "nan" -> return (0/0)
- "infinity" -> return (1/0)
- _ -> fail "expected a floating point number"
- where parseExp = do 'e' <- fmap toLower next
- commit (do '+' <- next; parseInt
- `onFail`
- parseSigned parseInt)
-
--- -----------------------------------------------------------------------------
-
-parseAndSpace :: Parse a -> Parse a
-parseAndSpace p = p `discard` whitespace'
-
-string :: String -> Parse String
-string = mapM char
-
-strings :: [String] -> Parse String
-strings = oneOf . map string
-
-hasString :: String -> Parse Bool
-hasString = liftM isJust . optional . string
-
-char :: Char -> Parse Char
-char c = satisfy (((==) `on` toLower) c)
- `adjustErr`
- (++ "\nnot the expected char: " ++ [c])
-
-noneOf :: (Eq a) => [a] -> Parser a a
-noneOf t = satisfy (\x -> all (/= x) t)
-
-whitespace :: Parse String
-whitespace = many1 (satisfy isSpace)
-
-whitespace' :: Parse String
-whitespace' = many (satisfy isSpace)
-
-optionalQuotedString :: String -> Parse String
-optionalQuotedString = optionalQuoted . string
-
-optionalQuoted :: Parse a -> Parse a
-optionalQuoted p = oneOf [ p
- , quotedParse p
- ]
-
-quotedParse :: Parse a -> Parse a
-quotedParse p = char '"' >> p `discard` char '"'
-
-newline :: Parse String
-newline = oneOf . map string $ ["\r\n", "\n", "\r"]
-
-skipToNewline :: Parse ()
-skipToNewline = many (noneOf ['\n','\r']) >> newline >> return ()
-
-parseField :: (Parseable a) => String -> Parse a
-parseField fld = do string fld
- whitespace'
- char '='
- whitespace'
- parse
-
-parseBoolField :: String -> Parse Bool
-parseBoolField = parseFieldDef True
-
--- | For 'Bool'-like data structures where the presence of the field
--- name without a value implies a default value.
-parseFieldDef :: (Parseable a) => a -> String -> Parse a
-parseFieldDef d fld = oneOf [ parseField fld
- , string fld >> return d
- ]
-
-commaSep :: (Parseable a, Parseable b) => Parse (a, b)
-commaSep = commaSep' parse parse
-
-commaSep' :: Parse a -> Parse b -> Parse (a,b)
-commaSep' pa pb = do a <- pa
- whitespace'
- char ','
- whitespace'
- b <- pb
- return (a,b)
diff --git a/Data/GraphViz/Types.hs b/Data/GraphViz/Types.hs
--- a/Data/GraphViz/Types.hs
+++ b/Data/GraphViz/Types.hs
@@ -9,246 +9,599 @@
with them for the GraphViz library. The specifications are based
loosely upon the information available at:
--}
+ Printing of /Dot/ code is done as strictly as possible, whilst
+ parsing is as permissive as possible. For example, if the types
+ allow it then @\"2\"@ will be parsed as an 'Int' value. Note that
+ quoting and escaping of 'String' values is done automagically.
+
+ A summary of known limitations\/differences:
+
+ * When creating 'GraphID' values for 'graphID' and 'subGraphID',
+ you should ensure that none of them have the same printed value
+ as one of the 'nodeID' values to avoid any possible problems.
+
+ * Whilst 'DotGraph', etc. are polymorphic in their node type, you
+ should ensure that you use a relatively simple node type (that
+ is, it only covers a single line, etc.).
+
+ * Also, whilst GraphViz allows you to mix the types used for nodes,
+ this library requires\/assumes that they are all the same type.
+
+ * 'DotEdge' defines an edge @(a, b)@ (with an edge going from @a@
+ to @b@); in /Dot/ parlance the edge has a head at @a@ and a tail
+ at @b@. Care must be taken when using the related @Head*@ and
+ @Tail*@ 'Attribute's. See the differences section in
+ "Data.GraphViz.Attributes" for more information.
+
+ * It is common to see multiple edges defined on the one line in Dot
+ (e.g. @n1 -> n2 -> n3@ means to create a directed edge from @n1@
+ to @n2@ and from @n2@ to @n3@). These types of edge definitions
+ are parseable; however, they are converted to singleton edges.
+
+ * Cannot create edges with subgraphs\/clusters as one of the
+ end points.
+
+ * When either creating a 'DotGraph' by hand or parsing one, it is
+ possible to specify that @'directedGraph' = d@, but at lease one
+ 'DotEdge' has @'directedEdge' = 'not' d@.
+
+ * Nodes cannot have Port values.
+
+ * Cannot place items in an arbitrary order: in particular, this
+ means that it is not possible to use the normal GraphViz hack of
+ having graph attributes that do not apply to subgraphs\/clusters
+ by listing them /after/ the subgraphs\/clusters.
+
+ * The parser cannot as yet parse comments (in that it doesn't even
+ know what comments are, and will throw an error). Multiline
+ statements and C pre-processor lines (that is, lines beginning
+ with a @#@) are also not parseable.
+
+ See "Data.GraphViz.Attributes" for more limitations.
+
+-}
module Data.GraphViz.Types
- ( DotGraph(..)
- , GraphID(..)
- , DotNode(..)
- , DotEdge(..)
+ ( -- * The overall representation of a graph in /Dot/ format.
+ DotGraph(..)
+ -- ** Printing and parsing a @DotGraph@.
+ , printDotGraph
, parseDotGraph
+ -- ** Functions acting on a @DotGraph@.
, setID
, makeStrict
+ , graphNodes
+ , graphEdges
+ -- ** Reporting of errors in a @DotGraph@.
+ , DotError(..)
, isValidGraph
- , invalidAttributes
+ , graphErrors
+ -- * Sub-components of a @DotGraph@.
+ , GraphID(..)
+ , DotStatements(..)
+ , GlobalAttributes(..)
+ , DotSubGraph(..)
+ , DotNode(..)
+ , DotEdge(..)
) where
import Data.GraphViz.Attributes
-import Data.GraphViz.ParserCombinators
+import Data.GraphViz.Types.Internal
+import Data.GraphViz.Types.Parsing
+import Data.GraphViz.Types.Printing
-import Data.Maybe
-import Control.Monad
+import Data.Maybe(isJust)
+import Control.Monad(liftM)
-- -----------------------------------------------------------------------------
-- | The internal representation of a graph in Dot form.
-data DotGraph = DotGraph { strictGraph :: Bool
- , directedGraph :: Bool
- , graphID :: Maybe GraphID
- , graphAttributes :: [Attribute]
- , graphNodes :: [DotNode]
- , graphEdges :: [DotEdge]
- }
- deriving (Eq, Read)
+data DotGraph a = DotGraph { strictGraph :: Bool -- ^ If 'True', no multiple edges are drawn.
+ , directedGraph :: Bool
+ , graphID :: Maybe GraphID
+ , graphStatements :: DotStatements a
+ }
+ deriving (Eq, Show, Read)
-- | A strict graph disallows multiple edges.
-makeStrict :: DotGraph -> DotGraph
+makeStrict :: DotGraph a -> DotGraph a
makeStrict g = g { strictGraph = True }
-setID :: GraphID -> DotGraph -> DotGraph
+-- | Set the ID of the graph.
+setID :: GraphID -> DotGraph a -> DotGraph a
setID i g = g { graphID = Just i }
--- | Check if all the @Attribute@s are being used correctly.
-isValidGraph :: DotGraph -> Bool
-isValidGraph g = null gas && null nas && null eas
- where
- (gas, nas, eas) = invalidAttributes g
+-- | Return all the 'DotNode's contained within this 'DotGraph'. Note
+-- that it does not yet return all implicitly defined nodes
+-- contained only within 'DotEdge's.
+graphNodes :: DotGraph a -> [DotNode a]
+graphNodes = statementNodes . graphStatements
--- | Return all those @Attribute@s which aren't being used properly.
-invalidAttributes :: DotGraph -> ( [Attribute]
- , [(DotNode, Attribute)]
- , [(DotEdge, Attribute)]
- )
-invalidAttributes g = ( invalidGraphAttributes g
- , concatMap invalidNodeAttributes $ graphNodes g
- , concatMap invalidEdgeAttributes $ graphEdges g
- )
+-- | Return all the 'DotEdge's contained within this 'DotGraph'.
+graphEdges :: DotGraph a -> [DotEdge a]
+graphEdges = statementEdges . graphStatements
-invalidGraphAttributes :: DotGraph -> [Attribute]
-invalidGraphAttributes = filter (not . usedByGraphs) . graphAttributes
+-- | The actual /Dot/ code for a 'DotGraph'. Note that it is expected
+-- that @'parseDotGraph' . 'printDotGraph' == 'id'@ (this might not
+-- be true the other way around due to un-parseable components).
+printDotGraph :: (PrintDot a) => DotGraph a -> String
+printDotGraph = renderDot . toDot
-instance Show DotGraph where
- show g
- = unlines $ (hdr ++ " {") : (rest ++ ["}"])
- where
- hdr = strct . addId $ gType
- strct = if strictGraph g
- then ("strict " ++)
- else id
- addId = maybe id (\ i -> flip (++) $ ' ' : show i) $ graphID g
- gType = if directedGraph g then dirGraph else undirGraph
- rest = case graphAttributes g of
- [] -> nodesEdges
- a -> ("\tgraph " ++ show a ++ ";") : nodesEdges
- nodesEdges = map show (graphNodes g) ++ map show (graphEdges g)
+-- | Parse a limited subset of the Dot language to form a 'DotGraph'
+-- (that is, the caveats listed in "Data.GraphViz.Attributes" aside,
+-- Dot graphs are parsed if they match the layout of 'DotGraph').
+parseDotGraph :: (ParseDot a) => String -> DotGraph a
+parseDotGraph = fst . runParser parse
+-- | Check if all the 'Attribute's are being used correctly.
+isValidGraph :: DotGraph a -> Bool
+isValidGraph = null . graphErrors
+
+-- | Return detectable errors in the 'DotGraph'.
+graphErrors :: DotGraph a -> [DotError a]
+graphErrors = invalidStmts usedByGraphs . graphStatements
+
+instance (PrintDot a) => PrintDot (DotGraph a) where
+ unqtDot = printStmtBased printGraphID graphStatements
+
+printGraphID :: (PrintDot a) => DotGraph a -> DotCode
+printGraphID g = bool strGraph' empty (strictGraph g)
+ <+> bool dirGraph' undirGraph' (directedGraph g)
+ <+> maybe empty toDot (graphID g)
+
+instance (ParseDot a) => ParseDot (DotGraph a) where
+ parseUnqt = parseStmtBased parseGraphID
+
+ parse = parseUnqt -- Don't want the option of quoting
+ `adjustErr`
+ (++ "\n\nNot a valid DotGraph")
+
+parseGraphID :: (ParseDot a) => Parse (DotStatements a -> DotGraph a)
+parseGraphID = do str <- liftM isJust
+ $ optional (parseAndSpace $ string strGraph)
+ dir <- parseAndSpace ( stringRep True dirGraph
+ `onFail`
+ stringRep False undirGraph
+ )
+ gID <- optional parse
+ return $ DotGraph str dir gID
+
dirGraph :: String
dirGraph = "digraph"
+dirGraph' :: DotCode
+dirGraph' = text dirGraph
+
undirGraph :: String
undirGraph = "graph"
--- | Parse a limited subset of the Dot language to form a 'DotGraph'
--- (that is, the caveats listed in "Data.GraphViz.Attributes" aside,
--- Dot graphs are parsed if they match the layout of DotGraph).
-parseDotGraph :: Parse DotGraph
-parseDotGraph = parse
+undirGraph' :: DotCode
+undirGraph' = text undirGraph
-instance Parseable DotGraph where
- parse = do isStrict <- parseAndSpace $ hasString "strict"
- gType <- strings [dirGraph,undirGraph]
- gId <- optional (parse `discard` whitespace)
- whitespace
- char '{'
- skipToNewline
- as <- liftM concat $
- many (whitespace' >>
- oneOf [ string "edge" >> skipToNewline >> return []
- , string "node" >> skipToNewline >> return []
- , string "graph" >> whitespace
- >> parse `discard` skipToNewline
- ]
- )
- ns <- many1 (whitespace' >> parse `discard` skipToNewline)
- es <- many1 (whitespace' >> parse `discard` skipToNewline)
- char '}'
- return DotGraph { strictGraph = isStrict
- , directedGraph = gType == dirGraph
- , graphID = gId
- , graphAttributes = as
- , graphNodes = ns
- , graphEdges = es
- }
+strGraph :: String
+strGraph = "strict"
- `adjustErr`
- (++ "\nNot a valid DotGraph")
+strGraph' :: DotCode
+strGraph' = text strGraph
+instance Functor DotGraph where
+ fmap f g = g { graphStatements = fmap f $ graphStatements g }
+
-- -----------------------------------------------------------------------------
+-- | Used to record invalid 'Attribute' usage. A 'Just' value denotes
+-- that it was used in an explicit 'DotNode' or 'DotEdge' usage;
+-- 'Nothing' means that it was used in a 'GlobalAttributes' value.
+data DotError a = GraphError Attribute
+ | NodeError (Maybe a) Attribute
+ | EdgeError (Maybe (a,a)) Attribute
+ deriving (Eq, Show, Read)
+
+-- -----------------------------------------------------------------------------
+
+-- | A polymorphic type that covers all possible ID values allowed by
+-- Dot syntax. Note that whilst the 'ParseDot' and 'PrintDot'
+-- instances for 'String' will properly take care of the special
+-- cases for numbers, they are treated differently here.
data GraphID = Str String
- | Num Double
- | QStr QuotedString
+ | Int Int
+ | Dbl Double
| HTML URL
- deriving (Eq, Read)
+ deriving (Eq, Show, Read)
-instance Show GraphID where
- show (Str str) = str
- show (Num n) = show n
- show (QStr str) = show str
- show (HTML url) = show url
+instance PrintDot GraphID where
+ unqtDot (Str str) = unqtDot str
+ unqtDot (Int i) = unqtDot i
+ unqtDot (Dbl d) = unqtDot d
+ unqtDot (HTML u) = unqtDot u
-instance Parseable GraphID where
- parse = oneOf [ liftM Str stringBlock
- , liftM Num parse
- , liftM QStr parse
+ toDot (Str str) = toDot str
+ toDot gID = unqtDot gID
+
+instance ParseDot GraphID where
+ parseUnqt = oneOf [ liftM Str parseUnqt
+ , liftM Int parseUnqt
+ , liftM Dbl parseUnqt
+ , liftM HTML parseUnqt
+ ]
+
+ parse = oneOf [ liftM Int parse
+ , liftM Dbl parse
, liftM HTML parse
+ -- Parse last so that quoted numbers are parsed as numbers.
+ , liftM Str parse
]
`adjustErr`
- (++ "\nNot a valid GraphID")
+ (++ "Not a valid GraphID")
-- -----------------------------------------------------------------------------
--- | A node in 'DotGraph' is either a singular node, or a cluster
--- containing nodes (or more clusters) within it.
--- At the moment, clusters are not parsed.
-data DotNode
- = DotNode { nodeID :: Int
- , nodeAttributes :: [Attribute]
- }
- | DotCluster { clusterID :: String
- , clusterAttributes :: [Attribute]
- , clusterElems :: [DotNode]
- }
- deriving (Eq, Read)
+data DotStatements a = DotStmts { attrStmts :: [GlobalAttributes]
+ , subGraphs :: [DotSubGraph a]
+ , nodeStmts :: [DotNode a]
+ , edgeStmts :: [DotEdge a]
+ }
+ deriving (Eq, Show, Read)
-invalidNodeAttributes :: DotNode -> [(DotNode, Attribute)]
-invalidNodeAttributes n@DotNode{} = map ((,) n)
- . filter (not . usedByNodes)
- $ nodeAttributes n
-invalidNodeAttributes c@DotCluster{} = cErr ++ nErr
+instance (PrintDot a) => PrintDot (DotStatements a) where
+ unqtDot stmts = vcat [ toDot $ attrStmts stmts
+ , toDot $ subGraphs stmts
+ , toDot $ nodeStmts stmts
+ , toDot $ edgeStmts stmts
+ ]
+
+instance (ParseDot a) => ParseDot (DotStatements a) where
+ parseUnqt = do atts <- tryParseList
+ newline'
+ sGraphs <- tryParseList
+ newline'
+ nodes <- tryParseList
+ newline'
+ edges <- tryParseList
+ return $ DotStmts atts sGraphs nodes edges
+
+ parse = parseUnqt -- Don't want the option of quoting
+ `adjustErr`
+ (++ "Not a valid set of statements")
+
+instance Functor DotStatements where
+ fmap f stmts = stmts { subGraphs = map (fmap f) $ subGraphs stmts
+ , nodeStmts = map (fmap f) $ nodeStmts stmts
+ , edgeStmts = map (fmap f) $ edgeStmts stmts
+ }
+
+printStmtBased :: (PrintDot n) => (a -> DotCode)
+ -> (a -> DotStatements n) -> a -> DotCode
+printStmtBased ff fss a = vcat [ ff a <+> lbrace
+ , ind stmts
+ , rbrace
+ ]
where
- cErr = map ((,) c) . filter (not . usedByClusters)
- $ clusterAttributes c
- nErr = concatMap invalidNodeAttributes $ clusterElems c
+ ind = nest 4
+ stmts = toDot $ fss a
-instance Show DotNode where
- show = init . unlines . addTabs . nodesToString
+printStmtBasedList :: (PrintDot n) => (a -> DotCode)
+ -> (a -> DotStatements n) -> [a] -> DotCode
+printStmtBasedList ff fss = vcat . map (printStmtBased ff fss)
-nodesToString :: DotNode -> [String]
-nodesToString n@(DotNode {})
- | null nAs = [nID ++ ";"]
- | otherwise = [nID ++ (' ':(show nAs ++ ";"))]
+parseStmtBased :: (ParseDot n) => Parse (DotStatements n -> a) -> Parse a
+parseStmtBased p = do f <- p
+ whitespace'
+ character '{'
+ newline'
+ stmts <- parse
+ newline'
+ whitespace'
+ character '}'
+ return $ f stmts
+ `adjustErr`
+ (++ "\n\nNot a valid statement-based structure")
+
+parseStmtBasedList :: (ParseDot n) => Parse (DotStatements n -> a)
+ -> Parse [a]
+parseStmtBasedList p = sepBy (whitespace' >> parseStmtBased p) newline'
+
+-- | The function represents which function to use to check the
+-- 'GraphAttrs' values.
+invalidStmts :: (Attribute -> Bool) -> DotStatements a -> [DotError a]
+invalidStmts f stmts = concatMap (invalidGlobal f) (attrStmts stmts)
+ ++ concatMap invalidSubGraph (subGraphs stmts)
+ ++ concatMap invalidNode (nodeStmts stmts)
+ ++ concatMap invalidEdge (edgeStmts stmts)
+
+statementNodes :: DotStatements a -> [DotNode a]
+statementNodes stmts = concatMap subGraphNodes (subGraphs stmts)
+ ++ nodeStmts stmts
+
+statementEdges :: DotStatements a -> [DotEdge a]
+statementEdges stmts = concatMap subGraphEdges (subGraphs stmts)
+ ++ edgeStmts stmts
+
+-- -----------------------------------------------------------------------------
+
+-- | Represents a list of top-level list of 'Attribute's for the
+-- entire graph/sub-graph. Note that 'GraphAttrs' also applies to
+-- 'DotSubGraph's.
+--
+-- Note that Dot allows a single 'Attribute' to be listen on a line;
+-- if this is the case then when parsing, the type of 'Attribute' it
+-- is determined and that type of 'GlobalAttribute' is created.
+data GlobalAttributes = GraphAttrs { attrs :: Attributes }
+ | NodeAttrs { attrs :: Attributes }
+ | EdgeAttrs { attrs :: Attributes }
+ deriving (Eq, Show, Read)
+
+instance PrintDot GlobalAttributes where
+ unqtDot = printAttrBased printGlobAttrType attrs
+
+ unqtListToDot = printAttrBasedList printGlobAttrType attrs
+
+ listToDot = unqtListToDot
+
+printGlobAttrType :: GlobalAttributes -> DotCode
+printGlobAttrType GraphAttrs{} = text "graph"
+printGlobAttrType NodeAttrs{} = text "node"
+printGlobAttrType EdgeAttrs{} = text "edge"
+
+instance ParseDot GlobalAttributes where
+ parseUnqt = parseAttrBased parseGlobAttrType
+ `onFail`
+ liftM determineType parse `discard` optional lineEnd
+
+ parse = parseUnqt -- Don't want the option of quoting
+ `adjustErr`
+ (++ "\n\nNot a valid listing of global attributes")
+
+ -- Have to do this manually because of the special case
+ parseUnqtList = sepBy (whitespace' >> parse) newline'
+
+ parseList = parseUnqtList
+
+parseGlobAttrType :: Parse (Attributes -> GlobalAttributes)
+parseGlobAttrType = oneOf [ stringRep GraphAttrs "graph"
+ , stringRep NodeAttrs "node"
+ , stringRep EdgeAttrs "edge"
+ ]
+
+determineType :: Attribute -> GlobalAttributes
+determineType attr
+ | usedByGraphs attr = GraphAttrs attr'
+ | usedByClusters attr = GraphAttrs attr' -- Also covers SubGraph case
+ | usedByNodes attr = NodeAttrs attr'
+ | otherwise = EdgeAttrs attr' -- Must be for edges.
where
- nID = show $ nodeID n
- nAs = nodeAttributes n
-nodesToString c@(DotCluster {})
- = ["subgraph cluster_" ++ clusterID c ++ " {"] ++ addTabs inner ++ ["}"]
+ attr' = [attr]
+
+invalidGlobal :: (Attribute -> Bool) -> GlobalAttributes
+ -> [DotError a]
+invalidGlobal f (GraphAttrs as) = map GraphError $ filter (not . f) as
+invalidGlobal _ (NodeAttrs as) = map (NodeError Nothing)
+ $ filter (not . usedByNodes) as
+invalidGlobal _ (EdgeAttrs as) = map (EdgeError Nothing)
+ $ filter (not . usedByEdges) as
+
+-- -----------------------------------------------------------------------------
+
+data DotSubGraph a = DotSG { isCluster :: Bool
+ , subGraphID :: Maybe GraphID
+ , subGraphStmts :: DotStatements a
+ }
+ deriving (Eq, Show, Read)
+
+instance (PrintDot a) => PrintDot (DotSubGraph a) where
+ unqtDot = printStmtBased printSubGraphID subGraphStmts
+
+ unqtListToDot = printStmtBasedList printSubGraphID subGraphStmts
+
+ listToDot = unqtListToDot
+
+printSubGraphID :: DotSubGraph a -> DotCode
+printSubGraphID s = sGraph'
+ <+> bool clust' empty isCl
+ <> maybe empty dtID (subGraphID s)
where
- inner = case clusterAttributes c of
- [] -> nodes
- a -> ("graph " ++ show a ++ ";") : nodes
- nodes = concatMap nodesToString $ clusterElems c
+ isCl = isCluster s
+ dtID sId = bool (char '_') space isCl
+ <> toDot sId
+instance (ParseDot a) => ParseDot (DotSubGraph a) where
+ parseUnqt = parseStmtBased parseSubGraphID
-instance Parseable DotNode where
- parse = do nId <- parse
- as <- optional (whitespace >> parse)
- char ';'
- return DotNode { nodeID = nId
- , nodeAttributes = fromMaybe [] as }
+ parse = parseUnqt -- Don't want the option of quoting
`adjustErr`
- (++ "\nNot a valid DotNode")
+ (++ "\n\nNot a valid Sub Graph")
--- | Prefix each 'String' with a tab character.
-addTabs :: [String] -> [String]
-addTabs = map ('\t':)
+ parseUnqtList = parseStmtBasedList parseSubGraphID
+ parseList = parseUnqtList
+
+parseSubGraphID :: Parse (DotStatements a -> DotSubGraph a)
+parseSubGraphID = do string sGraph
+ whitespace'
+ isCl <- liftM isJust
+ $ optional (string clust)
+ `discard` optional (character '_')
+ sId <- optional parse
+ return $ DotSG isCl sId
+
+sGraph :: String
+sGraph = "subgraph"
+
+sGraph' :: DotCode
+sGraph' = text sGraph
+
+clust :: String
+clust = "cluster"
+
+clust' :: DotCode
+clust' = text clust
+
+instance Functor DotSubGraph where
+ fmap f sg = sg { subGraphStmts = fmap f $ subGraphStmts sg }
+
+invalidSubGraph :: DotSubGraph a -> [DotError a]
+invalidSubGraph sg = invalidStmts valFunc (subGraphStmts sg)
+ where
+ valFunc = bool usedByClusters usedBySubGraphs (isCluster sg)
+
+subGraphNodes :: DotSubGraph a -> [DotNode a]
+subGraphNodes = statementNodes . subGraphStmts
+
+subGraphEdges :: DotSubGraph a -> [DotEdge a]
+subGraphEdges = statementEdges . subGraphStmts
+
-- -----------------------------------------------------------------------------
+-- | A node in 'DotGraph' is either a singular node, or a cluster
+-- containing nodes (or more clusters) within it.
+-- At the moment, clusters are not parsed.
+data DotNode a = DotNode { nodeID :: a
+ , nodeAttributes :: Attributes
+ }
+ deriving (Eq, Show, Read)
+
+instance (PrintDot a) => PrintDot (DotNode a) where
+ unqtDot = printAttrBased printNodeID nodeAttributes
+
+ unqtListToDot = printAttrBasedList printNodeID nodeAttributes
+
+ listToDot = unqtListToDot
+
+printNodeID :: (PrintDot a) => DotNode a -> DotCode
+printNodeID = toDot . nodeID
+
+instance (ParseDot a) => ParseDot (DotNode a) where
+ parseUnqt = parseAttrBased parseNodeID
+
+ parse = parseUnqt -- Don't want the option of quoting
+
+ parseUnqtList = parseAttrBasedList parseNodeID
+
+ parseList = parseUnqtList
+
+parseNodeID :: (ParseDot a) => Parse (Attributes -> DotNode a)
+parseNodeID = liftM DotNode parse
+
+instance Functor DotNode where
+ fmap f n = n { nodeID = f $ nodeID n }
+
+invalidNode :: DotNode a -> [DotError a]
+invalidNode n = map (NodeError (Just $ nodeID n))
+ $ filter (not . usedByNodes) (nodeAttributes n)
+
+-- -----------------------------------------------------------------------------
+
-- | An edge in 'DotGraph'.
-data DotEdge = DotEdge { edgeHeadNodeID :: Int
- , edgeTailNodeID :: Int
- , edgeAttributes :: [Attribute]
- , directedEdge :: Bool
- }
- deriving (Eq, Read)
+data DotEdge a = DotEdge { edgeFromNodeID :: a
+ , edgeToNodeID :: a
+ , directedEdge :: Bool
+ , edgeAttributes :: Attributes
+ }
+ deriving (Eq, Show, Read)
-invalidEdgeAttributes :: DotEdge -> [(DotEdge, Attribute)]
-invalidEdgeAttributes e = map ((,) e)
- . filter (not . usedByEdges)
- $ edgeAttributes e
+instance (PrintDot a) => PrintDot (DotEdge a) where
+ unqtDot = printAttrBased printEdgeID edgeAttributes
-instance Show DotEdge where
- show e
- = '\t' : (show (edgeHeadNodeID e)
- ++ edge ++ show (edgeTailNodeID e) ++ attributes)
- where
- edge = " " ++ (if directedEdge e then dirEdge else undirEdge) ++ " "
- attributes = case edgeAttributes e of
- [] -> ";"
- a -> ' ':(show a ++ ";")
+ unqtListToDot = printAttrBasedList printEdgeID edgeAttributes
+ listToDot = unqtListToDot
+
+printEdgeID :: (PrintDot a) => DotEdge a -> DotCode
+printEdgeID e = unqtDot (edgeFromNodeID e)
+ <+> bool dirEdge' undirEdge' (directedEdge e)
+ <+> unqtDot (edgeToNodeID e)
+
+
+instance (ParseDot a) => ParseDot (DotEdge a) where
+ parseUnqt = parseAttrBased parseEdgeID
+
+ parse = parseUnqt -- Don't want the option of quoting
+
+ -- Have to take into account edges of the type "n1 -> n2 -> n3", etc.
+ parseUnqtList = liftM concat
+ $ sepBy (whitespace' >> parseEdgeLine) newline'
+
+ parseList = parseUnqtList
+
+parseEdgeID :: (ParseDot a) => Parse (Attributes -> DotEdge a)
+parseEdgeID = do eHead <- parse
+ whitespace'
+ eType <- parseEdgeType
+ whitespace'
+ eTail <- parse
+ return $ DotEdge eHead eTail eType
+
+parseEdgeType :: Parse Bool
+parseEdgeType = stringRep True dirEdge
+ `onFail`
+ stringRep False undirEdge
+
+parseEdgeLine :: (ParseDot a) => Parse [DotEdge a]
+parseEdgeLine = liftM return parse
+ `onFail`
+ do n1 <- parse
+ ens <- many1 $ do whitespace'
+ eType <- parseEdgeType
+ whitespace'
+ n <- parse
+ return (eType, n)
+ let ens' = (True, n1) : ens
+ efs = zipWith mkEdg ens' (tail ens')
+ ef = return $ \ as -> map ($as) efs
+ parseAttrBased ef
+ where
+ mkEdg (_, hn) (et, tn) = DotEdge hn tn et
+
+instance Functor DotEdge where
+ fmap f e = e { edgeFromNodeID = f $ edgeFromNodeID e
+ , edgeToNodeID = f $ edgeToNodeID e
+ }
+
dirEdge :: String
dirEdge = "->"
+dirEdge' :: DotCode
+dirEdge' = text dirEdge
+
undirEdge :: String
undirEdge = "--"
-instance Parseable DotEdge where
- parse = do whitespace'
- eHead <- parse
- whitespace
- edgeType <- strings [dirEdge,undirEdge]
- whitespace
- eTail <- parse
- as <- optional (whitespace >> parse)
- char ';'
- return DotEdge { edgeHeadNodeID = eHead
- , edgeTailNodeID = eTail
- , edgeAttributes = fromMaybe [] as
- , directedEdge = edgeType == dirEdge
- }
- `adjustErr`
- (++ "\nNot a valid DotEdge")
+undirEdge' :: DotCode
+undirEdge' = text undirEdge
+invalidEdge :: DotEdge a -> [DotError a]
+invalidEdge e = map (EdgeError eID)
+ $ filter (not . usedByEdges) (edgeAttributes e)
+ where
+ eID = Just (edgeFromNodeID e, edgeToNodeID e)
+
-- -----------------------------------------------------------------------------
+
+-- Printing and parsing helpers.
+
+printAttrBased :: (a -> DotCode) -> (a -> Attributes) -> a -> DotCode
+printAttrBased ff fas a = dc <> semi
+ where
+ f = ff a
+ dc = case fas a of
+ [] -> f
+ as -> f <+> toDot as
+
+printAttrBasedList :: (a -> DotCode) -> (a -> Attributes)
+ -> [a] -> DotCode
+printAttrBasedList ff fas = vcat . map (printAttrBased ff fas)
+
+parseAttrBased :: Parse (Attributes -> a) -> Parse a
+parseAttrBased p = do f <- p
+ whitespace'
+ atts <- tryParseList
+ lineEnd
+ return $ f atts
+ `adjustErr`
+ (++ "\n\nNot a valid attribute-based structure")
+
+parseAttrBasedList :: Parse (Attributes -> a) -> Parse [a]
+parseAttrBasedList p = sepBy (whitespace' >> parseAttrBased p) newline'
+
+lineEnd :: Parse ()
+lineEnd = whitespace' >> character ';' >> return ()
diff --git a/Data/GraphViz/Types/Clustering.hs b/Data/GraphViz/Types/Clustering.hs
--- a/Data/GraphViz/Types/Clustering.hs
+++ b/Data/GraphViz/Types/Clustering.hs
@@ -9,35 +9,35 @@
This module defines types for creating clusters.
-}
-
module Data.GraphViz.Types.Clustering
( NodeCluster(..)
, clustersToNodes
) where
--- LT is defined in Attributes
-import Prelude hiding (LT)
-import qualified Prelude as P
-
import Data.GraphViz.Types
import Data.GraphViz.Attributes
-import Data.List(groupBy, sortBy, mapAccumL)
-import Data.Graph.Inductive.Graph(Graph, LNode, labNodes)
+import Data.Either(partitionEithers)
+import Data.List(groupBy, sortBy)
+import Data.Graph.Inductive.Graph(Graph, Node, LNode, labNodes)
-- -----------------------------------------------------------------------------
-- | Define into which cluster a particular node belongs.
--- Nodes can be nested to arbitrary depth.
-data NodeCluster c a = N (LNode a) | C c (NodeCluster c a)
+-- Clusters can be nested to arbitrary depth.
+data NodeCluster c a = N (LNode a) -- ^ Indicates the actual Node in the Graph.
+ | C c (NodeCluster c a) -- ^ Indicates that the
+ -- 'NodeCluster' is in
+ -- the Cluster /c/.
deriving (Show)
--- | Create the @'DotNode'@s for the given graph.
+-- | Create the /Dot/ representation for the given graph.
clustersToNodes :: (Ord c, Graph gr) => (LNode a -> NodeCluster c a)
- -> (c -> [Attribute]) -> (LNode a -> [Attribute])
- -> gr a b -> [DotNode]
-clustersToNodes clusterBy fmtCluster fmtNode
- = treesToNodes fmtCluster fmtNode
+ -> (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> gr a b
+ -> ([DotSubGraph Node], [DotNode Node])
+clustersToNodes clusterBy cID fmtCluster fmtNode
+ = treesToDot cID fmtCluster fmtNode
. collapseNClusts
. map (clustToTree . clusterBy)
. labNodes
@@ -45,7 +45,8 @@
-- -----------------------------------------------------------------------------
-- | A tree representation of a cluster.
-data ClusterTree c a = NT (LNode a) | CT c [ClusterTree c a]
+data ClusterTree c a = NT (LNode a)
+ | CT c [ClusterTree c a]
deriving (Show)
-- | Convert a single node cluster into its tree representation.
@@ -63,7 +64,7 @@
-- | Singleton nodes come first, and then ordering based upon the cluster.
clustOrder :: (Ord c) => ClusterTree c a -> ClusterTree c a -> Ordering
clustOrder (NT _) (NT _) = EQ
-clustOrder (NT _) (CT _ _) = P.LT -- don't use the attribute LT
+clustOrder (NT _) (CT _ _) = LT
clustOrder (CT _ _) (NT _) = GT
clustOrder (CT c1 _) (CT c2 _) = compare c1 c2
@@ -82,33 +83,33 @@
grpCls ns@((NT _):_) = ns
grpCls cs@((CT c _):_) = [CT c (collapseNClusts $ concatMap getNodes cs)]
-
--- | Convert the cluster representation of the trees into @'DotNode'@s.
--- Clusters will be labelled with @'Int'@s.
-treesToNodes :: (c -> [Attribute]) -> (LNode a -> [Attribute])
- -> [ClusterTree c a] -> [DotNode]
-treesToNodes fmtCluster fmtNode = snd . treesToNodesFrom fmtCluster fmtNode 0
-
--- | Start labelling the clusters with this @'Int'@.
-treesToNodesFrom :: (c -> [Attribute]) -> (LNode a -> [Attribute])
- -> Int -> [ClusterTree c a] -> (Int,[DotNode])
-treesToNodesFrom fmtCluster fmtNode n = mapAccumL mkNodes n
- where
- mkNodes = treeToNode fmtCluster fmtNode
-
--- | Convert this 'ClusterTree' into its 'DotNode' representation.
-treeToNode :: (c -> [Attribute]) -> (LNode a -> [Attribute])
- -> Int -> ClusterTree c a -> (Int, DotNode)
-treeToNode _ fmtNode n (NT ln) = ( n
- , DotNode { nodeID = fst ln
- , nodeAttributes = fmtNode ln
- }
- )
+-- | Convert the cluster representation of the trees into 'DotNode's
+-- and 'DotSubGraph's (with @'isCluster' = 'True'@, and
+-- @'subGraphID' = 'Nothing'@).
+treesToDot :: (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> [ClusterTree c a]
+ -> ([DotSubGraph Node], [DotNode Node])
+treesToDot cID fmtCluster fmtNode
+ = partitionEithers
+ . map (treeToDot cID fmtCluster fmtNode)
-treeToNode fmtCluster fmtNode n (CT c nts) = (n',clust)
+-- | Convert this 'ClusterTree' into its /Dot/ representation.
+treeToDot :: (c -> Maybe GraphID) -> (c -> [GlobalAttributes])
+ -> (LNode a -> Attributes) -> ClusterTree c a
+ -> Either (DotSubGraph Node) (DotNode Node)
+treeToDot _ _ fmtNode (NT ln)
+ = Right DotNode { nodeID = fst ln
+ , nodeAttributes = fmtNode ln
+ }
+treeToDot cID fmtCluster fmtNode (CT c nts)
+ = Left DotSG { isCluster = True
+ , subGraphID = cID c
+ , subGraphStmts = stmts
+ }
where
- (n', nts') = treesToNodesFrom fmtCluster fmtNode (n+1) nts
- clust = DotCluster { clusterID = show n
- , clusterAttributes = fmtCluster c
- , clusterElems = nts'
- }
+ stmts = DotStmts { attrStmts = fmtCluster c
+ , subGraphs = cs
+ , nodeStmts = ns
+ , edgeStmts = []
+ }
+ (cs, ns) = treesToDot cID fmtCluster fmtNode nts
diff --git a/Data/GraphViz/Types/Internal.hs b/Data/GraphViz/Types/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Types/Internal.hs
@@ -0,0 +1,63 @@
+{- |
+ Module : Data.GraphViz.Types.Internal
+ Description : Internal functions
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ This module defines internal functions.
+-}
+module Data.GraphViz.Types.Internal where
+
+import Data.Char( isAsciiUpper
+ , isAsciiLower
+ , isDigit
+ )
+
+isIDString :: String -> Bool
+isIDString [] = True
+isIDString (f:os) = frstIDString f
+ && all restIDString os
+
+-- | First character of a non-quoted 'String' must match this.
+frstIDString :: Char -> Bool
+frstIDString c = any ($c) [ isAsciiUpper
+ , isAsciiLower
+ , (==) '_'
+ , \ x -> x >= '\200' && x <= '\377'
+ ]
+
+-- | The rest of a non-quoted 'String' must match this.
+restIDString :: Char -> Bool
+restIDString c = frstIDString c || isDigit c
+
+-- | Determine if this String represents a number.
+isNumString :: String -> Bool
+isNumString "" = False
+isNumString str = case str of
+ ('-':str') -> go str'
+ _ -> go str
+ where
+ go [] = False
+ go cs = case dropWhile isDigit cs of
+ [] -> True
+ ('.':ds) -> not (null ds) && all isDigit ds
+ _ -> False
+
+-- | GraphViz requires double quotes to be explicitly escaped.
+escapeQuotes :: String -> String
+escapeQuotes [] = []
+escapeQuotes ('"':str) = '\\':'"': escapeQuotes str
+escapeQuotes (c:str) = c : escapeQuotes str
+
+-- | Remove explicit escaping of double quotes.
+descapeQuotes :: String -> String
+descapeQuotes [] = []
+descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str
+descapeQuotes (c:str) = c : descapeQuotes str
+
+-- | Fold over 'Bool's.
+bool :: a -> a -> Bool -> a
+bool t f b = if b
+ then t
+ else f
diff --git a/Data/GraphViz/Types/Parsing.hs b/Data/GraphViz/Types/Parsing.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Types/Parsing.hs
@@ -0,0 +1,285 @@
+{- |
+ Module : Data.GraphViz.Types.Parsing
+ Description : Helper functions for Parsing.
+ Copyright : (c) Matthew Sackman, Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ This module defines simple helper functions for use with
+ "Text.ParserCombinators.Poly.Lazy".
+
+ Note that the 'ParseDot' instances for 'Bool', etc. match those
+ specified for use with GraphViz (e.g. non-zero integers are
+ equivalent to 'True').
+
+ You should not be using this module; rather, it is here for
+ informative/documentative reasons. If you want to parse a
+ @'Data.GraphViz.Types.DotGraph'@, you should use
+ @'Data.GraphViz.Types.parseDotGraph'@ rather than its 'ParseDot'
+ instance.
+-}
+module Data.GraphViz.Types.Parsing
+ ( module Text.ParserCombinators.Poly.Lazy
+ , Parse
+ , ParseDot(..)
+ , stringBlock
+ , numString
+ , quotedString
+ , parseAndSpace
+ , string
+ , strings
+ , hasString
+ , character
+ , noneOf
+ , whitespace
+ , whitespace'
+ , optionalQuotedString
+ , optionalQuoted
+ , quotedParse
+ , newline
+ , newline'
+ , parseComma
+ , tryParseList
+ , tryParseList'
+ , skipToNewline
+ , parseField
+ , parseFields
+ , parseFieldBool
+ , parseFieldsBool
+ , parseFieldDef
+ , parseFieldsDef
+ , commaSep
+ , commaSep'
+ , stringRep
+ ) where
+
+import Data.GraphViz.Types.Internal
+
+import Text.ParserCombinators.Poly.Lazy
+import Data.Char( digitToInt
+ , isDigit
+ , isSpace
+ , toLower
+ )
+import Data.Function(on)
+import Data.Maybe(isJust, fromMaybe)
+import Data.Ratio((%))
+import Control.Monad
+
+-- -----------------------------------------------------------------------------
+-- Based off code from Text.Parse in the polyparse library
+
+-- | A @ReadS@-like type alias.
+type Parse a = Parser Char a
+
+class ParseDot a where
+ parseUnqt :: Parse a
+
+ parse :: Parse a
+ parse = optionalQuoted parseUnqt
+
+ parseUnqtList :: Parse [a]
+ parseUnqtList = bracketSep (parseAndSpace $ character '[')
+ (parseAndSpace $ parseComma)
+ (parseAndSpace $ character ']')
+ (parseAndSpace parse)
+
+ parseList :: Parse [a]
+ parseList = quotedParse parseUnqtList
+
+instance ParseDot Int where
+ parseUnqt = parseInt'
+
+instance ParseDot Double where
+ parseUnqt = parseFloat'
+
+instance ParseDot Bool where
+ parseUnqt = oneOf [ stringRep True "true"
+ , stringRep False "false"
+ , liftM (zero /=) parseInt'
+ ]
+ where
+ zero :: Int
+ zero = 0
+
+instance ParseDot Char where
+ -- Can't be a quote character.
+ parseUnqt = satisfy ((/=) '"')
+
+ parse = satisfy restIDString
+ `onFail`
+ quotedParse parseUnqt
+
+ parseUnqtList = oneOf [ numString
+ , stringBlock
+ , quotedString
+ ]
+
+ parseList = oneOf [numString, stringBlock]
+ `onFail`
+ -- This will also take care of quoted versions of
+ -- above.
+ quotedParse quotedString
+
+instance (ParseDot a) => ParseDot [a] where
+ parseUnqt = parseUnqtList
+
+ parse = parseList
+
+numString :: Parse String
+numString = liftM show parseInt'
+ `onFail`
+ liftM show parseFloat'
+
+stringBlock :: Parse String
+stringBlock = do frst <- satisfy frstIDString
+ rest <- many (satisfy restIDString)
+ return $ frst : rest
+
+-- | Used when quotes are explicitly required;
+quotedString :: Parse String
+quotedString = many $ oneOf [ stringRep '"' "\\\""
+ , satisfy ((/=) '"')
+ ]
+
+parseSigned :: Real a => Parse a -> Parse a
+parseSigned p = do '-' <- next; commit (fmap negate p)
+ `onFail`
+ p
+
+parseInt :: (Integral a) => Parse a
+parseInt = do cs <- many1 (satisfy isDigit)
+ return (foldl1 (\n d-> n*radix+d)
+ (map (fromIntegral . digitToInt) cs))
+ `adjustErr` (++ "\nexpected one or more digits")
+ where
+ radix = 10
+
+parseInt' :: Parse Int
+parseInt' = parseSigned parseInt
+
+parseFloat :: (RealFrac a) => Parse a
+parseFloat = do ds <- many1 (satisfy isDigit)
+ frac <- (do '.' <- next
+ many (satisfy isDigit)
+ `adjustErrBad` (++"expected digit after .")
+ `onFail` return [] )
+ expn <- parseExp `onFail` return 0
+ ( return . fromRational . (* (10^^(expn - length frac)))
+ . (%1) . fst
+ . runParser parseInt) (ds++frac)
+ `onFail`
+ do w <- many (satisfy (not.isSpace))
+ case map toLower w of
+ "nan" -> return (0/0)
+ "infinity" -> return (1/0)
+ _ -> fail "expected a floating point number"
+ where parseExp = do 'e' <- fmap toLower next
+ commit (do '+' <- next; parseInt
+ `onFail`
+ parseSigned parseInt)
+
+parseFloat' :: Parse Double
+parseFloat' = parseSigned parseFloat
+
+-- -----------------------------------------------------------------------------
+
+parseAndSpace :: Parse a -> Parse a
+parseAndSpace p = p `discard` whitespace'
+
+string :: String -> Parse String
+string = mapM character
+
+stringRep :: a -> String -> Parse a
+stringRep v s = string s >> return v
+
+strings :: [String] -> Parse String
+strings = oneOf . map string
+
+hasString :: String -> Parse Bool
+hasString = liftM isJust . optional . string
+
+character :: Char -> Parse Char
+character c = satisfy (((==) `on` toLower) c)
+ `adjustErr`
+ (++ "\nnot the expected char: " ++ [c])
+
+noneOf :: (Eq a) => [a] -> Parser a a
+noneOf t = satisfy (\x -> all (/= x) t)
+
+whitespace :: Parse String
+whitespace = many1 (satisfy isSpace)
+
+whitespace' :: Parse String
+whitespace' = many (satisfy isSpace)
+
+optionalQuotedString :: String -> Parse String
+optionalQuotedString = optionalQuoted . string
+
+optionalQuoted :: Parse a -> Parse a
+optionalQuoted p = p
+ `onFail`
+ quotedParse p
+
+quotedParse :: Parse a -> Parse a
+quotedParse p = bracket quote quote p
+ where
+ quote = character '"'
+
+newline :: Parse String
+newline = oneOf $ map string ["\r\n", "\n", "\r"]
+
+-- | Consume all whitespace and newlines until a line with
+-- non-whitespace is reached. The whitespace on that line is
+-- not consumed.
+newline' :: Parse ()
+newline' = many (whitespace' >> newline) >> return ()
+
+skipToNewline :: Parse ()
+skipToNewline = many (noneOf ['\n','\r']) >> newline >> return ()
+
+parseField :: (ParseDot a) => String -> Parse a
+parseField fld = do string fld
+ whitespace'
+ character '='
+ whitespace'
+ parse
+
+parseFields :: (ParseDot a) => [String] -> Parse a
+parseFields = oneOf . map parseField
+
+parseFieldBool :: String -> Parse Bool
+parseFieldBool = parseFieldDef True
+
+parseFieldsBool :: [String] -> Parse Bool
+parseFieldsBool = oneOf . map parseFieldBool
+
+-- | For 'Bool'-like data structures where the presence of the field
+-- name without a value implies a default value.
+parseFieldDef :: (ParseDot a) => a -> String -> Parse a
+parseFieldDef d fld = parseField fld
+ `onFail`
+ stringRep d fld
+
+parseFieldsDef :: (ParseDot a) => a -> [String] -> Parse a
+parseFieldsDef d = oneOf . map (parseFieldDef d)
+
+commaSep :: (ParseDot a, ParseDot b) => Parse (a, b)
+commaSep = commaSep' parse parse
+
+commaSep' :: Parse a -> Parse b -> Parse (a,b)
+commaSep' pa pb = do a <- pa
+ whitespace'
+ parseComma
+ whitespace'
+ b <- pb
+ return (a,b)
+
+parseComma :: Parse Char
+parseComma = character ','
+
+tryParseList :: (ParseDot a) => Parse [a]
+tryParseList = tryParseList' parse
+
+tryParseList' :: Parse [a] -> Parse [a]
+tryParseList' = liftM (fromMaybe []) . optional
diff --git a/Data/GraphViz/Types/Printing.hs b/Data/GraphViz/Types/Printing.hs
new file mode 100644
--- /dev/null
+++ b/Data/GraphViz/Types/Printing.hs
@@ -0,0 +1,151 @@
+{- |
+ Module : Data.GraphViz.Types.Printing
+ Description : Helper functions for converting to Dot format.
+ Copyright : (c) Ivan Lazar Miljenovic
+ License : 3-Clause BSD-style
+ Maintainer : Ivan.Miljenovic@gmail.com
+
+ This module defines simple helper functions for use with
+ "Text.PrettyPrint". It also re-exports all the pretty-printing
+ combinators from that module.
+
+ Note that the 'PrintDot' instances for 'Bool', etc. match those
+ specified for use with GraphViz.
+
+ You should only be using this module if you are writing custom node
+ types for use with "Data.GraphViz.Types". For actual printing of
+ code, use @'Data.GraphViz.Types.printDotGraph'@ (which produces a
+ 'String' value).
+
+ The Dot language specification specifies that any identifier is in
+ one of four forms:
+
+ * Any string of alphabetic ([a-zA-Z\200-\377]) characters, underscores ('_') or digits ([0-9]), not beginning with a digit;
+
+ * a number [-]?(.[0-9]+ | [0-9]+(.[0-9]*)? );
+
+ * any double-quoted string (\"...\") possibly containing escaped quotes (\");
+
+ * an HTML string (<...>).
+
+ Due to these restrictions, you should only use 'text' when you are
+ sure that the 'String' in question is static and quotes are
+ definitely needed/unneeded; it is better to use the 'String'
+ instance for 'PrintDot'. For more information, see the
+ specification page:
+
+-}
+module Data.GraphViz.Types.Printing
+ ( module Text.PrettyPrint
+ , DotCode
+ , renderDot
+ , PrintDot(..)
+ , wrap
+ , commaDel
+ , printField
+ ) where
+
+import Data.GraphViz.Types.Internal
+
+-- Only implicitly import and re-export combinators.
+import Text.PrettyPrint hiding ( Style(..)
+ , Mode(..)
+ , TextDetails(..)
+ , render
+ , style
+ , renderStyle
+ , fullRender
+ )
+import qualified Text.PrettyPrint as PP
+
+-- -----------------------------------------------------------------------------
+
+-- | A type alias to indicate what is being produced.
+type DotCode = Doc
+
+-- | Correctly render GraphViz output.
+renderDot :: DotCode -> String
+renderDot = PP.renderStyle style'
+ where
+ style' = PP.style { PP.mode = PP.ZigZagMode }
+
+-- | A class used to correctly print parts of the GraphViz Dot language.
+-- Minimal implementation is 'unqtDot'.
+class PrintDot a where
+ -- | The unquoted representation, for use when composing values to
+ -- produce a larger printing value.
+ unqtDot :: a -> DotCode
+
+ -- | The actual quoted representation; this should be quoted if it
+ -- contains characters not permitted a plain ID String, a number
+ -- or it is not an HTML string.
+ -- Defaults to 'unqtDot'.
+ toDot :: a -> DotCode
+ toDot = unqtDot
+
+ -- | The correct way of representing a list of this value when
+ -- printed; not all Dot values require this to be implemented.
+ -- Defaults to Haskell-like list representation.
+ unqtListToDot :: [a] -> DotCode
+ unqtListToDot = brackets . hsep . punctuate comma
+ . map unqtDot
+
+ -- | The quoted form of 'unqtListToDot'; defaults to wrapping
+ -- double quotes around the result of 'unqtListToDot' (since the
+ -- default implementation has characters that must be quoted).
+ listToDot :: [a] -> DotCode
+ listToDot = doubleQuotes . unqtListToDot
+
+instance PrintDot Int where
+ unqtDot = int
+
+instance PrintDot Double where
+ unqtDot = double
+
+instance PrintDot Bool where
+ unqtDot True = text "true"
+ unqtDot False = text "false"
+
+instance PrintDot Char where
+ unqtDot = char
+
+ toDot = qtChar
+
+ unqtListToDot = unqtString
+
+ listToDot = qtString
+
+-- | Check to see if this 'Char' needs to be quoted or not.
+qtChar :: Char -> DotCode
+qtChar c
+ | restIDString c = char c -- Could be a number as well.
+ | otherwise = doubleQuotes $ char c
+
+-- | Escape quotes in Strings that need them.
+unqtString :: String -> DotCode
+unqtString str
+ | isIDString str = text str
+ | isNumString str = text str
+ | otherwise = text $ escapeQuotes str
+
+-- | Escape quotes and quote Strings that need them.
+qtString :: String -> DotCode
+qtString str
+ | isIDString str = text str
+ | isNumString str = text str
+ -- Don't use unqtString as it re-runs isIDString
+ | otherwise = doubleQuotes . text $ escapeQuotes str
+
+instance (PrintDot a) => PrintDot [a] where
+ unqtDot = unqtListToDot
+
+ toDot = listToDot
+
+wrap :: DotCode -> DotCode -> DotCode -> DotCode
+wrap b a d = b <> d <> a
+
+commaDel :: (PrintDot a, PrintDot b) => a -> b -> DotCode
+commaDel a b = unqtDot a <> comma <> unqtDot b
+
+printField :: (PrintDot a) => String -> a -> DotCode
+printField f v = text f <> equals <> toDot v
diff --git a/TODO b/TODO
--- a/TODO
+++ b/TODO
@@ -2,15 +2,8 @@
* Utilise the generic graph class once it is finalised.
-* Allow user to choose whether or not the graph is meant to be
- directed or undirected.
-
-* Improve parsing to fully (or at least follow more closely) support Dot.
-
-* Improve clustering/subgraph support.
-
-* Use a PrettyPrinter rather than Show to generate Dot output.
-
* Improve Output support.
* Find and fix the handle closing bug with graphvizWithHandle.
+
+* Improve support for named Colors.
diff --git a/graphviz.cabal b/graphviz.cabal
--- a/graphviz.cabal
+++ b/graphviz.cabal
@@ -1,10 +1,10 @@
Name: graphviz
-Version: 2999.1.0.2
+Version: 2999.5.0.0
Stability: Beta
Synopsis: GraphViz bindings for Haskell.
Description: Provides convenient functions to convert FGL
graphs into the Dot language used by the
- GraphViz suite of
+ GraphViz () suite of
programs with a large degree of customisation
for layout, etc.
@@ -33,15 +33,18 @@
process,
array,
fgl,
- polyparse >= 1.1
+ polyparse >= 1.1,
+ pretty
Exposed-Modules: Data.GraphViz
Data.GraphViz.Types
+ Data.GraphViz.Types.Parsing
+ Data.GraphViz.Types.Printing
Data.GraphViz.Commands
Data.GraphViz.Attributes
- Data.GraphViz.ParserCombinators
Other-Modules: Data.GraphViz.Types.Clustering
+ Data.GraphViz.Types.Internal
Ghc-Options: -Wall
Ghc-Prof-Options: -prof -auto-all