Attributes.hs.prettyprinter.golden

module Data.GraphViz.Attributes
       (Attribute(..), Attributes, usedByGraphs, usedBySubGraphs,
        usedByClusters, usedByNodes, usedByEdges, EscString, URL(..),
        ArrowType(..), AspectType(..), Rect(..), ClusterMode(..),
        DirType(..), DEConstraints(..), DPoint(..), ModeType(..),
        Model(..), Label(..), Point(..), Overlap(..), LayerRange(..),
        LayerID(..), LayerList(..), OutputMode(..), Pack(..), PackMode(..),
        Pos(..), EdgeType(..), PageDir(..), Spline(..), QuadType(..),
        Root(..), RankType(..), RankDir(..), Shape(..), SmoothType(..),
        StartType(..), STStyle(..), StyleItem(..), StyleName(..),
        PortPos(..), CompassPoint(..), ViewPort(..), FocusType(..),
        VerticalPlacement(..), ScaleType(..), Justification(..),
        Ratios(..), module Data.GraphViz.Attributes.Colors, ArrowShape(..),
        ArrowModifier(..), ArrowFill(..), ArrowSide(..), box, crow,
        diamond, dotArrow, inv, noArrow, normal, tee, vee, oDot, invDot,
        invODot, oBox, oDiamond, eDiamond, openArr, halfOpen, emptyArr,
        invEmpty, noMods, openMod, defLayerSep, notLayerSep)
       where
import Data.GraphViz.Attributes.Colors
import Data.GraphViz.Util
import Data.GraphViz.Parsing
import Data.GraphViz.Printing
import Data.Char (toLower)
import Data.Maybe (isJust)
import Control.Arrow (first)
import Control.Monad (liftM, liftM2)

data Attribute = Damping Double
               | K Double
               | URL URL
               | ArrowHead ArrowType
               | ArrowSize Double
               | ArrowTail ArrowType
               | Aspect AspectType
               | Bb Rect
               | BgColor Color
               | Center Bool
               | Charset String
               | ClusterRank ClusterMode
               | ColorScheme ColorScheme
               | Color [Color]
               | Comment String
               | Compound Bool
               | Concentrate Bool
               | Constraint Bool
               | Decorate Bool
               | DefaultDist Double
               | Dimen Int
               | Dim Int
               | Dir DirType
               | DirEdgeConstraints DEConstraints
               | Distortion Double
               | DPI Double
               | EdgeURL URL
               | EdgeTarget EscString
               | EdgeTooltip EscString
               | Epsilon Double
               | ESep DPoint
               | FillColor Color
               | FixedSize Bool
               | FontColor Color
               | FontName String
               | FontNames String
               | FontPath String
               | FontSize Double
               | Group String
               | HeadURL URL
               | HeadClip Bool
               | HeadLabel Label
               | HeadPort PortPos
               | HeadTarget EscString
               | HeadTooltip EscString
               | Height Double
               | ID Label
               | Image String
               | ImageScale ScaleType
               | LabelURL URL
               | LabelAngle Double
               | LabelDistance Double
               | LabelFloat Bool
               | LabelFontColor Color
               | LabelFontName String
               | LabelFontSize Double
               | LabelJust Justification
               | LabelLoc VerticalPlacement
               | LabelTarget EscString
               | LabelTooltip EscString
               | Label Label
               | Landscape Bool
               | LayerSep String
               | Layers LayerList
               | Layer LayerRange
               | Layout String
               | Len Double
               | LevelsGap Double
               | Levels Int
               | LHead String
               | LPos Point
               | LTail String
               | Margin DPoint
               | MaxIter Int
               | MCLimit Double
               | MinDist Double
               | MinLen Int
               | Model Model
               | Mode ModeType
               | Mosek Bool
               | NodeSep Double
               | NoJustify Bool
               | Normalize Bool
               | Nslimit1 Double
               | Nslimit Double
               | Ordering String
               | Orientation Double
               | OutputOrder OutputMode
               | OverlapScaling Double
               | Overlap Overlap
               | PackMode PackMode
               | Pack Pack
               | Pad DPoint
               | PageDir PageDir
               | Page Point
               | PenColor Color
               | PenWidth Double
               | Peripheries Int
               | Pin Bool
               | Pos Pos
               | QuadTree QuadType
               | Quantum Double
               | RankDir RankDir
               | RankSep Double
               | Rank RankType
               | Ratio Ratios
               | Rects Rect
               | Regular Bool
               | ReMinCross Bool
               | RepulsiveForce Double
               | Root Root
               | Rotate Int
               | SameHead String
               | SameTail String
               | SamplePoints Int
               | SearchSize Int
               | Sep DPoint
               | ShapeFile String
               | Shape Shape
               | ShowBoxes Int
               | Sides Int
               | Size Point
               | Skew Double
               | Smoothing SmoothType
               | SortV Int
               | Splines EdgeType
               | Start StartType
               | StyleSheet String
               | Style [StyleItem]
               | TailURL URL
               | TailClip Bool
               | TailLabel Label
               | TailPort PortPos
               | TailTarget EscString
               | TailTooltip EscString
               | Target EscString
               | Tooltip EscString
               | TrueColor Bool
               | Vertices [Point]
               | ViewPort ViewPort
               | VoroMargin Double
               | Weight Double
               | Width Double
               | Z Double
                   deriving (Eq, Ord, Show, Read)

type Attributes = [Attribute]

