graphviz 2009.5.1 → 2999.0.0.0

raw patch · 8 files changed

+2242/−893 lines, 8 filesdep +extensible-exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: extensible-exceptions

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Changelog +52/−0
• Data/GraphViz.hs +54/−57
• Data/GraphViz/Attributes.hs +1702/−692
• Data/GraphViz/Commands.hs +13/−13
• Data/GraphViz/ParserCombinators.hs +207/−26
• Data/GraphViz/Types.hs +176/−83
• TODO +9/−3
• graphviz.cabal +29/−19

@@ -0,0 +1,52 @@+Changes since 2009.5.1+======================++* Fixed a bug where the Show instance and read function for DotEdge+  had the from/to nodes the wrong way round.  This was not immediately+  noticed since the Graph -> DotGraph functions created them the wrong+  way round, so for those users who only used these this was not+  apparent.  Spotted by Neil Brown.++* Greatly improved Attribute usage: almost all attributes are now+  covered with allowed values.++* Extend DotGraph to include whether a graph is strict or not and if+  it has an ID.  Also move the directedGraph field.++* Make "Dot" refer to the actual dot command and DotArrow refer to the+  ArrowType (rather than DotCmd and Dot as before).++* Make the Data.GraphViz.ParserCombinators module available to end+  users again, but not re-exported by Data.GraphViz; it has a warning+  message up the top not to be used.  It is there purely for+  documentative purposes.++* Use extensible-exceptions so that base < 4 is once again supported.++* Follow the PVP rather than using dates for versions:+  http://www.haskell.org/haskellwiki/Package_versioning_policy++Changes since 2008.9.20:+========================++* Support polyparse >= 1.1 (as opposed to < 1.3)++* Require base == 4.* (i.e. GHC 6.10.*) due to new exception handling.++* Include functions from Graphalyze-0.5 for running GraphViz commands,+  etc.++* Module re-organisation.++* The Data.GraphViz.ParserCombinators module is no longer available to+  end users.++* Improved Haddock documentation.++Changes since 2008.9.6+======================++* Differentiate between undirected and directed graphs (previously+  only directed graphs were supported).++* Clustering support was added.