instance PrintDot Attribute where
        unqtDot (Damping v) = printField "Damping" v
        unqtDot (K v) = printField "K" v
        unqtDot (URL v) = printField "URL" v
        unqtDot (ArrowHead v) = printField "arrowhead" v
        unqtDot (ArrowSize v) = printField "arrowsize" v
        unqtDot (ArrowTail v) = printField "arrowtail" v
        unqtDot (Aspect v) = printField "aspect" v
        unqtDot (Bb v) = printField "bb" v
        unqtDot (BgColor v) = printField "bgcolor" v
        unqtDot (Center v) = printField "center" v
        unqtDot (Charset v) = printField "charset" v
        unqtDot (ClusterRank v) = printField "clusterrank" v
        unqtDot (ColorScheme v) = printField "colorscheme" v
        unqtDot (Color v) = printField "color" v
        unqtDot (Comment v) = printField "comment" v
        unqtDot (Compound v) = printField "compound" v
        unqtDot (Concentrate v) = printField "concentrate" v
        unqtDot (Constraint v) = printField "constraint" v
        unqtDot (Decorate v) = printField "decorate" v
        unqtDot (DefaultDist v) = printField "defaultdist" v
        unqtDot (Dimen v) = printField "dimen" v
        unqtDot (Dim v) = printField "dim" v
        unqtDot (Dir v) = printField "dir" v
        unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v
        unqtDot (Distortion v) = printField "distortion" v
        unqtDot (DPI v) = printField "dpi" v
        unqtDot (EdgeURL v) = printField "edgeURL" v
        unqtDot (EdgeTarget v) = printField "edgetarget" v
        unqtDot (EdgeTooltip v) = printField "edgetooltip" v
        unqtDot (Epsilon v) = printField "epsilon" v
        unqtDot (ESep v) = printField "esep" v
        unqtDot (FillColor v) = printField "fillcolor" v
        unqtDot (FixedSize v) = printField "fixedsize" v
        unqtDot (FontColor v) = printField "fontcolor" v
        unqtDot (FontName v) = printField "fontname" v
        unqtDot (FontNames v) = printField "fontnames" v
        unqtDot (FontPath v) = printField "fontpath" v
        unqtDot (FontSize v) = printField "fontsize" v
        unqtDot (Group v) = printField "group" v
        unqtDot (HeadURL v) = printField "headURL" v
        unqtDot (HeadClip v) = printField "headclip" v
        unqtDot (HeadLabel v) = printField "headlabel" v
        unqtDot (HeadPort v) = printField "headport" v
        unqtDot (HeadTarget v) = printField "headtarget" v
        unqtDot (HeadTooltip v) = printField "headtooltip" v
        unqtDot (Height v) = printField "height" v
        unqtDot (ID v) = printField "id" v
        unqtDot (Image v) = printField "image" v
        unqtDot (ImageScale v) = printField "imagescale" v
        unqtDot (LabelURL v) = printField "labelURL" v
        unqtDot (LabelAngle v) = printField "labelangle" v
        unqtDot (LabelDistance v) = printField "labeldistance" v
        unqtDot (LabelFloat v) = printField "labelfloat" v
        unqtDot (LabelFontColor v) = printField "labelfontcolor" v
        unqtDot (LabelFontName v) = printField "labelfontname" v
        unqtDot (LabelFontSize v) = printField "labelfontsize" v
        unqtDot (LabelJust v) = printField "labeljust" v
        unqtDot (LabelLoc v) = printField "labelloc" v
        unqtDot (LabelTarget v) = printField "labeltarget" v
        unqtDot (LabelTooltip v) = printField "labeltooltip" v
        unqtDot (Label v) = printField "label" v
        unqtDot (Landscape v) = printField "landscape" v
        unqtDot (LayerSep v) = printField "layersep" v
        unqtDot (Layers v) = printField "layers" v
        unqtDot (Layer v) = printField "layer" v
        unqtDot (Layout v) = printField "layout" v
        unqtDot (Len v) = printField "len" v
        unqtDot (LevelsGap v) = printField "levelsgap" v
        unqtDot (Levels v) = printField "levels" v
        unqtDot (LHead v) = printField "lhead" v
        unqtDot (LPos v) = printField "lp" v
        unqtDot (LTail v) = printField "ltail" v
        unqtDot (Margin v) = printField "margin" v
        unqtDot (MaxIter v) = printField "maxiter" v
        unqtDot (MCLimit v) = printField "mclimit" v
        unqtDot (MinDist v) = printField "mindist" v
        unqtDot (MinLen v) = printField "minlen" v
        unqtDot (Model v) = printField "model" v
        unqtDot (Mode v) = printField "mode" v
        unqtDot (Mosek v) = printField "mosek" v
        unqtDot (NodeSep v) = printField "nodesep" v
        unqtDot (NoJustify v) = printField "nojustify" v
        unqtDot (Normalize v) = printField "normalize" v
        unqtDot (Nslimit1 v) = printField "nslimit1" v
        unqtDot (Nslimit v) = printField "nslimit" v
        unqtDot (Ordering v) = printField "ordering" v
        unqtDot (Orientation v) = printField "orientation" v
        unqtDot (OutputOrder v) = printField "outputorder" v
        unqtDot (OverlapScaling v) = printField "overlap_scaling" v
        unqtDot (Overlap v) = printField "overlap" v
        unqtDot (PackMode v) = printField "packmode" v
        unqtDot (Pack v) = printField "pack" v
        unqtDot (Pad v) = printField "pad" v
        unqtDot (PageDir v) = printField "pagedir" v
        unqtDot (Page v) = printField "page" v
        unqtDot (PenColor v) = printField "pencolor" v
        unqtDot (PenWidth v) = printField "penwidth" v
        unqtDot (Peripheries v) = printField "peripheries" v
        unqtDot (Pin v) = printField "pin" v
        unqtDot (Pos v) = printField "pos" v
        unqtDot (QuadTree v) = printField "quadtree" v
        unqtDot (Quantum v) = printField "quantum" v
        unqtDot (RankDir v) = printField "rankdir" v
        unqtDot (RankSep v) = printField "ranksep" v
        unqtDot (Rank v) = printField "rank" v
        unqtDot (Ratio v) = printField "ratio" v
        unqtDot (Rects v) = printField "rects" v
        unqtDot (Regular v) = printField "regular" v
        unqtDot (ReMinCross v) = printField "remincross" v
        unqtDot (RepulsiveForce v) = printField "repulsiveforce" v
        unqtDot (Root v) = printField "root" v
        unqtDot (Rotate v) = printField "rotate" v
        unqtDot (SameHead v) = printField "samehead" v
        unqtDot (SameTail v) = printField "sametail" v
        unqtDot (SamplePoints v) = printField "samplepoints" v
        unqtDot (SearchSize v) = printField "searchsize" v
        unqtDot (Sep v) = printField "sep" v
        unqtDot (ShapeFile v) = printField "shapefile" v
        unqtDot (Shape v) = printField "shape" v
        unqtDot (ShowBoxes v) = printField "showboxes" v
        unqtDot (Sides v) = printField "sides" v
        unqtDot (Size v) = printField "size" v
        unqtDot (Skew v) = printField "skew" v
        unqtDot (Smoothing v) = printField "smoothing" v
        unqtDot (SortV v) = printField "sortv" v
        unqtDot (Splines v) = printField "splines" v
        unqtDot (Start v) = printField "start" v
        unqtDot (StyleSheet v) = printField "stylesheet" v
        unqtDot (Style v) = printField "style" v
        unqtDot (TailURL v) = printField "tailURL" v
        unqtDot (TailClip v) = printField "tailclip" v
        unqtDot (TailLabel v) = printField "taillabel" v
        unqtDot (TailPort v) = printField "tailport" v
        unqtDot (TailTarget v) = printField "tailtarget" v
        unqtDot (TailTooltip v) = printField "tailtooltip" v
        unqtDot (Target v) = printField "target" v
        unqtDot (Tooltip v) = printField "tooltip" v
        unqtDot (TrueColor v) = printField "truecolor" v
        unqtDot (Vertices v) = printField "vertices" v
        unqtDot (ViewPort v) = printField "viewport" v
        unqtDot (VoroMargin v) = printField "voro_margin" v
        unqtDot (Weight v) = printField "weight" v
        unqtDot (Width v) = printField "width" v
        unqtDot (Z v) = printField "z" v
        listToDot = unqtListToDot

instance ParseDot Attribute where
        parseUnqt
          = oneOf
              [liftM Damping $ parseField "Damping", liftM K $ parseField "K",
               liftM URL $ parseFields ["URL", "href"],
               liftM ArrowHead $ parseField "arrowhead",
               liftM ArrowSize $ parseField "arrowsize",
               liftM ArrowTail $ parseField "arrowtail",
               liftM Aspect $ parseField "aspect", liftM Bb $ parseField "bb",
               liftM BgColor $ parseField "bgcolor",
               liftM Center $ parseFieldBool "center",
               liftM Charset $ parseField "charset",
               liftM ClusterRank $ parseField "clusterrank",
               liftM ColorScheme $ parseField "colorscheme",
               liftM Color $ parseField "color",
               liftM Comment $ parseField "comment",
               liftM Compound $ parseFieldBool "compound",
               liftM Concentrate $ parseFieldBool "concentrate",
               liftM Constraint $ parseFieldBool "constraint",
               liftM Decorate $ parseFieldBool "decorate",
               liftM DefaultDist $ parseField "defaultdist",
               liftM Dimen $ parseField "dimen", liftM Dim $ parseField "dim",
               liftM Dir $ parseField "dir",
               liftM DirEdgeConstraints $
                 parseFieldDef EdgeConstraints "diredgeconstraints",
               liftM Distortion $ parseField "distortion",
               liftM DPI $ parseFields ["dpi", "resolution"],
               liftM EdgeURL $ parseFields ["edgeURL", "edgehref"],
               liftM EdgeTarget $ parseField "edgetarget",
               liftM EdgeTooltip $ parseField "edgetooltip",
               liftM Epsilon $ parseField "epsilon",
               liftM ESep $ parseField "esep",
               liftM FillColor $ parseField "fillcolor",
               liftM FixedSize $ parseFieldBool "fixedsize",
               liftM FontColor $ parseField "fontcolor",
               liftM FontName $ parseField "fontname",
               liftM FontNames $ parseField "fontnames",
               liftM FontPath $ parseField "fontpath",
               liftM FontSize $ parseField "fontsize",
               liftM Group $ parseField "group",
               liftM HeadURL $ parseFields ["headURL", "headhref"],
               liftM HeadClip $ parseFieldBool "headclip",
               liftM HeadLabel $ parseField "headlabel",
               liftM HeadPort $ parseField "headport",
               liftM HeadTarget $ parseField "headtarget",
               liftM HeadTooltip $ parseField "headtooltip",
               liftM Height $ parseField "height", liftM ID $ parseField "id",
               liftM Image $ parseField "image",
               liftM ImageScale $ parseFieldDef UniformScale "imagescale",
               liftM LabelURL $ parseFields ["labelURL", "labelhref"],
               liftM LabelAngle $ parseField "labelangle",
               liftM LabelDistance $ parseField "labeldistance",
               liftM LabelFloat $ parseFieldBool "labelfloat",
               liftM LabelFontColor $ parseField "labelfontcolor",
               liftM LabelFontName $ parseField "labelfontname",
               liftM LabelFontSize $ parseField "labelfontsize",
               liftM LabelJust $ parseField "labeljust",
               liftM LabelLoc $ parseField "labelloc",
               liftM LabelTarget $ parseField "labeltarget",
               liftM LabelTooltip $ parseField "labeltooltip",
               liftM Label $ parseField "label",
               liftM Landscape $ parseFieldBool "landscape",
               liftM LayerSep $ parseField "layersep",
               liftM Layers $ parseField "layers",
               liftM Layer $ parseField "layer",
               liftM Layout $ parseField "layout", liftM Len $ parseField "len",
               liftM LevelsGap $ parseField "levelsgap",
               liftM Levels $ parseField "levels",
               liftM LHead $ parseField "lhead", liftM LPos $ parseField "lp",
               liftM LTail $ parseField "ltail",
               liftM Margin $ parseField "margin",
               liftM MaxIter $ parseField "maxiter",
               liftM MCLimit $ parseField "mclimit",
               liftM MinDist $ parseField "mindist",
               liftM MinLen $ parseField "minlen",
               liftM Model $ parseField "model", liftM Mode $ parseField "mode",
               liftM Mosek $ parseFieldBool "mosek",
               liftM NodeSep $ parseField "nodesep",
               liftM NoJustify $ parseFieldBool "nojustify",
               liftM Normalize $ parseFieldBool "normalize",
               liftM Nslimit1 $ parseField "nslimit1",
               liftM Nslimit $ parseField "nslimit",
               liftM Ordering $ parseField "ordering",
               liftM Orientation $ parseField "orientation",
               liftM OutputOrder $ parseField "outputorder",
               liftM OverlapScaling $ parseField "overlap_scaling",
               liftM Overlap $ parseFieldDef KeepOverlaps "overlap",
               liftM PackMode $ parseField "packmode",
               liftM Pack $ parseFieldDef DoPack "pack",
               liftM Pad $ parseField "pad", liftM PageDir $ parseField "pagedir",
               liftM Page $ parseField "page",
               liftM PenColor $ parseField "pencolor",
               liftM PenWidth $ parseField "penwidth",
               liftM Peripheries $ parseField "peripheries",
               liftM Pin $ parseFieldBool "pin", liftM Pos $ parseField "pos",
               liftM QuadTree $ parseFieldDef NormalQT "quadtree",
               liftM Quantum $ parseField "quantum",
               liftM RankDir $ parseField "rankdir",
               liftM RankSep $ parseField "ranksep",
               liftM Rank $ parseField "rank", liftM Ratio $ parseField "ratio",
               liftM Rects $ parseField "rects",
               liftM Regular $ parseFieldBool "regular",
               liftM ReMinCross $ parseFieldBool "remincross",
               liftM RepulsiveForce $ parseField "repulsiveforce",
               liftM Root $ parseFieldDef IsCentral "root",
               liftM Rotate $ parseField "rotate",
               liftM SameHead $ parseField "samehead",
               liftM SameTail $ parseField "sametail",
               liftM SamplePoints $ parseField "samplepoints",
               liftM SearchSize $ parseField "searchsize",
               liftM Sep $ parseField "sep",
               liftM ShapeFile $ parseField "shapefile",
               liftM Shape $ parseField "shape",
               liftM ShowBoxes $ parseField "showboxes",
               liftM Sides $ parseField "sides", liftM Size $ parseField "size",
               liftM Skew $ parseField "skew",
               liftM Smoothing $ parseField "smoothing",
               liftM SortV $ parseField "sortv",
               liftM Splines $ parseFieldDef SplineEdges "splines",
               liftM Start $ parseField "start",
               liftM StyleSheet $ parseField "stylesheet",
               liftM Style $ parseField "style",
               liftM TailURL $ parseFields ["tailURL", "tailhref"],
               liftM TailClip $ parseFieldBool "tailclip",
               liftM TailLabel $ parseField "taillabel",
               liftM TailPort $ parseField "tailport",
               liftM TailTarget $ parseField "tailtarget",
               liftM TailTooltip $ parseField "tailtooltip",
               liftM Target $ parseField "target",
               liftM Tooltip $ parseField "tooltip",
               liftM TrueColor $ parseFieldBool "truecolor",
               liftM Vertices $ parseField "vertices",
               liftM ViewPort $ parseField "viewport",
               liftM VoroMargin $ parseField "voro_margin",
               liftM Weight $ parseField "weight",
               liftM Width $ parseField "width", liftM Z $ parseField "z"]
        parse = parseUnqt
        parseList = parseUnqtList

usedByGraphs :: Attribute -> Bool
usedByGraphs Damping{} = True
usedByGraphs K{} = True
usedByGraphs URL{} = True
usedByGraphs Aspect{} = True
usedByGraphs Bb{} = True
usedByGraphs BgColor{} = True
usedByGraphs Center{} = True
usedByGraphs Charset{} = True
usedByGraphs ClusterRank{} = True
usedByGraphs ColorScheme{} = True
usedByGraphs Comment{} = True
usedByGraphs Compound{} = True
usedByGraphs Concentrate{} = True
usedByGraphs DefaultDist{} = True
usedByGraphs Dimen{} = True
usedByGraphs Dim{} = True
usedByGraphs DirEdgeConstraints{} = True
usedByGraphs DPI{} = True
usedByGraphs Epsilon{} = True
usedByGraphs ESep{} = True
usedByGraphs FontColor{} = True
usedByGraphs FontName{} = True
usedByGraphs FontNames{} = True
usedByGraphs FontPath{} = True
usedByGraphs FontSize{} = True
usedByGraphs ID{} = True
usedByGraphs LabelJust{} = True
usedByGraphs LabelLoc{} = True
usedByGraphs Label{} = True
usedByGraphs Landscape{} = True
usedByGraphs LayerSep{} = True
usedByGraphs Layers{} = True
usedByGraphs Layout{} = True
usedByGraphs LevelsGap{} = True
usedByGraphs Levels{} = True
usedByGraphs LPos{} = True
usedByGraphs Margin{} = True
usedByGraphs MaxIter{} = True
usedByGraphs MCLimit{} = True
usedByGraphs MinDist{} = True
usedByGraphs Model{} = True
usedByGraphs Mode{} = True
usedByGraphs Mosek{} = True
usedByGraphs NodeSep{} = True
usedByGraphs NoJustify{} = True
usedByGraphs Normalize{} = True
usedByGraphs Nslimit1{} = True
usedByGraphs Nslimit{} = True
usedByGraphs Ordering{} = True
usedByGraphs OutputOrder{} = True
usedByGraphs OverlapScaling{} = True
usedByGraphs Overlap{} = True
usedByGraphs PackMode{} = True
usedByGraphs Pack{} = True
usedByGraphs Pad{} = True
usedByGraphs PageDir{} = True
usedByGraphs Page{} = True
usedByGraphs QuadTree{} = True
usedByGraphs Quantum{} = True
usedByGraphs RankDir{} = True
usedByGraphs RankSep{} = True
usedByGraphs Ratio{} = True
usedByGraphs ReMinCross{} = True
usedByGraphs RepulsiveForce{} = True
usedByGraphs Root{} = True
usedByGraphs Rotate{} = True
usedByGraphs SearchSize{} = True
usedByGraphs Sep{} = True
usedByGraphs ShowBoxes{} = True
usedByGraphs Size{} = True
usedByGraphs Smoothing{} = True
usedByGraphs SortV{} = True
usedByGraphs Splines{} = True
usedByGraphs Start{} = True
usedByGraphs StyleSheet{} = True
usedByGraphs Target{} = True
usedByGraphs TrueColor{} = True
usedByGraphs ViewPort{} = True
usedByGraphs VoroMargin{} = True
usedByGraphs _ = False