@@ -1,7 +1,3 @@-{-# LANGUAGE NamedFieldPuns-           , ScopedTypeVariables-           #-}- {- |    Module      : Data.GraphViz    Description : GraphViz bindings for Haskell.@@ -16,13 +12,7 @@     Information about GraphViz and the Dot language can be found at:    <http://graphviz.org/>--   Note that this module re-exports the "Data.GraphViz.Attributes"-   module, which exports a constructor that clashes with-   'Prelude.LT'.  As such, you may need to import either this module-   or the @Prelude@ qualified or hiding @LT@.--   -}+ -}  module Data.GraphViz     ( graphToDot@@ -35,33 +25,30 @@     , module Data.GraphViz.Types     , module Data.GraphViz.Attributes     , module Data.GraphViz.Commands-    )-    where+    ) where +import Data.GraphViz.Types+import Data.GraphViz.Types.Clustering+import Data.GraphViz.Attributes+import Data.GraphViz.Commands+import Data.GraphViz.ParserCombinators(runParser)+ import Data.Graph.Inductive.Graph-import Data.List-import Data.Function import qualified Data.Set as Set-import Text.ParserCombinators.Poly.Lazy-import Control.Monad+import Control.Arrow((&&&)) import Data.Maybe import qualified Data.Map as Map-import System.IO+import System.IO(hGetContents) import System.IO.Unsafe(unsafePerformIO) -import Data.GraphViz.Types-import Data.GraphViz.Types.Clustering-import Data.GraphViz.Attributes-import Data.GraphViz.Commands- -- -----------------------------------------------------------------------------  -- | Determine if the given graph is undirected or directed. isUndir   :: (Ord b, Graph g) => g a b -> Bool-isUndir g = all hasFlip edges+isUndir g = all hasFlip es     where-      edges = labEdges g-      eSet = Set.fromList edges+      es = labEdges g+      eSet = Set.fromList es       hasFlip e = Set.member (flippedEdge e) eSet       flippedEdge (f,t,l) = (t,f,l) @@ -70,8 +57,8 @@ -- | 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 graphAttributes fmtNode fmtEdge-    = clusterGraphToDot graph graphAttributes clusterBy fmtCluster fmtNode fmtEdge+graphToDot graph gAttributes fmtNode fmtEdge+    = clusterGraphToDot graph gAttributes clusterBy fmtCluster fmtNode fmtEdge       where         clusterBy :: LNode a -> NodeCluster () a         clusterBy = N@@ -84,17 +71,23 @@                   -> [Attribute] -> (LNode a -> NodeCluster c a)                   -> (c -> [Attribute]) -> (LNode a -> [Attribute])                   -> (LEdge b -> [Attribute]) -> DotGraph-clusterGraphToDot graph graphAttributes clusterBy fmtCluster fmtNode fmtEdge-    = DotGraph { graphAttributes, graphNodes, graphEdges, directedGraph }+clusterGraphToDot graph gAttrs clusterBy fmtCluster fmtNode fmtEdge+    = DotGraph { strictGraph     = False+               , directedGraph   = dirGraph+               , graphID         = Nothing+               , graphAttributes = gAttrs+               , graphNodes      = ns+               , graphEdges      = es+               }       where-        graphNodes = clustersToNodes clusterBy fmtCluster fmtNode graph-        directedGraph = not $ isUndir graph-        graphEdges = catMaybes . map mkDotEdge . labEdges $ graph-        mkDotEdge e@(f,t,_) = if (directedGraph || f <= t)-                              then Just $ DotEdge {edgeHeadNodeID = t-                                                  ,edgeTailNodeID = f-                                                  ,edgeAttributes = fmtEdge e-                                                  ,directedEdge = directedGraph}+        dirGraph = not $ isUndir graph+        ns = clustersToNodes clusterBy 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}                               else Nothing  -- -----------------------------------------------------------------------------@@ -105,31 +98,35 @@ -- | 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 :: forall gr a b . (Ord b, Graph gr) =>-                gr a b -> [Attribute] -> (LNode a -> [Attribute]) -> (LEdge b -> [Attribute]) -> IO (gr (AttributeNode a) (AttributeEdge b))-graphToGraph gr graphAttributes fmtNode fmtEdge-    = do { out <- graphvizWithHandle command dot DotOutput hGetContents-         ; let res = fromJust out-         ; (length res) `seq` return ()-         ; return $ rebuildGraphWithAttributes res-         }+graphToGraph :: (Ord b, Graph gr) => gr a b -> [Attribute]+                -> (LNode a -> [Attribute]) -> (LEdge b -> [Attribute])+                -> IO (gr (AttributeNode a) (AttributeEdge b))+graphToGraph gr gAttributes fmtNode fmtEdge+    = 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 graphAttributes fmtNode fmtEdge-      rebuildGraphWithAttributes :: String -> gr (AttributeNode a) (AttributeEdge b)+      dot = graphToDot gr gAttributes fmtNode fmtEdge       rebuildGraphWithAttributes dotResult = mkGraph lnodes ledges           where-            lnodes = map (\(n, l) -> (n, (fromJust $ Map.lookup n nodeMap, l))) . labNodes $ gr-            ledges = map createEdges . labEdges $ gr-            (DotGraph { graphEdges, graphNodes }) = fst . runParser readDotGraph $ dotResult-            nodeMap = Map.fromList . map (\n -> (nodeID n, nodeAttributes n)) $ graphNodes-            edgeMap = Map.fromList . map (\e -> ((edgeTailNodeID e, edgeHeadNodeID e), edgeAttributes e)) $ graphEdges-            createEdges (f,t,l) = if (undirected && f > t)-                                  then (f,t,getLabel (t,f))-                                  else (f,t,getLabel (f,t))+            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))                 where-                  getLabel c = (fromJust $ Map.lookup c edgeMap,l)+                  getLabel c = (fromJust $ Map.lookup c edgeMap, l)+            DotGraph { graphNodes = ns, graphEdges = es}+                = fst . runParser parseDotGraph $ dotResult+            nodeMap = Map.fromList $ map (nodeID &&& nodeAttributes) ns+            edgeMap = Map.fromList $ map (\e -> ( ( edgeTailNodeID e+                                                  , edgeHeadNodeID e)+                                                , edgeAttributes e)+                                         ) 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'

@@ -1,692 +1,1702 @@-{-# LANGUAGE NamedFieldPuns-           , ScopedTypeVariables-           #-}--{- |-   Module      : Data.GraphViz.Attributes-   Description : Definition of the GraphViz attributes.-   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic-   License     : 3-Clause BSD-style-   Maintainer  : Ivan.Miljenovic@gmail.com--   This module defines the various attributes that different parts of-   a GraphViz graph can have.  Note that when using this module, you-   may need to either import it or @Prelude@ qualified or hiding-   @LT@, as this module exports a constructor with the same name.-  -}--module Data.GraphViz.Attributes where--import Prelude hiding (LT)--import Data.Word-import Numeric-import Text.ParserCombinators.Poly.Lazy-import Control.Monad-import Data.Maybe--import Data.GraphViz.ParserCombinators--data ArrowType = Normal   | Inv-               | Dot      | InvDot-               | ODot     | InvODot-               | NoArrow  | Tee-               | Empty    | InvEmpty-               | Diamond  | ODiamond-               | EDiamond | Crow-               | Box      | OBox-               | Open     | HalfOpen-               | Vee-                 deriving (Eq)--instance Show ArrowType where-    show Normal   = "normal"-    show Inv      = "inv"-    show Dot      = "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"--readArrowType :: Parser Char ArrowType-readArrowType-              = oneOf [ optionalQuotedString "normal" >> return Normal-                      , optionalQuotedString "inv" >> return Inv-                      , optionalQuotedString "dot" >> return Dot-                      , optionalQuotedString "invdot" >> return InvDot-                      , optionalQuotedString "odot" >> return ODot-                      , optionalQuotedString "invodot" >> return InvODot-                      , optionalQuotedString "noarrow" >> return NoArrow-                      , optionalQuotedString "tee" >> return Tee-                      , optionalQuotedString "empty" >> return Empty-                      , optionalQuotedString "invempty" >> return InvEmpty-                      , optionalQuotedString "diamond" >> return Diamond-                      , optionalQuotedString "odiamond" >> return ODiamond-                      , optionalQuotedString "ediamond" >> return EDiamond-                      , optionalQuotedString "crow" >> return Crow-                      , optionalQuotedString "box" >> return Box-                      , optionalQuotedString "obox" >> return OBox-                      , optionalQuotedString "open" >> return Open-                      , optionalQuotedString "halfopen" >> return HalfOpen-                      , optionalQuotedString "vee" >> return Vee-                      ]--data ColorType = RGB { red :: Word8-                      , green :: Word8-                      , blue :: Word8-                      }-                | RGBA { red :: Word8-                       , green :: Word8-                       , blue :: Word8-                       , alpha :: Word8-                       }-                  deriving (Eq)--instance Show ColorType where-    show (RGB { red, green, blue })-        = show $ '#' : foldr showWord8Pad "" [red, green, blue]-    show (RGBA { red, green, blue, alpha })-        = show $ '#' : foldr showWord8Pad "" [red, green, blue, alpha]--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)--readColorType :: Parser Char ColorType-readColorType-              = do { string "\"#"-                   ; digits <- many $ noneOf ['"']-                   ; char '"'-                   ; let c = readHexPairs digits-                   ; return $ case c of-                                [r,g,b]-                                    -> RGB r g b-                                [r,g,b,a]-                                    -> RGBA r g b a-                                _ -> error $ "Unexpected pairs: " ++ show c-                   }-    where-          readHexPairs :: String -> [Word8]-          readHexPairs [] = []-          readHexPairs (h1:h2:h')-              = let [(n, [])] = readHex [h1,h2] in n : readHexPairs h'-          readHexPairs c = error $ "Error in readHexPairs: " ++ (show c)--data DirType = Forward | Back | Both | None-               deriving (Eq)--instance Show DirType where-    show Forward = "forward"-    show Back = "back"-    show Both = "both"-    show None = "none"--readDirType :: Parser Char DirType-readDirType-              = oneOf [optionalQuotedString "forward" >> return Forward-                      ,optionalQuotedString "back" >> return Back-                      ,optionalQuotedString "both" >> return Both-                      ,optionalQuotedString "none" >> return None-                      ]--data OutputMode = BreadthFirst | NodesFirst | EdgesFirst-                  deriving (Eq)--instance Show OutputMode where-    show BreadthFirst = "breadthfirst"-    show NodesFirst = "nodesfirst"-    show EdgesFirst = "edgesfirst"--readOutputMode :: Parser Char OutputMode-readOutputMode-              = oneOf [ optionalQuotedString "breadthfirst" >> return BreadthFirst-                      , optionalQuotedString "nodesfirst" >> return NodesFirst-                      , optionalQuotedString "edgesfirst" >> return EdgesFirst-                      ]--data PageDir = BL | BR | TL | TR | RB | RT | LB | LT-               deriving (Eq)--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"--readPageDir :: Parser Char PageDir-readPageDir-              = oneOf [ optionalQuotedString "BL" >> return BL-                      , optionalQuotedString "BR" >> return BR-                      , optionalQuotedString "TL" >> return TL-                      , optionalQuotedString "TR" >> return TR-                      , optionalQuotedString "RB" >> return RB-                      , optionalQuotedString "RT" >> return RT-                      , optionalQuotedString "LB" >> return LB-                      , optionalQuotedString "LT" >> return LT-                      ]--data ShapeType-    = 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)--instance Show ShapeType 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"--readShapeType :: Parser Char ShapeType-readShapeType-              = oneOf [ optionalQuotedString "box" >> return BoxShape-                      , optionalQuotedString "polygon" >> return Polygon-                      , optionalQuotedString "ellipse" >> return Ellipse-                      , optionalQuotedString "circle" >> return Circle-                      , optionalQuotedString "point" >> return PointShape-                      , optionalQuotedString "egg" >> return Egg-                      , optionalQuotedString "triangle" >> return Triangle-                      , optionalQuotedString "plaintext" >> return Plaintext-                      , optionalQuotedString "diamond" >> return DiamondShape-                      , optionalQuotedString "trapezium" >> return Trapezium-                      , optionalQuotedString "parallelogram" >> return Parallelogram-                      , optionalQuotedString "house" >> return House-                      , optionalQuotedString "pentagon" >> return Pentagon-                      , optionalQuotedString "hexagon" >> return Hexagon-                      , optionalQuotedString "septagon" >> return Septagon-                      , optionalQuotedString "octagon" >> return Octagon-                      , optionalQuotedString "doublecircle" >> return Doublecircle-                      , optionalQuotedString "doubleoctagon" >> return Doubleoctagon-                      , optionalQuotedString "tripleoctagon" >> return Tripleoctagon-                      , optionalQuotedString "invtriangle" >> return Invtriangle-                      , optionalQuotedString "invtrapezium" >> return Invtrapezium-                      , optionalQuotedString "invhouse" >> return Invhouse-                      , optionalQuotedString "mdiamond" >> return Mdiamond-                      , optionalQuotedString "msquare" >> return Msquare-                      , optionalQuotedString "mcircle" >> return Mcircle-                      , optionalQuotedString "rectangle" >> return Rectangle-                      , optionalQuotedString "none" >> return NoShape-                      , optionalQuotedString "note" >> return Note-                      , optionalQuotedString "tab" >> return Tab-                      , optionalQuotedString "folder" >> return Folder-                      , optionalQuotedString "box3d" >> return Box3d-                      , optionalQuotedString "component" >> return Component-                      ]--data StyleType = Filled | Invisible | Diagonals | Rounded | Dashed | Dotted | Solid | Bold-                 deriving (Eq)--instance Show StyleType where-    show Filled = "filled"-    show Invisible = "invisible"-    show Diagonals = "diagonals"-    show Rounded = "rounded"-    show Dashed = "dashed"-    show Dotted = "dotted"-    show Solid = "solid"-    show Bold = "bold"--readStyleType :: Parser Char StyleType-readStyleType-              = oneOf [ optionalQuotedString "filled" >> return Filled-                      , optionalQuotedString "invisible" >> return Invisible-                      , optionalQuotedString "diagonals" >> return Diagonals-                      , optionalQuotedString "rounded" >> return Rounded-                      , optionalQuotedString "dashed" >> return Dashed-                      , optionalQuotedString "dotted" >> return Dotted-                      , optionalQuotedString "solid" >> return Solid-                      , optionalQuotedString "bold" >> return Bold-                      ]--data Point = Point Int Int-           | PointD Double Double-             deriving (Eq)--newtype PointList = PointList [Point]-                    deriving (Eq)--instance Show Point where-    show (Point x y) = show $ (show x) ++ (',':(show y))-    show (PointD x y) = show $ (show x) ++ (',':(show y))--instance Show PointList where-    show (PointList points) = show $ case foldr s "" points of-                                       [] -> ""-                                       str -> tail str-        where-          s (Point x y) acc = ' ':((show x) ++ (',':((show y) ++ acc)))-          s (PointD x y) acc = ' ':((show x) ++ (',':((show y) ++ acc)))--readPoint :: Parser Char Point-readPoint = char '"' >> oneOf [readPointI, readPointD]-    where-      readPointI = do { x <- number-                      ; char ','-                      ; y <- number-                      ; char '"'-                      ; return $ Point x y-                      }-      readPointD = do { x <- floatingNumber-                      ; char ','-                      ; y <- floatingNumber-                      ; char '"'-                      ; return $ PointD x y-                      }--readPointList :: Parser Char PointList-readPointList-    = do { char '"'-         ; points <- many pointPair-         ; char '"'-         ; return $ PointList points-         }-    where-          pointPair-              = do { x <- number-                   ; char ','-                   ; y <- number-                   ; optional (char ' ')-                   ; return $ Point x y-                   }--data Rect = Rect Point Point-            deriving (Eq)--instance Show Rect where-    show (Rect (Point x1 y1) (Point x2 y2))-        = show $ (show x1) ++ (',': ((show y1) ++ (',': ((show x2) ++ (',': (show y2))))))-    show (Rect (Point x1 y1) (PointD x2 y2))-        = show $ (show x1) ++ (',': ((show y1) ++ (',': ((show x2) ++ (',': (show y2))))))-    show (Rect (PointD x1 y1) (Point x2 y2))-        = show $ (show x1) ++ (',': ((show y1) ++ (',': ((show x2) ++ (',': (show y2))))))-    show (Rect (PointD x1 y1) (PointD x2 y2))-        = show $ (show x1) ++ (',': ((show y1) ++ (',': ((show x2) ++ (',': (show y2))))))--readRect :: Parser Char Rect-readRect = do { char '"'-              ; x1 <- number-              ; char ','-              ; y1 <- number-              ; char ','-              ; x2 <- number-              ; char ','-              ; y2 <- number-              ; char '"'-              ; return (Rect (Point x1 y1) (Point x2 y2))-              }--data ScaleType = Scale | NoScale | FitX | FitY-                 deriving (Eq)--instance Show ScaleType where-    show Scale = "true"-    show NoScale = "false"-    show FitX = "width"-    show FitY = "height"--readScaleType :: Parser Char ScaleType-readScaleType = oneOf [ optionalQuotedString "true" >> return Scale-                      , optionalQuotedString "false" >> return NoScale-                      , optionalQuotedString "width" >> return FitX-                      , optionalQuotedString "height" >> return FitY-                      ]--data Justification = JLeft | JRight | JCenter-                     deriving (Eq)--instance Show Justification where-    show JLeft = "l"-    show JRight = "r"-    show JCenter = "c"--readJustification :: Parser Char Justification-readJustification = oneOf [ optionalQuotedString "l" >> return JLeft-                          , optionalQuotedString "r" >> return JRight-                          , optionalQuotedString "c" >> return JCenter-                          ]--data VerticalPlacement = VTop | VCenter | VBottom-                         deriving (Eq)--instance Show VerticalPlacement where-    show VTop = "t"-    show VCenter = "c"-    show VBottom = "b"--readVerticalPlacement :: Parser Char VerticalPlacement-readVerticalPlacement-              = oneOf [ optionalQuotedString "t" >> return VTop-                      , optionalQuotedString "c" >> return VCenter-                      , optionalQuotedString "b" >> return VBottom-                      ]--data Attribute-    = ArrowHead ArrowType-    | ArrowSize Double-    | ArrowTail ArrowType-    | Bb Rect-    | BgColor ColorType-    | Center Bool-    | Color ColorType-    | Concentrate Bool-    | Constraint Bool-    | Decorate Bool-    | DefaultDist Double-    | Dir DirType-    | Dpi Double-    | FillColor ColorType-    | FixedSize Bool-    | FontColor ColorType-    | FontName String-    | FontSize Double-    | Group String-    | HeadClip Bool-    | HeadLabel String-    | Height Double-    | Image String-    | ImageScale ScaleType-    | Label String-    | LabelAngle Double-    | LabelDistance Double-    | LabelFloat Bool-    | LabelFontColor ColorType-    | LabelFontName String-    | LabelFontSize Double-    | LabelJust Justification-    | LabelLoc VerticalPlacement-    | Landscape Bool-    | Len Double-    | Margin Double Double-    | MinDist Double-    | Minlen Double-    | Nodesep Double-    | NoJustify Bool-    | Normalize Bool-    | Orientation Double-    | OutputOrder OutputMode-    | Overlap Bool-    | Pad Double Double-    | Page Double Double-    | PageDir PageDir-    | PenColor ColorType-    | Pos PointList-    | Quantum Double-    | RankDir PageDir-    | RankSep Double-    | Ratio Double-    | Regular Bool-    | Rotate Double-    | SameHead String-    | SameTail String-    | Sep Double-    | Shape ShapeType-    | Sides Int-    | Size Double Double-    | Skew Double-    | Splines (Maybe Bool)-    | Style StyleType-    | TailClip Bool-    | TailLabel String-    | Weight Double-    | Width Double-    | Unknown String String-      deriving (Eq)--instance Show Attribute where-    show (ArrowHead arrowtype) = "arrowhead=" ++ (show arrowtype)-    show (ArrowSize double) = "arrowsize=" ++ (show double)-    show (ArrowTail arrowtype) = "arrowtail=" ++ (show arrowtype)-    show (Bb rect) = "bb=" ++ (show rect)-    show (BgColor colortype) = "bgcolor=" ++ (show colortype)-    show (Center bool) = "center=" ++ (show bool)-    show (Color colortype) = "color=" ++ (show colortype)-    show (Concentrate bool) = "concentrate=" ++ (show bool)-    show (Constraint bool) = "constraint=" ++ (show bool)-    show (Decorate bool) = "decorate=" ++ (show bool)-    show (DefaultDist double) = "defaultdist=" ++ (show double)-    show (Dir dirtype) = "dir=" ++ (show dirtype)-    show (Dpi double) = "dpi=" ++ (show double)-    show (FillColor colortype) = "fillcolor=" ++ (show colortype)-    show (FixedSize bool) = "fixedsize=" ++ (show bool)-    show (FontColor colortype) = "fontcolor=" ++ (show colortype)-    show (FontName string) = "fontname=" ++ (show string)-    show (FontSize double) = "fontsize=" ++ (show double)-    show (Group string) = "group=" ++ (show string)-    show (HeadClip bool) = "headclip=" ++ (show bool)-    show (HeadLabel string) = "headlabel=" ++ (show string)-    show (Height double) = "height=" ++ (show double)-    show (Image string) = "image=" ++ (show string)-    show (ImageScale scaletype) = "imagescale=" ++ (show scaletype)-    show (Label string) = "label=" ++ (show string)-    show (LabelAngle double) = "labelangle=" ++ (show double)-    show (LabelDistance double) = "labeldistance=" ++ (show double)-    show (LabelFloat bool) = "labelfloat=" ++ (show bool)-    show (LabelFontColor colortype) = "labelfontcolor=" ++ (show colortype)-    show (LabelFontName string) = "labelfontname=" ++ (show string)-    show (LabelFontSize double) = "labelfontsize=" ++ (show double)-    show (LabelJust justification) = "labeljust=" ++ (show justification)-    show (LabelLoc verticalplacement) = "labelloc=" ++ (show verticalplacement)-    show (Landscape bool) = "landscape=" ++ (show bool)-    show (Len double) = "len=" ++ (show double)-    show (Margin double1 double2) = "margin=" ++ (show $ PointD double1 double2)-    show (MinDist double) = "mindist=" ++ (show double)-    show (Minlen double) = "minlen=" ++ (show double)-    show (Nodesep double) = "nodesep=" ++ (show double)-    show (NoJustify bool) = "nojustify=" ++ (show bool)-    show (Normalize bool) = "normalize=" ++ (show bool)-    show (Orientation double) = "orientation=" ++ (show double)-    show (OutputOrder outputmode) = "outputorder=" ++ (show outputmode)-    show (Overlap bool) = "overlap=" ++ (show bool)-    show (Pad double1 double2) = "pad=" ++ (show $ PointD double1 double2)-    show (Page double1 double2) = "page=" ++ (show $ PointD double1 double2)-    show (PageDir pagedir) = "pagedir=" ++ (show pagedir)-    show (PenColor colortype) = "pencolor=" ++ (show colortype)-    show (Pos pointlist) = "pos=" ++ (show pointlist)-    show (Quantum double) = "quantum=" ++ (show double)-    show (RankDir pagedir) = "rankdir=" ++ (show pagedir)-    show (RankSep double) = "ranksep=" ++ (show double)-    show (Ratio double) = "ratio=" ++ (show double)-    show (Regular bool) = "regular=" ++ (show bool)-    show (Rotate double) = "rotate=" ++ (show double)-    show (SameHead string) = "samehead=" ++ (show string)-    show (SameTail string) = "sametail=" ++ (show string)-    show (Sep double) = "sep=" ++ (show double)-    show (Shape shapetype) = "shape=" ++ (show shapetype)-    show (Sides int) = "sides=" ++ (show int)-    show (Size double1 double2) = "size=" ++ (show $ PointD double1 double2)-    show (Skew double) = "skew=" ++ (show double)-    show (Splines maybebool) = "splines=" ++ (show (fromMaybe [] (liftM show maybebool)))-    show (Style styletype) = "style=" ++ (show styletype)-    show (TailClip bool) = "tailclip=" ++ (show bool)-    show (TailLabel string) = "taillabel=" ++ (show string)-    show (Weight double) = "weight=" ++ (show double)-    show (Width double) = "width=" ++ (show double)-    show (Unknown key value) = (show key) ++ ('=':(show . show $ value))--readBool :: Parser Char Bool-readBool = oneOf [ (optionalQuotedString "true" >> return True)-                 , (optionalQuotedString "false" >> return False)-                 , (optionalQuotedString "True" >> return True)-                 , (optionalQuotedString "False" >> return False)-                 ]--readString :: Parser Char String-readString = oneOf [quoted, nonquoted]-    where-      quoted = do { char '"'-                  ; str <- liftM concat . many . oneOf $ [nonescaped, escapedPair]-                  ; char '"'-                  ; return str-                  }-      nonquoted = many $ noneOf ['"', ' ', ',', '\t', '\n', '\r', ']']-      escapedPair = do { char '\\'-                       ; oneOf [ char '"' >> return "\""-                               , char 't' >> return "\t"-                               , char 'n' >> return "\n"-                               , char 'r' >> return "\r"-                               , satisfy (const True) >>= \c -> return ['\\', c]-                               ]-                       }-      nonescaped = liftM (: []) . noneOf $ ['\\', '"']--readAttribute :: Parser Char Attribute-readAttribute-              = oneOf-                [ string "arrowhead=" >> readArrowType >>= return . ArrowHead-                , string "arrowsize=" >> optionalQuoted floatingNumber >>= return . ArrowSize-                , string "arrowtail=" >> readArrowType >>= return . ArrowTail-                , string "bb=" >> readRect >>= return . Bb-                , string "bgcolor=" >> readColorType >>= return . BgColor-                , string "center=" >> readBool >>= return . Center-                , string "color=" >> readColorType >>= return . Color-                , string "concentrate=" >> readBool >>= return . Concentrate-                , string "constraint=" >> readBool >>= return . Constraint-                , string "decorate=" >> readBool >>= return . Decorate-                , string "defaultdist=" >> optionalQuoted floatingNumber >>= return . DefaultDist-                , string "dir=" >> readDirType >>= return . Dir-                , string "dpi=" >> optionalQuoted floatingNumber >>= return . Dpi-                , string "fillcolor=" >> readColorType >>= return . FillColor-                , string "fixedsize=" >> readBool >>= return . FixedSize-                , string "fontcolor=" >> readColorType >>= return . FontColor-                , string "fontname=" >> readString >>= return . FontName-                , string "fontsize=" >> optionalQuoted floatingNumber >>= return . FontSize-                , string "group=" >> readString >>= return . Group-                , string "headclip=" >> readBool >>= return . HeadClip-                , string "headlabel=" >> readString >>= return . HeadLabel-                , string "height=" >> optionalQuoted floatingNumber >>= return . Height-                , string "image=" >> readString >>= return . Image-                , string "imagescale=" >> readScaleType >>= return . ImageScale-                , string "label=" >> readString >>= return . Label-                , string "labelangle=" >> optionalQuoted floatingNumber >>= return . LabelAngle-                , string "labeldistance=" >> optionalQuoted floatingNumber >>= return . LabelDistance-                , string "labelfloat=" >> readBool >>= return . LabelFloat-                , string "labelfontcolor=" >> readColorType >>= return . LabelFontColor-                , string "labelfontname=" >> readString >>= return . LabelFontName-                , string "labelfontsize=" >> optionalQuoted floatingNumber >>= return . LabelFontSize-                , string "labeljust=" >> readJustification >>= return . LabelJust-                , string "labelloc=" >> readVerticalPlacement >>= return . LabelLoc-                , string "landscape=" >> readBool >>= return . Landscape-                , string "len=" >> optionalQuoted floatingNumber >>= return . Len-                , string "margin=" >> readPoint >>= \(PointD x y) -> return $ Margin x y-                , string "mindist=" >> optionalQuoted floatingNumber >>= return . MinDist-                , string "minlen=" >> optionalQuoted floatingNumber >>= return . Minlen-                , string "nodesep=" >> optionalQuoted floatingNumber >>= return . Nodesep-                , string "nojustify=" >> readBool >>= return . NoJustify-                , string "normalize=" >> readBool >>= return . Normalize-                , string "orientation=" >> optionalQuoted floatingNumber >>= return . Orientation-                , string "outputorder=" >> readOutputMode >>= return . OutputOrder-                , string "overlap=" >> readBool >>= return . Overlap-                , string "pad=" >> readPoint >>= \(PointD x y) -> return $ Pad x y-                , string "page=" >> readPoint >>= \(PointD x y) -> return $ Page x y-                , string "pagedir=" >> readPageDir >>= return . PageDir-                , string "pencolor=" >> readColorType >>= return . PenColor-                , string "pos=" >> readPointList >>= return . Pos-                , string "quantum=" >> optionalQuoted floatingNumber >>= return . Quantum-                , string "rankdir=" >> readPageDir >>= return . RankDir-                , string "ranksep=" >> optionalQuoted floatingNumber >>= return . RankSep-                , string "ratio=" >> optionalQuoted floatingNumber >>= return . Ratio-                , string "regular=" >> readBool >>= return . Regular-                , string "rotate=" >> optionalQuoted floatingNumber >>= return . Rotate-                , string "samehead=" >> readString >>= return . SameHead-                , string "sametail=" >> readString >>= return . SameTail-                , string "sep=" >> optionalQuoted floatingNumber >>= return . Sep-                , string "shape=" >> readShapeType >>= return . Shape-                , string "sides=" >> optionalQuoted number >>= return . Sides-                , string "size=" >> readPoint >>= \(PointD x y) -> return $ Size x y-                , string "skew=" >> optionalQuoted floatingNumber >>= return . Skew-                , string "splines=" >> (oneOf [(string "\"\"" >> return Nothing), readBool >>= return . Just]) >>= return . Splines-                , string "style=" >> readStyleType >>= return . Style-                , string "tailclip=" >> readBool >>= return . TailClip-                , string "taillabel=" >> readString >>= return . TailLabel-                , string "weight=" >> optionalQuoted floatingNumber >>= return . Weight-                , string "width=" >> optionalQuoted floatingNumber >>= return . Width-                , many (noneOf ['=', '"', ' ', ',', '\t', '\n', '\r', ']']) >>= \key -> char '=' >> readString >>= return . Unknown key-                ]--readAttributesList :: Parser Char [Attribute]-readAttributesList = do { char '['-                        ; as <- many (optional whitespace >> readAttribute >>= \a -> optional whitespace >> optional (char ',') >> return a)-                        ; optional whitespace-                        ; char ']'-                        ; return as-                        }+{- |+   Module      : Data.GraphViz.Attributes+   Description : Definition of the GraphViz attributes.+   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic+   License     : 3-Clause BSD-style+   Maintainer  : Ivan.Miljenovic@gmail.com++   This module defines the various attributes that different parts of+   a GraphViz graph can have.  These attributes are based on the+   documentation found at:++     <http://graphviz.org/doc/info/attrs.html>++   For more information on usage, etc. please see that document.++   A summary of known current constraints\/limitations\/differences:++   * 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.++ -}++module Data.GraphViz.Attributes where++import Data.GraphViz.ParserCombinators++import Data.Char(isDigit, isHexDigit)+import Data.Word+import Numeric+import Control.Monad+import Data.Maybe++-- -----------------------------------------------------------------------------++{- |++   These attributes have been implemented in a /permissive/ manner:+   that is, rather than split them up based on which type of value+   they are allowed, they have all been included in the one data type,+   with functions to determine if they are indeed valid for what+   they're being applied to.++   To interpret the /Valid for/ listings:++     [@G@] Valid for Graphs.++     [@C@] Valid for Clusters.++     [@S@] Valid for Sub-Graphs (and also Clusters).++     [@N@] Valid for Nodes.++     [@E@] Valid for Edges.++   Note also that the default values are taken from the specification+   page listed above, and might not correspond fully with the names of+   the permitted values.+-}+data Attribute+    = Damping Double                          -- ^ /Valid for/: G; /Default/: 0.99; /Minimum/: 0.0; /Notes/: neato only+    | K Double                                -- ^ /Valid for/: GC; /Default/: 0.3; /Minimum/: 0; /Notes/: sfdp, fdp only+    | URL URL                                 -- ^ /Valid for/: ENGC; /Default/: \<none\>; /Notes/: svg, postscript, map only+    | ArrowHead ArrowType                     -- ^ /Valid for/: E; /Default/: Normal+    | ArrowSize Double                        -- ^ /Valid for/: E; /Default/: 1.0; /Minimum/: 0.0+    | ArrowTail ArrowType                     -- ^ /Valid for/: E; /Default/: Normal+    | Aspect AspectType                       -- ^ /Valid for/: G; /Notes/: dot only+    | Bb Rect                                 -- ^ /Valid for/: G; /Notes/: write only+    | BgColor Color                           -- ^ /Valid for/: GC; /Default/: \<none\>+    | Center Bool                             -- ^ /Valid for/: G; /Default/: false+    | Charset String                          -- ^ /Valid for/: G; /Default/: \"UTF-8\"+    | ClusterRank ClusterMode                 -- ^ /Valid for/: G; /Default/: local; /Notes/: dot only+    | Color (Either 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 (Either String Bool) -- ^ /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+    | EdgeHref URL                            -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only+    | EdgeTarget String                       -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only+    | EdgeTooltip String                      -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only+    | Epsilon Double                          -- ^ /Valid for/: G; /Default/: .0001 * # nodes(mode == KK) | .0001(mode == major); /Notes/: neato only+    | ESep (Either Double Point)              -- ^ /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+    | HeadHref URL                            -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only+    | HeadLabel (Either String URL)           -- ^ /Valid for/: E; /Default/: \"\"+    | HeadPort PortPos                        -- ^ /Valid for/: E; /Default/: center+    | HeadTarget QuotedString                 -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only+    | HeadTooltip QuotedString                -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only+    | Height Double                           -- ^ /Valid for/: N; /Default/: 0.5; /Minimum/: 0.02+    | Href URL                                -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, postscript, map only+    | ID (Either String URL)                  -- ^ /Valid for/: GNE; /Default/: \"\"; /Notes/: svg, postscript, map only+    | Image String                            -- ^ /Valid for/: N; /Default/: \"\"+    | ImageScale ScaleType                    -- ^ /Valid for/: N; /Default/: false+    | Label (Either String URL)               -- ^ /Valid for/: ENGC; /Default/: \"\N\" (nodes) | \"\" (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+    | 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+    | LabelHref URL                           -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only+    | LabelJust Justification                 -- ^ /Valid for/: GC; /Default/: \"c\"+    | LabelLoc VerticalPlacement              -- ^ /Valid for/: GCN; /Default/: \"t\"(clusters) | \"b\"(root graphs) | \"c\"(clusters)+    | LabelTarget String                      -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only+    | LabelTooltip String                     -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only+    | Landscape Bool                          -- ^ /Valid for/: G; /Default/: false+    | Layer LayerRange                        -- ^ /Valid for/: EN; /Default/: \"\"+    | Layers LayerList                        -- ^ /Valid for/: G; /Default/: \"\"+    | LayerSep String                         -- ^ /Valid for/: G; /Default/: \" :\t\"+    | Layout String                           -- ^ /Valid for/: G; /Default/: \"\"+    | Len Double                              -- ^ /Valid for/: E; /Default/: 1.0(neato)/0.3(fdp); /Notes/: fdp, neato only+    | Levels Int                              -- ^ /Valid for/: G; /Default/: MAXINT; /Minimum/: 0.0; /Notes/: sfdp only+    | LevelsGap Double                        -- ^ /Valid for/: G; /Default/: 0.0; /Notes/: neato only+    | LHead String                            -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only+    | LP Point                                -- ^ /Valid for/: EGC; /Notes/: write only+    | LTail String                            -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: dot only+    | Margin (Either Double Point)            -- ^ /Valid for/: NG; /Default/: \<device-dependent\>+    | MaxIter Int                             -- ^ /Valid for/: G; /Default/: 100 * # nodes(mode == KK) | 200(mode == major) | 600(fdp); /Notes/: fdp, neato only+    | MCLimit Double                          -- ^ /Valid for/: G; /Default/: 1.0; /Notes/: dot only+    | MinDist Double                          -- ^ /Valid for/: G; /Default/: 1.0; /Minimum/: 0.0; /Notes/: circo only+    | MinLen Int                              -- ^ /Valid for/: E; /Default/: 1; /Minimum/: 0; /Notes/: dot only+    | Mode String                             -- ^ /Valid for/: G; /Default/: \"major\"; /Notes/: neato only+    | Model String                            -- ^ /Valid for/: G; /Default/: \"shortpath\"; /Notes/: neato only+    | Mosek Bool                              -- ^ /Valid for/: G; /Default/: false; /Notes/: neato only; requires the Mosek software+    | NodeSep Double                          -- ^ /Valid for/: G; /Default/: 0.25; /Minimum/: 0.02; /Notes/: dot only+    | NoJustify Bool                          -- ^ /Valid for/: GCNE; /Default/: false+    | Normalize Bool                          -- ^ /Valid for/: G; /Default/: false; /Notes/: not dot+    | Nslimit Double                          -- ^ /Valid for/: G; /Notes/: dot only+    | Nslimit1 Double                         -- ^ /Valid for/: G; /Notes/: dot only+    | Ordering String                         -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: dot only+    | Orientation Double                      -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: 360.0+    | OrientationGraph String                 -- ^ /Valid for/: G; /Default/: \"\"; /Notes/: Landscape if \"[lL]*\" and rotate not defined+    | OutputOrder OutputMode                  -- ^ /Valid for/: G; /Default/: breadthfirst+    | Overlap (Either String Bool)            -- ^ /Valid for/: G; /Default/: true; /Notes/: not dot+    | OverlapScaling Double                   -- ^ /Valid for/: G; /Default/: -4; /Minimum/: -1.0e10; /Notes/: prism only+    | Pack (Either Bool Int)                  -- ^ /Valid for/: G; /Default/: false; /Notes/: not dot+    | PackMode PackMode                       -- ^ /Valid for/: G; /Default/: node; /Notes/: not dot+    | Pad (Either Double Point)               -- ^ /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 (Either Point [Spline])             -- ^ /Valid for/: EN+    | QuadTree (Either QuadType Bool)         -- ^ /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 (Either String Bool)               -- ^ /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 (Either Double Point)               -- ^ /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 (Either Bool String)            -- ^ /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+    | TailHref URL                            -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, map only+    | TailLabel (Either String URL)           -- ^ /Valid for/: E; /Default/: \"\"+    | TailPort PortPos                        -- ^ /Valid for/: E; /Default/: center+    | TailTarget String                       -- ^ /Valid for/: E; /Default/: \<none\>; /Notes/: svg, map only+    | TailTooltip String                      -- ^ /Valid for/: E; /Default/: \"\"; /Notes/: svg, cmap only+    | Target String                           -- ^ /Valid for/: ENGC; /Default/: \<none\>; /Notes/: svg, map only+    | Tooltip String                          -- ^ /Valid for/: NEC; /Default/: \"\"; /Notes/: svg, cmap only+    | TrueColor Bool                          -- ^ /Valid for/: G; /Notes/: bitmap output only+    | Vertices [Point]                        -- ^ /Valid for/: N; /Notes/: write only+    | ViewPort ViewPort                       -- ^ /Valid for/: G; /Default/: \"\"+    | VoroMargin Double                       -- ^ /Valid for/: G; /Default/: 0.05; /Minimum/: 0.0; /Notes/: not dot+    | Weight Double                           -- ^ /Valid for/: E; /Default/: 1.0; /Minimum/: 0(dot) | 1(neato,fdp,sfdp)+    | Width Double                            -- ^ /Valid for/: N; /Default/: 0.75; /Minimum/: 0.01+    | Z Double                                -- ^ /Valid for/: N; /Default/: 0.0; /Minimum/: -MAXFLOAT | -1000+      deriving (Eq, Read)++instance Show Attribute where+    show (Damping v)            = "Damping=" ++ show v+    show (K v)                  = "K=" ++ show v+    show (URL v)                = "URL=" ++ show v+    show (ArrowHead v)          = "arrowhead=" ++ show v+    show (ArrowSize v)          = "arrowsize=" ++ show v+    show (ArrowTail v)          = "arrowtail=" ++ show v+    show (Aspect v)             = "aspect=" ++ show v+    show (Bb v)                 = "bb=" ++ show v+    show (BgColor v)            = "bgcolor=" ++ show v+    show (Center v)             = "center=" ++ show v+    show (Charset v)            = "charset=" ++ v+    show (ClusterRank v)        = "clusterrank=" ++ show v+    show (Color v)              = "color=" ++ show v+    show (ColorScheme v)        = "colorscheme=" ++ v+    show (Comment v)            = "comment=" ++ v+    show (Compound v)           = "compound=" ++ show v+    show (Concentrate v)        = "concentrate=" ++ show v+    show (Constraint v)         = "constraint=" ++ show v+    show (Decorate v)           = "decorate=" ++ show v+    show (DefaultDist v)        = "defaultdist=" ++ show v+    show (Dim v)                = "dim=" ++ show v+    show (Dimen v)              = "dimen=" ++ show v+    show (Dir v)                = "dir=" ++ show v+    show (DirEdgeConstraints v) = "diredgeconstraints=" ++ show v+    show (Distortion v)         = "distortion=" ++ show v+    show (DPI v)                = "dpi=" ++ show v+    show (EdgeURL v)            = "edgeURL=" ++ show v+    show (EdgeHref v)           = "edgehref=" ++ 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 (HeadHref v)           = "headhref=" ++ 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 (Href v)               = "href=" ++ 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 (LabelHref v)          = "labelhref=" ++ 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 (TailHref v)           = "tailhref=" ++ 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                $ parseField "URL"+                  , 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 $ parseField "diredgeconstraints"+                  , liftM Distortion         $ parseField "distortion"+                  , liftM DPI                $ parseField "dpi"+                  , liftM EdgeURL            $ parseField "edgeURL"+                  , liftM EdgeHref           $ parseField "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            $ parseField "headURL"+                  , liftM HeadClip           $ parseBoolField "headclip"+                  , liftM HeadHref           $ parseField "headhref"+                  , liftM HeadLabel          $ parseField "headlabel"+                  , liftM HeadPort           $ parseField "headport"+                  , liftM HeadTarget         $ parseField "headtarget"+                  , liftM HeadTooltip        $ parseField "headtooltip"+                  , liftM Height             $ parseField "height"+                  , liftM Href               $ parseField "href"+                  , liftM ID                 $ parseField "id"+                  , liftM Image              $ parseField "image"+                  , liftM ImageScale         $ parseField "imagescale"+                  , liftM Label              $ parseField "label"+                  , liftM LabelURL           $ parseField "labelURL"+                  , 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 LabelHref          $ parseField "labelhref"+                  , 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            $ parseField "overlap"+                  , liftM OverlapScaling     $ parseField "overlap_scaling"+                  , liftM Pack               $ parseField "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           $ parseField "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               $ parseField "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            $ parseField "splines"+                  , liftM Start              $ parseField "start"+                  , liftM Style              $ parseField "style"+                  , liftM StyleSheet         $ parseField "stylesheet"+                  , liftM TailURL            $ parseField "tailURL"+                  , liftM TailClip           $ parseBoolField "tailclip"+                  , liftM TailHref           $ parseField "tailhref"+                  , 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 EdgeHref{}       = True+usedByEdges EdgeTarget{}     = True+usedByEdges EdgeTooltip{}    = True+usedByEdges FontColor{}      = True+usedByEdges FontName{}       = True+usedByEdges FontSize{}       = True+usedByEdges HeadURL{}        = True+usedByEdges HeadClip{}       = True+usedByEdges HeadHref{}       = True+usedByEdges HeadLabel{}      = True+usedByEdges HeadPort{}       = True+usedByEdges HeadTarget{}     = True+usedByEdges HeadTooltip{}    = True+usedByEdges Href{}           = 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 LabelHref{}      = 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 TailHref{}       = 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)      = show $ '#' : foldr showWord8Pad "" [r,g,b]+showColor (RGBA r g b a)   = show $ '#' : foldr showWord8Pad "" [r,g,b,a]+showColor (HSV h s v)      = show $ 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+                    ]++-- -----------------------------------------------------------------------------++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 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 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++-- -----------------------------------------------------------------------------++-- | 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+    parse = optionalQuoted+            $ oneOf [ string "normal" >> return NormalQT+                    , string "fast"   >> return FastQT+                    , string "none"   >> return NoQT+                    ]++-- -----------------------------------------------------------------------------++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+               | NodeName String+                 deriving (Eq, Read)++instance Show FocusType where+    show (XY p)        = showPoint p+    show (NodeName nm) = nm++instance Parseable FocusType where+    parse = oneOf [ liftM XY parsePoint+                  , liftM NodeName 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++-- -----------------------------------------------------------------------------

@@ -30,15 +30,15 @@ import System.Process import Data.Array.IO import Control.Concurrent-import Control.Exception+import Control.Exception.Extensible  import Data.GraphViz.Types  -- | The available Graphviz commands.-data GraphvizCommand = DotCmd | Neato | TwoPi | Circo | Fdp+data GraphvizCommand = Dot | Neato | TwoPi | Circo | Fdp  instance Show GraphvizCommand where-    show DotCmd = "dot"+    show Dot    = "dot"     show Neato  = "neato"     show TwoPi  = "twopi"     show Circo  = "circo"@@ -46,7 +46,7 @@  -- | The default command for directed graphs. dirCommand :: GraphvizCommand-dirCommand = DotCmd+dirCommand = Dot  -- | The default command for undirected graphs. undirCommand :: GraphvizCommand@@ -62,7 +62,9 @@ --   Note that it is not possible to choose between output variants, --   and that not all of these may be available on your system. -----   This will probably be improved in future.+--   This will probably be improved in future.  For now, more+--   information is available from:+--     <http://graphviz.org/doc/info/output.html> data GraphvizOutput = Canon                     | Cmap                     | Cmapx@@ -156,7 +158,8 @@ runGraphvizCommand :: GraphvizCommand -> DotGraph -> GraphvizOutput                    -> FilePath -> IO Bool runGraphvizCommand  cmd gr t fp-    = do pipe <- tryJust catcher $ openFile fp WriteMode+    = do pipe <- tryJust (\(SomeException _) -> return ())+                 $ openFile fp WriteMode          case pipe of            (Left _)  -> return False            (Right f) -> do file <- graphvizWithHandle cmd gr t (flip squirt f)@@ -164,26 +167,23 @@                            case file of                              (Just _) -> return True                              _        -> return False-    where-      catcher   :: IOError -> Maybe ()-      catcher _ = Just ()  -- graphvizWithHandle sometimes throws an error about handles not--- being closed properly: investigate.+-- being closed properly: investigate (now on the official TODO).  -- | 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)+                      -> (Handle -> IO a) -> IO (Maybe a) graphvizWithHandle cmd gr t f-    = do (inp, outp, errp, proc) <- runInteractiveCommand command+    = do (inp, outp, errp, prc) <- runInteractiveCommand command          forkIO $ hPrint inp gr >> hClose inp          forkIO $ (hGetContents errp >>= hPutStr stderr >> hClose errp)          a <- f outp          -- Don't close outp until f finishes.          a `seq` hClose outp-         exitCode <- waitForProcess proc+         exitCode <- waitForProcess prc          case exitCode of            ExitSuccess -> return (Just a)            _           -> return Nothing

@@ -8,50 +8,231 @@    Maintainer  : Ivan.Miljenovic@gmail.com     This module defines simple helper functions for use with-   @Text.ParserCombinators.Poly.Lazy@.+   "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 where+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+    , 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 -string :: String -> Parser Char String+-- -----------------------------------------------------------------------------+-- 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++instance (Parseable a, Parseable b) => Parseable (Either a b) where+    parse = oneOf [ liftM Left parse+                  , liftM Right parse+                  ]++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] -> Parser Char String+strings :: [String] -> Parse String strings = oneOf . map string -char :: Char -> Parser Char Char-char = satisfy . (==)+hasString :: String -> Parse Bool+hasString = liftM isJust . optional . string -noneOf :: (Eq a) => [a] -> Parser a a-noneOf t = satisfy (\x -> and . map ((/= x) $) $ t)+char   :: Char -> Parse Char+char c = satisfy (((==) `on` toLower) c)+         `adjustErr`+         (++ "\nnot the expected char: " ++ [c]) -digit :: Parser Char Char-digit = oneOf . map char $ ['0'..'9']+noneOf :: (Eq a) => [a] -> Parser a a+noneOf t = satisfy (\x -> all (/= x) t) -number :: (Num a, Read a) => Parser Char a-number = liftM read $ many1 digit+whitespace :: Parse String+whitespace = many1 (satisfy isSpace) -floatingNumber :: (Floating a, Read a) => Parser Char a-floatingNumber = do { a::Integer <- number-                    ; char '.'-                    ; b::Integer <- number-                    ; return . read $ (show a) ++ ('.':(show b))-                    }+whitespace' :: Parse String+whitespace' = many (satisfy isSpace) -whitespace :: Parser Char String-whitespace = many1 (oneOf . map char $ [' ', '\t'])+optionalQuotedString :: String -> Parse String+optionalQuotedString = optionalQuoted . string -optionalQuotedString :: String -> Parser Char String-optionalQuotedString s = oneOf [string s, char '"' >> string s >>= \s' -> char '"' >> return s']+optionalQuoted   :: Parse a -> Parse a+optionalQuoted p = oneOf [ p+                         , quotedParse p+                         ] -optionalQuoted :: Parser Char a -> Parser Char a-optionalQuoted p = oneOf [p, char '"' >> p >>= \r -> char '"' >> return r]+quotedParse   :: Parse a -> Parse a+quotedParse p = char '"' >> p `discard` char '"' -newline :: Parser Char String+newline :: Parse String newline = oneOf . map string $ ["\r\n", "\n", "\r"] -skipToNewline :: Parser Char ()+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 fld = oneOf [ parseField fld+                           , string fld >> return True+                           ]++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)

@@ -1,7 +1,3 @@-{-# LANGUAGE NamedFieldPuns-           , ScopedTypeVariables-           #-}- {- |    Module      : Data.GraphViz.Types    Description : Definition of the GraphViz types.@@ -10,41 +6,81 @@    Maintainer  : Ivan.Miljenovic@gmail.com     This module defines the overall types and methods that interact-   with them for the GraphViz library.+   with them for the GraphViz library.  The specifications are based+   loosely upon the information available at:+     <http://graphviz.org/doc/info/lang.html> -}  module Data.GraphViz.Types     ( DotGraph(..)+    , GraphID(..)     , DotNode(..)     , DotEdge(..)-    , readDotGraph+    , parseDotGraph+    , setID+    , makeStrict+    , isValidGraph+    , invalidAttributes     ) where -import Data.Maybe-import Control.Monad-import Text.ParserCombinators.Poly.Lazy- import Data.GraphViz.Attributes import Data.GraphViz.ParserCombinators +import Data.Maybe+import Control.Monad+ -- -----------------------------------------------------------------------------  -- | The internal representation of a graph in Dot form.-data DotGraph = DotGraph { graphAttributes :: [Attribute]-                         , graphNodes :: [DotNode]-                         , graphEdges :: [DotEdge]-                         , directedGraph :: Bool+data DotGraph = DotGraph { strictGraph     :: Bool+                         , directedGraph   :: Bool+                         , graphID         :: Maybe GraphID+                         , graphAttributes :: [Attribute]+                         , graphNodes      :: [DotNode]+                         , graphEdges      :: [DotEdge]                          }+                deriving (Eq, Read) +-- | A strict graph disallows multiple edges.+makeStrict   :: DotGraph -> DotGraph+makeStrict g = g { strictGraph = True }++setID     :: GraphID -> DotGraph -> DotGraph+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 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+                      )++invalidGraphAttributes :: DotGraph -> [Attribute]+invalidGraphAttributes = filter (not . usedByGraphs) . graphAttributes+ instance Show DotGraph where-    show (DotGraph { graphAttributes, graphNodes, graphEdges, directedGraph })-        = unlines $ gType : " {" : (rest ++ ["}"])+    show g+        = unlines $ (hdr ++ " {") : (rest ++ ["}"])         where-          gType = if directedGraph then dirGraph else undirGraph-          rest = case graphAttributes of+          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) ++ (map show graphEdges)+                   a -> ("\tgraph " ++ show a ++ ";") : nodesEdges+          nodesEdges = map show (graphNodes g) ++ map show (graphEdges g)  dirGraph :: String dirGraph = "digraph"@@ -52,10 +88,69 @@ 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++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+                               }++            `adjustErr`+            (++ "\nNot a valid DotGraph")+ -- ----------------------------------------------------------------------------- +data GraphID = Str String+             | Num Double+             | QStr QuotedString+             | HTML URL+               deriving (Eq, 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 Parseable GraphID where+    parse = oneOf [ liftM Str stringBlock+                  , liftM Num parse+                  , liftM QStr parse+                  , liftM HTML parse+                  ]+            `adjustErr`+            (++ "\nNot 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]@@ -64,24 +159,46 @@                  , clusterAttributes :: [Attribute]                  , clusterElems      :: [DotNode]                  }+      deriving (Eq, Read) +invalidNodeAttributes                :: DotNode -> [(DotNode, Attribute)]+invalidNodeAttributes n@DotNode{}    = map ((,) n)+                                       . filter (not . usedByNodes)+                                       $ nodeAttributes n+invalidNodeAttributes c@DotCluster{} = cErr ++ nErr+    where+      cErr = map ((,) c) . filter (not . usedByClusters)+             $ clusterAttributes c+      nErr = concatMap invalidNodeAttributes $ clusterElems c+ instance Show DotNode where-    show n = init . unlines . addTabs $ nodesToString n+    show = init . unlines . addTabs . nodesToString  nodesToString :: DotNode -> [String]-nodesToString (DotNode { nodeID, nodeAttributes })-    | null nodeAttributes = [nID ++ ";"]-    | otherwise           = [nID ++ (' ':((show nodeAttributes) ++ ";"))]+nodesToString n@(DotNode {})+    | null nAs  = [nID ++ ";"]+    | otherwise = [nID ++ (' ':(show nAs ++ ";"))]     where-      nID = show nodeID-nodesToString (DotCluster { clusterID, clusterAttributes, clusterElems })-    = ["subgraph cluster_" ++ clusterID ++ " {"] ++ (addTabs inner) ++ ["}"]+      nID = show $ nodeID n+      nAs = nodeAttributes n+nodesToString c@(DotCluster {})+    = ["subgraph cluster_" ++ clusterID c ++ " {"] ++ addTabs inner ++ ["}"]     where-      inner = case clusterAttributes of+      inner = case clusterAttributes c of                 [] -> nodes-                a  -> ("graph " ++ (show a) ++ ";") : nodes-      nodes = concatMap nodesToString clusterElems+                a  -> ("graph " ++ show a ++ ";") : nodes+      nodes = concatMap nodesToString $ clusterElems c ++instance Parseable DotNode where+    parse = do nId <- parse+               as <- optional (whitespace >> parse)+               char ';'+               return DotNode { nodeID = nId+                              , nodeAttributes = fromMaybe [] as }+            `adjustErr`+            (++ "\nNot a valid DotNode")+ -- | Prefix each 'String' with a tab character. addTabs :: [String] -> [String] addTabs = map ('\t':)@@ -94,15 +211,22 @@                        , edgeAttributes :: [Attribute]                        , directedEdge   :: Bool                        }+             deriving (Eq, Read) +invalidEdgeAttributes   :: DotEdge -> [(DotEdge, Attribute)]+invalidEdgeAttributes e = map ((,) e)+                          . filter (not . usedByEdges)+                          $ edgeAttributes e+ instance Show DotEdge where-    show (DotEdge { edgeHeadNodeID, edgeTailNodeID, edgeAttributes, directedEdge })-        = '\t' : ((show edgeTailNodeID) ++ edge ++ (show edgeHeadNodeID) ++ attributes)+    show e+        = '\t' : (show (edgeHeadNodeID e)+                  ++ edge ++ show (edgeTailNodeID e) ++ attributes)           where-            edge = " " ++ (if directedEdge then dirEdge else undirEdge) ++ " "-            attributes = case edgeAttributes of+            edge = " " ++ (if directedEdge e then dirEdge else undirEdge) ++ " "+            attributes = case edgeAttributes e of                            [] -> ";"-                           a  -> ' ':((show a) ++ ";")+                           a  -> ' ':(show a ++ ";")  dirEdge :: String dirEdge = "->"@@ -110,52 +234,21 @@ undirEdge :: String undirEdge = "--" --- --------------------------------------------------------------------------------- | Parse a 'DotNode'-readDotNode :: Parser Char DotNode-readDotNode = do { optional whitespace-                 ; nodeID <- number-                 ; as <- optional (whitespace >> readAttributesList)-                 ; char ';'-                 ; skipToNewline-                 ; return (DotNode { nodeID, nodeAttributes = fromMaybe [] as })-                 }---- | Parse a 'DotEdge'-readDotEdge :: Parser Char DotEdge-readDotEdge = do { optional whitespace-                 ; edgeTailNodeID <- number-                 ; whitespace-                 ; edge <- strings [dirEdge,undirEdge]-                 ; whitespace-                 ; edgeHeadNodeID <- number-                 ; as <- optional (whitespace >> readAttributesList)-                 ; char ';'-                 ; skipToNewline-                 ; return (DotEdge { edgeHeadNodeID-                                   , edgeTailNodeID-                                   , edgeAttributes = fromMaybe [] as-                                   , directedEdge = edge == dirEdge })-                 }+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") --- | Parse a 'DotGraph'-readDotGraph :: Parser Char DotGraph-readDotGraph = do { d <- strings [dirGraph,undirGraph]-                  ; let directedGraph = d == dirGraph-                  ; whitespace-                  ; char '{'-                  ; skipToNewline-                  ; graphAttributes-                      <- liftM concat $-                         many (optional whitespace >>-                               oneOf [ (string "edge" >> skipToNewline >> return [])-                                     , (string "node" >> skipToNewline >> return [])-                                     , (string "graph" >> whitespace >> readAttributesList >>= \as -> skipToNewline >> return as)-                                     ]-                              )-                  ; graphNodes <- many readDotNode-                  ; graphEdges <- many readDotEdge-                  ; char '}'-                  ; return $ DotGraph { graphAttributes, graphNodes, graphEdges, directedGraph }-                  }+-- -----------------------------------------------------------------------------

@@ -1,10 +1,16 @@ Areas to work on: -* Add support for Data.Graph-style graphs.+* 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. -* Ensure Data.GraphViz.Attributes contains all supported attributes for Dot.+* Improve parsing to fully (or at least follow more closely) support Dot. -* Remove (or at least minimise) usage of extensions.+* 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.

@@ -1,37 +1,47 @@ Name:               graphviz-Version:            2009.5.1+Version:            2999.0.0.0 Stability:          Beta-Copyright:          Matthew Sackman, Ivan Lazar Miljenovic-Category:           Graphics-Maintainer:         Ivan.Miljenovic@gmail.com-Author:             Matthew Sackman, Ivan Lazar Miljenovic+Synopsis:           GraphViz wrapper for Haskell.+Description:        Provides convenient functions to convert FGL+                      graphs into the Dot language used by the+                      GraphViz <http://graphviz.org/> programs with a+                      large degree of customisation for layout, etc.++                    Also allows a limited amount of parsing of Dot,+                      and usage of GraphViz to attach positional data+                      to each node and edge in the graph.+Category:           Graphs, Graphics License:            BSD3 License-File:       LICENSE-Extra-Source-Files: TODO-Cabal-Version:      >= 1.6+Copyright:          Matthew Sackman, Ivan Lazar Miljenovic+Author:             Matthew Sackman, Ivan Lazar Miljenovic+Maintainer:         Ivan.Miljenovic@gmail.com Build-Type:         Simple-Synopsis:           GraphViz wrapper for Haskell.-Description:-  Provides convenient functions to convert FGL graphs into the Dot-  language used by the GraphViz (http://graphviz.org/) programs with a-  large degree of customisation for layout, etc.+Cabal-Version:      >= 1.6+Extra-Source-Files: TODO+                    Changelog -  Also allows a limited amount of parsing of Dot, and usage of-  GraphViz to attach positional data to each node and edge in the-  graph.+Source-Repository head+    Type:         darcs+    Location:     http://code.haskell.org/graphviz  Library {-        Build-Depends:     base == 4.*, containers, process, array,-                           fgl, polyparse >= 1.1+        Build-Depends:     base >= 3 && < 5,+                           extensible-exceptions,+                           containers,+                           process,+                           array,+                           fgl,+                           polyparse >= 1.1          Exposed-Modules:   Data.GraphViz                            Data.GraphViz.Types                            Data.GraphViz.Commands                            Data.GraphViz.Attributes+                           Data.GraphViz.ParserCombinators          Other-Modules:     Data.GraphViz.Types.Clustering-                           Data.GraphViz.ParserCombinators -        Ghc-Options:       -Wall -fno-warn-name-shadowing+        Ghc-Options:       -Wall         Ghc-Prof-Options:  -prof -auto-all }