usedByClusters :: Attribute -> Bool
usedByClusters K{} = True
usedByClusters URL{} = True
usedByClusters BgColor{} = True
usedByClusters ColorScheme{} = True
usedByClusters Color{} = True
usedByClusters FillColor{} = True
usedByClusters FontColor{} = True
usedByClusters FontName{} = True
usedByClusters FontSize{} = True
usedByClusters LabelJust{} = True
usedByClusters LabelLoc{} = True
usedByClusters Label{} = True
usedByClusters LPos{} = True
usedByClusters NoJustify{} = True
usedByClusters PenColor{} = True
usedByClusters PenWidth{} = True
usedByClusters Peripheries{} = True
usedByClusters Rank{} = True
usedByClusters SortV{} = True
usedByClusters Style{} = True
usedByClusters Target{} = True
usedByClusters Tooltip{} = True
usedByClusters _ = False

usedBySubGraphs :: Attribute -> Bool
usedBySubGraphs Rank{} = True
usedBySubGraphs _ = False

usedByNodes :: Attribute -> Bool
usedByNodes URL{} = True
usedByNodes ColorScheme{} = True
usedByNodes Color{} = True
usedByNodes Comment{} = True
usedByNodes Distortion{} = True
usedByNodes FillColor{} = True
usedByNodes FixedSize{} = True
usedByNodes FontColor{} = True
usedByNodes FontName{} = True
usedByNodes FontSize{} = True
usedByNodes Group{} = True
usedByNodes Height{} = True
usedByNodes ID{} = True
usedByNodes Image{} = True
usedByNodes ImageScale{} = True
usedByNodes LabelLoc{} = True
usedByNodes Label{} = True
usedByNodes Layer{} = True
usedByNodes Margin{} = True
usedByNodes NoJustify{} = True
usedByNodes Orientation{} = True
usedByNodes PenWidth{} = True
usedByNodes Peripheries{} = True
usedByNodes Pin{} = True
usedByNodes Pos{} = True
usedByNodes Rects{} = True
usedByNodes Regular{} = True
usedByNodes Root{} = True
usedByNodes SamplePoints{} = True
usedByNodes ShapeFile{} = True
usedByNodes Shape{} = True
usedByNodes ShowBoxes{} = True
usedByNodes Sides{} = True
usedByNodes Skew{} = True
usedByNodes SortV{} = True
usedByNodes Style{} = True
usedByNodes Target{} = True
usedByNodes Tooltip{} = True
usedByNodes Vertices{} = True
usedByNodes Width{} = True
usedByNodes Z{} = True
usedByNodes _ = False

usedByEdges :: Attribute -> Bool
usedByEdges URL{} = True
usedByEdges ArrowHead{} = True
usedByEdges ArrowSize{} = True
usedByEdges ArrowTail{} = True
usedByEdges ColorScheme{} = True
usedByEdges Color{} = True
usedByEdges Comment{} = True
usedByEdges Constraint{} = True
usedByEdges Decorate{} = True
usedByEdges Dir{} = True
usedByEdges EdgeURL{} = True
usedByEdges EdgeTarget{} = True
usedByEdges EdgeTooltip{} = True
usedByEdges FontColor{} = True
usedByEdges FontName{} = True
usedByEdges FontSize{} = True
usedByEdges HeadURL{} = True
usedByEdges HeadClip{} = True
usedByEdges HeadLabel{} = True
usedByEdges HeadPort{} = True
usedByEdges HeadTarget{} = True
usedByEdges HeadTooltip{} = True
usedByEdges ID{} = True
usedByEdges LabelURL{} = True
usedByEdges LabelAngle{} = True
usedByEdges LabelDistance{} = True
usedByEdges LabelFloat{} = True
usedByEdges LabelFontColor{} = True
usedByEdges LabelFontName{} = True
usedByEdges LabelFontSize{} = True
usedByEdges LabelTarget{} = True
usedByEdges LabelTooltip{} = True
usedByEdges Label{} = True
usedByEdges Layer{} = True
usedByEdges Len{} = True
usedByEdges LHead{} = True
usedByEdges LPos{} = True
usedByEdges LTail{} = True
usedByEdges MinLen{} = True
usedByEdges NoJustify{} = True
usedByEdges PenWidth{} = True
usedByEdges Pos{} = True
usedByEdges SameHead{} = True
usedByEdges SameTail{} = True
usedByEdges ShowBoxes{} = True
usedByEdges Style{} = True
usedByEdges TailURL{} = True
usedByEdges TailClip{} = True
usedByEdges TailLabel{} = True
usedByEdges TailPort{} = True
usedByEdges TailTarget{} = True
usedByEdges TailTooltip{} = True
usedByEdges Target{} = True
usedByEdges Tooltip{} = True
usedByEdges Weight{} = True
usedByEdges _ = False

type EscString = String

newtype URL = UStr{urlString :: EscString}
                deriving (Eq, Ord, Show, Read)

instance PrintDot URL where
        unqtDot = wrap (char '<') (char '>') . text . urlString

instance ParseDot URL where
        parseUnqt
          = liftM UStr $
              bracket (character open) (character close)
                (many1 $ satisfy ((/=) close))
          where open = '<'
                close = '>'
        parse = parseUnqt

newtype ArrowType = AType [(ArrowModifier, ArrowShape)]
                      deriving (Eq, Ord, Show, Read)

box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee ::
     ArrowType

oDot, invDot, invODot, oBox, oDiamond :: ArrowType

eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType
normal = AType [(noMods, Normal)]
inv = AType [(noMods, Inv)]
dotArrow = AType [(noMods, DotArrow)]
invDot = AType [(noMods, Inv), (noMods, DotArrow)]
oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)]
invODot = AType [(noMods, Inv), (openMod, DotArrow)]
noArrow = AType [(noMods, NoArrow)]
tee = AType [(noMods, Tee)]
emptyArr = AType [(openMod, Normal)]
invEmpty = AType [(noMods, Inv), (openMod, Normal)]
diamond = AType [(noMods, Diamond)]
oDiamond = AType [(openMod, Diamond)]
eDiamond = oDiamond
crow = AType [(noMods, Crow)]
box = AType [(noMods, Box)]
oBox = AType [(openMod, Box)]
openArr = vee
halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)]
vee = AType [(noMods, Vee)]

instance PrintDot ArrowType where
        unqtDot (AType mas) = hcat $ map appMod mas
          where appMod (m, a) = unqtDot m <> unqtDot a

instance ParseDot ArrowType where
        parseUnqt
          = do mas <- many1 $
                        do m <- parseUnqt
                           a <- parseUnqt
                           return (m, a)
               return $ AType mas
              `onFail` specialArrowParse

specialArrowParse :: Parse ArrowType
specialArrowParse
  = oneOf
      [stringRep eDiamond "ediamond", stringRep openArr "open",
       stringRep halfOpen "halfopen", stringRep emptyArr "empty",
       stringRep invEmpty "invempty"]

data ArrowShape = Box
                | Crow
                | Diamond
                | DotArrow
                | Inv
                | NoArrow
                | Normal
                | Tee
                | Vee
                    deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot ArrowShape where
        unqtDot Box = unqtDot "box"
        unqtDot Crow = unqtDot "crow"
        unqtDot Diamond = unqtDot "diamond"
        unqtDot DotArrow = unqtDot "dot"
        unqtDot Inv = unqtDot "inv"
        unqtDot NoArrow = unqtDot "none"
        unqtDot Normal = unqtDot "normal"
        unqtDot Tee = unqtDot "tee"
        unqtDot Vee = unqtDot "vee"

instance ParseDot ArrowShape where
        parseUnqt
          = oneOf
              [stringRep Box "box", stringRep Crow "crow",
               stringRep Diamond "diamond", stringRep DotArrow "dot",
               stringRep Inv "inv", stringRep NoArrow "none",
               stringRep Normal "normal", stringRep Tee "tee",
               stringRep Vee "vee"]

data ArrowModifier = ArrMod{arrowFill :: ArrowFill,
                            arrowSide :: ArrowSide}
                       deriving (Eq, Ord, Show, Read)

noMods :: ArrowModifier
noMods = ArrMod FilledArrow BothSides

openMod :: ArrowModifier
openMod = ArrMod OpenArrow BothSides

instance PrintDot ArrowModifier where
        unqtDot (ArrMod f s) = unqtDot f <> unqtDot s

instance ParseDot ArrowModifier where
        parseUnqt
          = do f <- parseUnqt
               s <- parseUnqt
               return $ ArrMod f s

data ArrowFill = OpenArrow
               | FilledArrow
                   deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot ArrowFill where
        unqtDot OpenArrow = char 'o'
        unqtDot FilledArrow = empty

instance ParseDot ArrowFill where
        parseUnqt
          = liftM (bool FilledArrow OpenArrow . isJust) $
              optional (character 'o')
        parse = parseUnqt

data ArrowSide = LeftSide
               | RightSide
               | BothSides
                   deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot ArrowSide where
        unqtDot LeftSide = char 'l'
        unqtDot RightSide = char 'r'
        unqtDot BothSides = empty

instance ParseDot ArrowSide where
        parseUnqt
          = liftM getSideType $ optional (oneOf $ map character ['l', 'r'])
          where getSideType
                  = maybe BothSides (bool RightSide LeftSide . (==) 'l')
        parse = parseUnqt

data AspectType = RatioOnly Double
                | RatioPassCount Double Int
                    deriving (Eq, Ord, Show, Read)

instance PrintDot AspectType where
        unqtDot (RatioOnly r) = unqtDot r
        unqtDot (RatioPassCount r p) = commaDel r p
        toDot at@RatioOnly{} = unqtDot at
        toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at

instance ParseDot AspectType where
        parseUnqt
          = liftM (uncurry RatioPassCount) commaSepUnqt `onFail`
              liftM RatioOnly parseUnqt
        parse
          = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt)
              `onFail` liftM RatioOnly parse

data Rect = Rect Point Point
              deriving (Eq, Ord, Show, Read)

instance PrintDot Rect where
        unqtDot (Rect p1 p2) = commaDel p1 p2
        toDot = doubleQuotes . unqtDot

instance ParseDot Rect where
        parseUnqt = liftM (uncurry Rect) commaSepUnqt
        parse = quotedParse parseUnqt

data ClusterMode = Local
                 | Global
                 | NoCluster
                     deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot ClusterMode where
        unqtDot Local = unqtDot "local"
        unqtDot Global = unqtDot "global"
        unqtDot NoCluster = unqtDot "none"

instance ParseDot ClusterMode where
        parseUnqt
          = oneOf
              [stringRep Local "local", stringRep Global "global",
               stringRep NoCluster "none"]

data DirType = Forward
             | Back
             | Both
             | NoDir
                 deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot DirType where
        unqtDot Forward = unqtDot "forward"
        unqtDot Back = unqtDot "back"
        unqtDot Both = unqtDot "both"
        unqtDot NoDir = unqtDot "none"

instance ParseDot DirType where
        parseUnqt
          = oneOf
              [stringRep Forward "forward", stringRep Back "back",
               stringRep Both "both", stringRep NoDir "none"]

data DEConstraints = EdgeConstraints
                   | NoConstraints
                   | HierConstraints
                       deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot DEConstraints where
        unqtDot EdgeConstraints = unqtDot True
        unqtDot NoConstraints = unqtDot False
        unqtDot HierConstraints = text "hier"

instance ParseDot DEConstraints where
        parseUnqt
          = liftM (bool NoConstraints EdgeConstraints) parse `onFail`
              stringRep HierConstraints "hier"

data DPoint = DVal Double
            | PVal Point
                deriving (Eq, Ord, Show, Read)

instance PrintDot DPoint where
        unqtDot (DVal d) = unqtDot d
        unqtDot (PVal p) = unqtDot p
        toDot (DVal d) = toDot d
        toDot (PVal p) = toDot p

instance ParseDot DPoint where
        parseUnqt = liftM PVal parseUnqt `onFail` liftM DVal parseUnqt
        parse = liftM PVal parse `onFail` liftM DVal parse

data ModeType = Major
              | KK
              | Hier
              | IpSep
                  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot ModeType where
        unqtDot Major = text "major"
        unqtDot KK = text "KK"
        unqtDot Hier = text "hier"
        unqtDot IpSep = text "ipsep"

instance ParseDot ModeType where
        parseUnqt
          = oneOf
              [stringRep Major "major", stringRep KK "KK", stringRep Hier "hier",
               stringRep IpSep "ipsep"]

data Model = ShortPath
           | SubSet
           | Circuit
               deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot Model where
        unqtDot ShortPath = text "shortpath"
        unqtDot SubSet = text "subset"
        unqtDot Circuit = text "circuit"

instance ParseDot Model where
        parseUnqt
          = oneOf
              [stringRep ShortPath "shortpath", stringRep SubSet "subset",
               stringRep Circuit "circuit"]

data Label = StrLabel EscString
           | URLLabel URL
               deriving (Eq, Ord, Show, Read)

instance PrintDot Label where
        unqtDot (StrLabel s) = unqtDot s
        unqtDot (URLLabel u) = unqtDot u
        toDot (StrLabel s) = toDot s
        toDot (URLLabel u) = toDot u

instance ParseDot Label where
        parseUnqt
          = liftM StrLabel parseUnqt `onFail` liftM URLLabel parseUnqt
        parse = liftM StrLabel parse `onFail` liftM URLLabel parse

data Point = Point Int Int
           | PointD Double Double
               deriving (Eq, Ord, Show, Read)

instance PrintDot Point where
        unqtDot (Point x y) = commaDel x y
        unqtDot (PointD x y) = commaDel x y
        toDot = doubleQuotes . unqtDot
        unqtListToDot = hsep . map unqtDot
        listToDot = doubleQuotes . unqtListToDot

instance ParseDot Point where
        parseUnqt
          = intDblPoint `onFail` liftM (uncurry Point) commaSepUnqt `onFail`
              liftM (uncurry PointD) commaSepUnqt
          where intDblPoint
                  = liftM (uncurry PointD . first fI) $
                      commaSep' parseUnqt parseStrictFloat
                
                fI :: Int -> Double
                fI = fromIntegral
        parse = quotedParse parseUnqt
        parseUnqtList = sepBy1 parseUnqt whitespace

data Overlap = KeepOverlaps
             | RemoveOverlaps
             | ScaleOverlaps
             | ScaleXYOverlaps
             | PrismOverlap (Maybe Int)
             | CompressOverlap
             | VpscOverlap
             | IpsepOverlap
                 deriving (Eq, Ord, Show, Read)

instance PrintDot Overlap where
        unqtDot KeepOverlaps = unqtDot True
        unqtDot RemoveOverlaps = unqtDot False
        unqtDot ScaleOverlaps = text "scale"
        unqtDot ScaleXYOverlaps = text "scalexy"
        unqtDot (PrismOverlap i)
          = maybe id (flip (<>) . unqtDot) i $ text "prism"
        unqtDot CompressOverlap = text "compress"
        unqtDot VpscOverlap = text "vpsc"
        unqtDot IpsepOverlap = text "ipsep"

instance ParseDot Overlap where
        parseUnqt
          = oneOf
              [stringRep KeepOverlaps "true", stringRep RemoveOverlaps "false",
               stringRep ScaleXYOverlaps "scalexy",
               stringRep ScaleOverlaps "scale",
               string "prism" >> liftM PrismOverlap (optional parse),
               stringRep CompressOverlap "compress", stringRep VpscOverlap "vpsc",
               stringRep IpsepOverlap "ipsep"]

data LayerRange = LRID LayerID
                | LRS LayerID String LayerID
                    deriving (Eq, Ord, Show, Read)

instance PrintDot LayerRange where
        unqtDot (LRID lid) = unqtDot lid
        unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2
        toDot (LRID lid) = toDot lid
        toDot lrs = doubleQuotes $ unqtDot lrs

instance ParseDot LayerRange where
        parseUnqt
          = do id1 <- parseUnqt
               s <- parseLayerSep
               id2 <- parseUnqt
               return $ LRS id1 s id2
              `onFail` liftM LRID parseUnqt
        parse
          = quotedParse
              (do id1 <- parseUnqt
                  s <- parseLayerSep
                  id2 <- parseUnqt
                  return $ LRS id1 s id2)
              `onFail` liftM LRID parse

parseLayerSep :: Parse String
parseLayerSep = many1 . oneOf $ map character defLayerSep

defLayerSep :: [Char]
defLayerSep = [' ', ':', '\t']

parseLayerName :: Parse String
parseLayerName
  = many1 . orQuote $
      satisfy (liftM2 (&&) notLayerSep ((/=) quoteChar))

parseLayerName' :: Parse String
parseLayerName' = stringBlock `onFail` quotedParse parseLayerName

notLayerSep :: Char -> Bool
notLayerSep = flip notElem defLayerSep

data LayerID = AllLayers
             | LRInt Int
             | LRName String
                 deriving (Eq, Ord, Show, Read)

instance PrintDot LayerID where
        unqtDot AllLayers = text "all"
        unqtDot (LRInt n) = unqtDot n
        unqtDot (LRName nm) = unqtDot nm
        toDot (LRName nm) = toDot nm
        toDot li = unqtDot li

instance ParseDot LayerID where
        parseUnqt = liftM checkLayerName parseLayerName
        parse
          = oneOf [liftM checkLayerName parseLayerName', liftM LRInt parse]

checkLayerName :: String -> LayerID
checkLayerName str = maybe checkAll LRInt $ stringToInt str
  where checkAll
          = if map toLower str == "all" then AllLayers else LRName str

data LayerList = LL String [(String, String)]
                   deriving (Eq, Ord, Show, Read)

instance PrintDot LayerList where
        unqtDot (LL l1 ols) = unqtDot l1 <> hcat (map subLL ols)
          where subLL (s, l) = unqtDot s <> unqtDot l
        toDot (LL l1 []) = toDot l1
        toDot ll = doubleQuotes $ unqtDot ll

instance ParseDot LayerList where
        parseUnqt
          = do l1 <- parseLayerName
               ols <- many $
                        do s <- parseLayerSep
                           lnm <- parseLayerName
                           return (s, lnm)
               return $ LL l1 ols
        parse
          = quotedParse parseUnqt `onFail`
              liftM (flip LL []) (parseLayerName' `onFail` numString)

data OutputMode = BreadthFirst
                | NodesFirst
                | EdgesFirst
                    deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot OutputMode where
        unqtDot BreadthFirst = text "breadthfirst"
        unqtDot NodesFirst = text "nodesfirst"
        unqtDot EdgesFirst = text "edgesfirst"

instance ParseDot OutputMode where
        parseUnqt
          = oneOf
              [stringRep BreadthFirst "breadthfirst",
               stringRep NodesFirst "nodesfirst",
               stringRep EdgesFirst "edgesfirst"]

data Pack = DoPack
          | DontPack
          | PackMargin Int
              deriving (Eq, Ord, Show, Read)

instance PrintDot Pack where
        unqtDot DoPack = unqtDot True
        unqtDot DontPack = unqtDot False
        unqtDot (PackMargin m) = unqtDot m

instance ParseDot Pack where
        parseUnqt
          = oneOf
              [liftM PackMargin parseUnqt, liftM (bool DontPack DoPack) onlyBool]

data PackMode = PackNode
              | PackClust
              | PackGraph
              | PackArray Bool Bool (Maybe Int)
                  deriving (Eq, Ord, Show, Read)

instance PrintDot PackMode where
        unqtDot PackNode = text "node"
        unqtDot PackClust = text "clust"
        unqtDot PackGraph = text "graph"
        unqtDot (PackArray c u mi)
          = addNum . isU . isC . isUnder $ text "array"
          where addNum = maybe id (flip (<>) . unqtDot) mi
                isUnder = if c || u then flip (<>) $ char '_' else id
                isC = if c then flip (<>) $ char 'c' else id
                isU = if u then flip (<>) $ char 'u' else id

instance ParseDot PackMode where
        parseUnqt
          = oneOf
              [stringRep PackNode "node", stringRep PackClust "clust",
               stringRep PackGraph "graph",
               do string "array"
                  mcu <- optional $
                           do character '_'
                              many1 $ satisfy isCU
                  let c = hasCharacter mcu 'c'
                      u = hasCharacter mcu 'u'
                  mi <- optional parseUnqt
                  return $ PackArray c u mi]
          where hasCharacter ms c = maybe False (elem c) ms
                isCU = flip elem ['c', 'u']

data Pos = PointPos Point
         | SplinePos [Spline]
             deriving (Eq, Ord, Show, Read)

instance PrintDot Pos where
        unqtDot (PointPos p) = unqtDot p
        unqtDot (SplinePos ss) = unqtDot ss
        toDot (PointPos p) = toDot p
        toDot (SplinePos ss) = toDot ss

instance ParseDot Pos where
        parseUnqt
          = do splns <- parseUnqt
               case splns of
                   [Spline Nothing Nothing [p]] -> return $ PointPos p
                   _ -> return $ SplinePos splns
        parse = quotedParse parseUnqt

data EdgeType = SplineEdges
              | LineEdges
              | NoEdges
              | PolyLine
              | CompoundEdge
                  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot EdgeType where
        unqtDot SplineEdges = toDot True
        unqtDot LineEdges = toDot False
        unqtDot NoEdges = empty
        unqtDot PolyLine = text "polyline"
        unqtDot CompoundEdge = text "compound"
        toDot NoEdges = doubleQuotes empty
        toDot et = unqtDot et

instance ParseDot EdgeType where
        parseUnqt
          = oneOf
              [liftM (bool LineEdges SplineEdges) parse,
               stringRep SplineEdges "spline", stringRep LineEdges "line",
               stringRep PolyLine "polyline", stringRep CompoundEdge "compound"]
        parse = stringRep NoEdges "\"\"" `onFail` optionalQuoted parseUnqt

data PageDir = Bl
             | Br
             | Tl
             | Tr
             | Rb
             | Rt
             | Lb
             | Lt
                 deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot PageDir where
        unqtDot Bl = text "BL"
        unqtDot Br = text "BR"
        unqtDot Tl = text "TL"
        unqtDot Tr = text "TR"
        unqtDot Rb = text "RB"
        unqtDot Rt = text "RT"
        unqtDot Lb = text "LB"
        unqtDot Lt = text "LT"

instance ParseDot PageDir where
        parseUnqt
          = oneOf
              [stringRep Bl "BL", stringRep Br "BR", stringRep Tl "TL",
               stringRep Tr "TR", stringRep Rb "RB", stringRep Rt "RT",
               stringRep Lb "LB", stringRep Lt "LT"]

data Spline = Spline (Maybe Point) (Maybe Point) [Point]
                deriving (Eq, Ord, Show, Read)

instance PrintDot Spline where
        unqtDot (Spline ms me ps) = addS . addE . hsep $ map unqtDot ps
          where addP t = maybe id ((<+>) . commaDel t)
                addS = addP 's' ms
                addE = addP 'e' me
        toDot = doubleQuotes . unqtDot
        unqtListToDot = hcat . punctuate semi . map unqtDot
        listToDot = doubleQuotes . unqtListToDot

instance ParseDot Spline where
        parseUnqt
          = do ms <- parseP 's'
               me <- parseP 'e'
               ps <- sepBy1 parseUnqt whitespace
               return $ Spline ms me ps
          where parseP t
                  = optional $
                      do character t
                         parseComma
                         parseUnqt `discard` whitespace
        parse = quotedParse parseUnqt
        parseUnqtList = sepBy1 parseUnqt (character ';')

data QuadType = NormalQT
              | FastQT
              | NoQT
                  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot QuadType where
        unqtDot NormalQT = text "normal"
        unqtDot FastQT = text "fast"
        unqtDot NoQT = text "none"

instance ParseDot QuadType where
        parseUnqt
          = oneOf
              [stringRep NormalQT "normal", stringRep FastQT "fast",
               stringRep NoQT "none", character '2' >> return FastQT,
               liftM (bool NoQT NormalQT) parse]

data Root = IsCentral
          | NotCentral
          | NodeName String
              deriving (Eq, Ord, Show, Read)

instance PrintDot Root where
        unqtDot IsCentral = unqtDot True
        unqtDot NotCentral = unqtDot False
        unqtDot (NodeName n) = unqtDot n
        toDot (NodeName n) = toDot n
        toDot r = unqtDot r

instance ParseDot Root where
        parseUnqt
          = liftM (bool NotCentral IsCentral) onlyBool `onFail`
              liftM NodeName parseUnqt
        parse
          = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool)
              `onFail` liftM NodeName parse

data RankType = SameRank
              | MinRank
              | SourceRank
              | MaxRank
              | SinkRank
                  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot RankType where
        unqtDot SameRank = text "same"
        unqtDot MinRank = text "min"
        unqtDot SourceRank = text "source"
        unqtDot MaxRank = text "max"
        unqtDot SinkRank = text "sink"

instance ParseDot RankType where
        parseUnqt
          = oneOf
              [stringRep SameRank "same", stringRep MinRank "min",
               stringRep SourceRank "source", stringRep MaxRank "max",
               stringRep SinkRank "sink"]

data RankDir = FromTop
             | FromLeft
             | FromBottom
             | FromRight
                 deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot RankDir where
        unqtDot FromTop = text "TB"
        unqtDot FromLeft = text "LR"
        unqtDot FromBottom = text "BT"
        unqtDot FromRight = text "RL"

instance ParseDot RankDir where
        parseUnqt
          = oneOf
              [stringRep FromTop "TB", stringRep FromLeft "LR",
               stringRep FromBottom "BT", stringRep FromRight "RL"]

data Shape = BoxShape
           | Polygon
           | Ellipse
           | Circle
           | PointShape
           | Egg
           | Triangle
           | PlainText
           | DiamondShape
           | Trapezium
           | Parallelogram
           | House
           | Pentagon
           | Hexagon
           | Septagon
           | Octagon
           | DoubleCircle
           | DoubleOctagon
           | TripleOctagon
           | InvTriangle
           | InvTrapezium
           | InvHouse
           | MDiamond
           | MSquare
           | MCircle
           | Note
           | Tab
           | Folder
           | Box3D
           | Component
               deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot Shape where
        unqtDot BoxShape = text "box"
        unqtDot Polygon = text "polygon"
        unqtDot Ellipse = text "ellipse"
        unqtDot Circle = text "circle"
        unqtDot PointShape = text "point"
        unqtDot Egg = text "egg"
        unqtDot Triangle = text "triangle"
        unqtDot PlainText = text "plaintext"
        unqtDot DiamondShape = text "diamond"
        unqtDot Trapezium = text "trapezium"
        unqtDot Parallelogram = text "parallelogram"
        unqtDot House = text "house"
        unqtDot Pentagon = text "pentagon"
        unqtDot Hexagon = text "hexagon"
        unqtDot Septagon = text "septagon"
        unqtDot Octagon = text "octagon"
        unqtDot DoubleCircle = text "doublecircle"
        unqtDot DoubleOctagon = text "doubleoctagon"
        unqtDot TripleOctagon = text "tripleoctagon"
        unqtDot InvTriangle = text "invtriangle"
        unqtDot InvTrapezium = text "invtrapezium"
        unqtDot InvHouse = text "invhouse"
        unqtDot MDiamond = text "Mdiamond"
        unqtDot MSquare = text "Msquare"
        unqtDot MCircle = text "Mcircle"
        unqtDot Note = text "note"
        unqtDot Tab = text "tab"
        unqtDot Folder = text "folder"
        unqtDot Box3D = text "box3d"
        unqtDot Component = text "component"

instance ParseDot Shape where
        parseUnqt
          = oneOf
              [stringRep Box3D "box3d",
               stringReps BoxShape ["box", "rectangle", "rect"],
               stringRep Polygon "polygon", stringRep Ellipse "ellipse",
               stringRep Circle "circle", stringRep PointShape "point",
               stringRep Egg "egg", stringRep Triangle "triangle",
               stringReps PlainText ["plaintext", "none"],
               stringRep DiamondShape "diamond", stringRep Trapezium "trapezium",
               stringRep Parallelogram "parallelogram", stringRep House "house",
               stringRep Pentagon "pentagon", stringRep Hexagon "hexagon",
               stringRep Septagon "septagon", stringRep Octagon "octagon",
               stringRep DoubleCircle "doublecircle",
               stringRep DoubleOctagon "doubleoctagon",
               stringRep TripleOctagon "tripleoctagon",
               stringRep InvTriangle "invtriangle",
               stringRep InvTrapezium "invtrapezium",
               stringRep InvHouse "invhouse", stringRep MDiamond "Mdiamond",
               stringRep MSquare "Msquare", stringRep MCircle "Mcircle",
               stringRep Note "note", stringRep Tab "tab",
               stringRep Folder "folder", stringRep Component "component"]

data SmoothType = NoSmooth
                | AvgDist
                | GraphDist
                | PowerDist
                | RNG
                | Spring
                | TriangleSmooth
                    deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot SmoothType where
        unqtDot NoSmooth = text "none"
        unqtDot AvgDist = text "avg_dist"
        unqtDot GraphDist = text "graph_dist"
        unqtDot PowerDist = text "power_dist"
        unqtDot RNG = text "rng"
        unqtDot Spring = text "spring"
        unqtDot TriangleSmooth = text "triangle"

instance ParseDot SmoothType where
        parseUnqt
          = oneOf
              [stringRep NoSmooth "none", stringRep AvgDist "avg_dist",
               stringRep GraphDist "graph_dist", stringRep PowerDist "power_dist",
               stringRep RNG "rng", stringRep Spring "spring",
               stringRep TriangleSmooth "triangle"]

data StartType = StartStyle STStyle
               | StartSeed Int
               | StartStyleSeed STStyle Int
                   deriving (Eq, Ord, Show, Read)

instance PrintDot StartType where
        unqtDot (StartStyle ss) = unqtDot ss
        unqtDot (StartSeed s) = unqtDot s
        unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s

instance ParseDot StartType where
        parseUnqt
          = oneOf
              [do ss <- parseUnqt
                  s <- parseUnqt
                  return $ StartStyleSeed ss s,
               liftM StartStyle parseUnqt, liftM StartSeed parseUnqt]

data STStyle = RegularStyle
             | SelfStyle
             | RandomStyle
                 deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot STStyle where
        unqtDot RegularStyle = text "regular"
        unqtDot SelfStyle = text "self"
        unqtDot RandomStyle = text "random"

instance ParseDot STStyle where
        parseUnqt
          = oneOf
              [stringRep RegularStyle "regular", stringRep SelfStyle "self",
               stringRep RandomStyle "random"]

data StyleItem = SItem StyleName [String]
                   deriving (Eq, Ord, Show, Read)

instance PrintDot StyleItem where
        unqtDot (SItem nm args)
          | null args = dnm
          | otherwise = dnm <> parens args'
          where dnm = unqtDot nm
                args' = hcat . punctuate comma $ map unqtDot args
        toDot si@(SItem nm args)
          | null args = toDot nm
          | otherwise = doubleQuotes $ unqtDot si
        unqtListToDot = hcat . punctuate comma . map unqtDot
        listToDot [SItem nm []] = toDot nm
        listToDot sis = doubleQuotes $ unqtListToDot sis

instance ParseDot StyleItem where
        parseUnqt
          = do nm <- parseUnqt
               args <- tryParseList' parseArgs
               return $ SItem nm args
        parse
          = quotedParse (liftM2 SItem parseUnqt parseArgs) `onFail`
              liftM (flip SItem []) parse
        parseUnqtList = sepBy1 parseUnqt parseComma
        parseList = quotedParse parseUnqtList `onFail` liftM return parse

parseArgs :: Parse [String]
parseArgs
  = bracketSep (character '(') parseComma (character ')')
      parseStyleName

data StyleName = Dashed
               | Dotted
               | Solid
               | Bold
               | Invisible
               | Filled
               | Diagonals
               | Rounded
               | DD String
                   deriving (Eq, Ord, Show, Read)

instance PrintDot StyleName where
        unqtDot Dashed = text "dashed"
        unqtDot Dotted = text "dotted"
        unqtDot Solid = text "solid"
        unqtDot Bold = text "bold"
        unqtDot Invisible = text "invis"
        unqtDot Filled = text "filled"
        unqtDot Diagonals = text "diagonals"
        unqtDot Rounded = text "rounded"
        unqtDot (DD nm) = unqtDot nm
        toDot (DD nm) = toDot nm
        toDot sn = unqtDot sn

instance ParseDot StyleName where
        parseUnqt = liftM checkDD parseStyleName
        parse
          = liftM checkDD $
              quotedParse parseStyleName `onFail`
                do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ', ']']
                   r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',', ']'])
                   return $ f : r

checkDD :: String -> StyleName
checkDD str
  = case map toLower str of
        "dashed" -> Dashed
        "dotted" -> Dotted
        "solid" -> Solid
        "bold" -> Bold
        "invis" -> Invisible
        "filled" -> Filled
        "diagonals" -> Diagonals
        "rounded" -> Rounded
        _ -> DD str

parseStyleName :: Parse String
parseStyleName
  = do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ']
       r <- many (orQuote $ noneOf [quoteChar, '(', ')', ','])
       return $ f : r

newtype PortPos = PP CompassPoint
                    deriving (Eq, Ord, Show, Read)

instance PrintDot PortPos where
        unqtDot (PP cp) = unqtDot cp
        toDot (PP cp) = toDot cp

instance ParseDot PortPos where
        parseUnqt = liftM PP parseUnqt

data CompassPoint = North
                  | NorthEast
                  | East
                  | SouthEast
                  | South
                  | SouthWest
                  | West
                  | NorthWest
                  | CenterPoint
                  | NoCP
                      deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot CompassPoint where
        unqtDot NorthEast = text "ne"
        unqtDot NorthWest = text "nw"
        unqtDot North = text "n"
        unqtDot East = text "e"
        unqtDot SouthEast = text "se"
        unqtDot SouthWest = text "sw"
        unqtDot South = text "s"
        unqtDot West = text "w"
        unqtDot CenterPoint = text "c"
        unqtDot NoCP = text "_"

instance ParseDot CompassPoint where
        parseUnqt
          = oneOf
              [stringRep NorthEast "ne", stringRep NorthWest "nw",
               stringRep North "n", stringRep SouthEast "se",
               stringRep SouthWest "sw", stringRep South "s", stringRep East "e",
               stringRep West "w", stringRep CenterPoint "c", stringRep NoCP "_"]

data ViewPort = VP{wVal :: Double, hVal :: Double, zVal :: Double,
                   focus :: Maybe FocusType}
                  deriving (Eq, Ord, Show, Read)

instance PrintDot ViewPort where
        unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot) $ focus vp
          where vs
                  = hcat . punctuate comma $
                      map (unqtDot . flip ($) vp) [wVal, hVal, zVal]
        toDot = doubleQuotes . unqtDot

instance ParseDot ViewPort where
        parseUnqt
          = do wv <- parseUnqt
               parseComma
               hv <- parseUnqt
               parseComma
               zv <- parseUnqt
               mf <- optional $ parseComma >> parseUnqt
               return $ VP wv hv zv mf
        parse = quotedParse parseUnqt

data FocusType = XY Point
               | NodeFocus String
                   deriving (Eq, Ord, Show, Read)

instance PrintDot FocusType where
        unqtDot (XY p) = unqtDot p
        unqtDot (NodeFocus nm) = unqtDot nm
        toDot (XY p) = toDot p
        toDot (NodeFocus nm) = toDot nm

instance ParseDot FocusType where
        parseUnqt = liftM XY parseUnqt `onFail` liftM NodeFocus parseUnqt
        parse = liftM XY parse `onFail` liftM NodeFocus parse

data VerticalPlacement = VTop
                       | VCenter
                       | VBottom
                           deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot VerticalPlacement where
        unqtDot VTop = char 't'
        unqtDot VCenter = char 'c'
        unqtDot VBottom = char 'b'

instance ParseDot VerticalPlacement where
        parseUnqt
          = oneOf
              [stringRep VTop "t", stringRep VCenter "c", stringRep VBottom "b"]

data ScaleType = UniformScale
               | NoScale
               | FillWidth
               | FillHeight
               | FillBoth
                   deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot ScaleType where
        unqtDot UniformScale = unqtDot True
        unqtDot NoScale = unqtDot False
        unqtDot FillWidth = text "width"
        unqtDot FillHeight = text "height"
        unqtDot FillBoth = text "both"

instance ParseDot ScaleType where
        parseUnqt
          = oneOf
              [stringRep UniformScale "true", stringRep NoScale "false",
               stringRep FillWidth "width", stringRep FillHeight "height",
               stringRep FillBoth "both"]

data Justification = JLeft
                   | JRight
                   | JCenter
                       deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot Justification where
        unqtDot JLeft = char 'l'
        unqtDot JRight = char 'r'
        unqtDot JCenter = char 'c'

instance ParseDot Justification where
        parseUnqt
          = oneOf
              [stringRep JLeft "l", stringRep JRight "r", stringRep JCenter "c"]

data Ratios = AspectRatio Double
            | FillRatio
            | CompressRatio
            | ExpandRatio
            | AutoRatio
                deriving (Eq, Ord, Show, Read)

instance PrintDot Ratios where
        unqtDot (AspectRatio r) = unqtDot r
        unqtDot FillRatio = text "fill"
        unqtDot CompressRatio = text "compress"
        unqtDot ExpandRatio = text "expand"
        unqtDot AutoRatio = text "auto"

instance ParseDot Ratios where
        parseUnqt
          = oneOf
              [liftM AspectRatio parseUnqt, stringRep FillRatio "fill",
               stringRep CompressRatio "compress", stringRep ExpandRatio "expand",
               stringRep AutoRatio "auto"]