1module Data.GraphViz.Attributes 2 (Attribute(..), Attributes, usedByGraphs, usedBySubGraphs, 3 usedByClusters, usedByNodes, usedByEdges, EscString, URL(..), 4 ArrowType(..), AspectType(..), Rect(..), ClusterMode(..), 5 DirType(..), DEConstraints(..), DPoint(..), ModeType(..), 6 Model(..), Label(..), Point(..), Overlap(..), LayerRange(..), 7 LayerID(..), LayerList(..), OutputMode(..), Pack(..), PackMode(..), 8 Pos(..), EdgeType(..), PageDir(..), Spline(..), QuadType(..), 9 Root(..), RankType(..), RankDir(..), Shape(..), SmoothType(..), 10 StartType(..), STStyle(..), StyleItem(..), StyleName(..), 11 PortPos(..), CompassPoint(..), ViewPort(..), FocusType(..), 12 VerticalPlacement(..), ScaleType(..), Justification(..), 13 Ratios(..), module Data.GraphViz.Attributes.Colors, ArrowShape(..), 14 ArrowModifier(..), ArrowFill(..), ArrowSide(..), box, crow, 15 diamond, dotArrow, inv, noArrow, normal, tee, vee, oDot, invDot, 16 invODot, oBox, oDiamond, eDiamond, openArr, halfOpen, emptyArr, 17 invEmpty, noMods, openMod, defLayerSep, notLayerSep) 18 where 19import Data.GraphViz.Attributes.Colors 20import Data.GraphViz.Util 21import Data.GraphViz.Parsing 22import Data.GraphViz.Printing 23import Data.Char (toLower) 24import Data.Maybe (isJust) 25import Control.Arrow (first) 26import Control.Monad (liftM, liftM2) 27 28data Attribute = Damping Double 29 | K Double 30 | URL URL 31 | ArrowHead ArrowType 32 | ArrowSize Double 33 | ArrowTail ArrowType 34 | Aspect AspectType 35 | Bb Rect 36 | BgColor Color 37 | Center Bool 38 | Charset String 39 | ClusterRank ClusterMode 40 | ColorScheme ColorScheme 41 | Color [Color] 42 | Comment String 43 | Compound Bool 44 | Concentrate Bool 45 | Constraint Bool 46 | Decorate Bool 47 | DefaultDist Double 48 | Dimen Int 49 | Dim Int 50 | Dir DirType 51 | DirEdgeConstraints DEConstraints 52 | Distortion Double 53 | DPI Double 54 | EdgeURL URL 55 | EdgeTarget EscString 56 | EdgeTooltip EscString 57 | Epsilon Double 58 | ESep DPoint 59 | FillColor Color 60 | FixedSize Bool 61 | FontColor Color 62 | FontName String 63 | FontNames String 64 | FontPath String 65 | FontSize Double 66 | Group String 67 | HeadURL URL 68 | HeadClip Bool 69 | HeadLabel Label 70 | HeadPort PortPos 71 | HeadTarget EscString 72 | HeadTooltip EscString 73 | Height Double 74 | ID Label 75 | Image String 76 | ImageScale ScaleType 77 | LabelURL URL 78 | LabelAngle Double 79 | LabelDistance Double 80 | LabelFloat Bool 81 | LabelFontColor Color 82 | LabelFontName String 83 | LabelFontSize Double 84 | LabelJust Justification 85 | LabelLoc VerticalPlacement 86 | LabelTarget EscString 87 | LabelTooltip EscString 88 | Label Label 89 | Landscape Bool 90 | LayerSep String 91 | Layers LayerList 92 | Layer LayerRange 93 | Layout String 94 | Len Double 95 | LevelsGap Double 96 | Levels Int 97 | LHead String 98 | LPos Point 99 | LTail String 100 | Margin DPoint 101 | MaxIter Int 102 | MCLimit Double 103 | MinDist Double 104 | MinLen Int 105 | Model Model 106 | Mode ModeType 107 | Mosek Bool 108 | NodeSep Double 109 | NoJustify Bool 110 | Normalize Bool 111 | Nslimit1 Double 112 | Nslimit Double 113 | Ordering String 114 | Orientation Double 115 | OutputOrder OutputMode 116 | OverlapScaling Double 117 | Overlap Overlap 118 | PackMode PackMode 119 | Pack Pack 120 | Pad DPoint 121 | PageDir PageDir 122 | Page Point 123 | PenColor Color 124 | PenWidth Double 125 | Peripheries Int 126 | Pin Bool 127 | Pos Pos 128 | QuadTree QuadType 129 | Quantum Double 130 | RankDir RankDir 131 | RankSep Double 132 | Rank RankType 133 | Ratio Ratios 134 | Rects Rect 135 | Regular Bool 136 | ReMinCross Bool 137 | RepulsiveForce Double 138 | Root Root 139 | Rotate Int 140 | SameHead String 141 | SameTail String 142 | SamplePoints Int 143 | SearchSize Int 144 | Sep DPoint 145 | ShapeFile String 146 | Shape Shape 147 | ShowBoxes Int 148 | Sides Int 149 | Size Point 150 | Skew Double 151 | Smoothing SmoothType 152 | SortV Int 153 | Splines EdgeType 154 | Start StartType 155 | StyleSheet String 156 | Style [StyleItem] 157 | TailURL URL 158 | TailClip Bool 159 | TailLabel Label 160 | TailPort PortPos 161 | TailTarget EscString 162 | TailTooltip EscString 163 | Target EscString 164 | Tooltip EscString 165 | TrueColor Bool 166 | Vertices [Point] 167 | ViewPort ViewPort 168 | VoroMargin Double 169 | Weight Double 170 | Width Double 171 | Z Double 172 deriving (Eq, Ord, Show, Read) 173 174type Attributes = [Attribute] 175 176instance PrintDot Attribute where 177 unqtDot (Damping v) = printField "Damping" v 178 unqtDot (K v) = printField "K" v 179 unqtDot (URL v) = printField "URL" v 180 unqtDot (ArrowHead v) = printField "arrowhead" v 181 unqtDot (ArrowSize v) = printField "arrowsize" v 182 unqtDot (ArrowTail v) = printField "arrowtail" v 183 unqtDot (Aspect v) = printField "aspect" v 184 unqtDot (Bb v) = printField "bb" v 185 unqtDot (BgColor v) = printField "bgcolor" v 186 unqtDot (Center v) = printField "center" v 187 unqtDot (Charset v) = printField "charset" v 188 unqtDot (ClusterRank v) = printField "clusterrank" v 189 unqtDot (ColorScheme v) = printField "colorscheme" v 190 unqtDot (Color v) = printField "color" v 191 unqtDot (Comment v) = printField "comment" v 192 unqtDot (Compound v) = printField "compound" v 193 unqtDot (Concentrate v) = printField "concentrate" v 194 unqtDot (Constraint v) = printField "constraint" v 195 unqtDot (Decorate v) = printField "decorate" v 196 unqtDot (DefaultDist v) = printField "defaultdist" v 197 unqtDot (Dimen v) = printField "dimen" v 198 unqtDot (Dim v) = printField "dim" v 199 unqtDot (Dir v) = printField "dir" v 200 unqtDot (DirEdgeConstraints v) = printField "diredgeconstraints" v 201 unqtDot (Distortion v) = printField "distortion" v 202 unqtDot (DPI v) = printField "dpi" v 203 unqtDot (EdgeURL v) = printField "edgeURL" v 204 unqtDot (EdgeTarget v) = printField "edgetarget" v 205 unqtDot (EdgeTooltip v) = printField "edgetooltip" v 206 unqtDot (Epsilon v) = printField "epsilon" v 207 unqtDot (ESep v) = printField "esep" v 208 unqtDot (FillColor v) = printField "fillcolor" v 209 unqtDot (FixedSize v) = printField "fixedsize" v 210 unqtDot (FontColor v) = printField "fontcolor" v 211 unqtDot (FontName v) = printField "fontname" v 212 unqtDot (FontNames v) = printField "fontnames" v 213 unqtDot (FontPath v) = printField "fontpath" v 214 unqtDot (FontSize v) = printField "fontsize" v 215 unqtDot (Group v) = printField "group" v 216 unqtDot (HeadURL v) = printField "headURL" v 217 unqtDot (HeadClip v) = printField "headclip" v 218 unqtDot (HeadLabel v) = printField "headlabel" v 219 unqtDot (HeadPort v) = printField "headport" v 220 unqtDot (HeadTarget v) = printField "headtarget" v 221 unqtDot (HeadTooltip v) = printField "headtooltip" v 222 unqtDot (Height v) = printField "height" v 223 unqtDot (ID v) = printField "id" v 224 unqtDot (Image v) = printField "image" v 225 unqtDot (ImageScale v) = printField "imagescale" v 226 unqtDot (LabelURL v) = printField "labelURL" v 227 unqtDot (LabelAngle v) = printField "labelangle" v 228 unqtDot (LabelDistance v) = printField "labeldistance" v 229 unqtDot (LabelFloat v) = printField "labelfloat" v 230 unqtDot (LabelFontColor v) = printField "labelfontcolor" v 231 unqtDot (LabelFontName v) = printField "labelfontname" v 232 unqtDot (LabelFontSize v) = printField "labelfontsize" v 233 unqtDot (LabelJust v) = printField "labeljust" v 234 unqtDot (LabelLoc v) = printField "labelloc" v 235 unqtDot (LabelTarget v) = printField "labeltarget" v 236 unqtDot (LabelTooltip v) = printField "labeltooltip" v 237 unqtDot (Label v) = printField "label" v 238 unqtDot (Landscape v) = printField "landscape" v 239 unqtDot (LayerSep v) = printField "layersep" v 240 unqtDot (Layers v) = printField "layers" v 241 unqtDot (Layer v) = printField "layer" v 242 unqtDot (Layout v) = printField "layout" v 243 unqtDot (Len v) = printField "len" v 244 unqtDot (LevelsGap v) = printField "levelsgap" v 245 unqtDot (Levels v) = printField "levels" v 246 unqtDot (LHead v) = printField "lhead" v 247 unqtDot (LPos v) = printField "lp" v 248 unqtDot (LTail v) = printField "ltail" v 249 unqtDot (Margin v) = printField "margin" v 250 unqtDot (MaxIter v) = printField "maxiter" v 251 unqtDot (MCLimit v) = printField "mclimit" v 252 unqtDot (MinDist v) = printField "mindist" v 253 unqtDot (MinLen v) = printField "minlen" v 254 unqtDot (Model v) = printField "model" v 255 unqtDot (Mode v) = printField "mode" v 256 unqtDot (Mosek v) = printField "mosek" v 257 unqtDot (NodeSep v) = printField "nodesep" v 258 unqtDot (NoJustify v) = printField "nojustify" v 259 unqtDot (Normalize v) = printField "normalize" v 260 unqtDot (Nslimit1 v) = printField "nslimit1" v 261 unqtDot (Nslimit v) = printField "nslimit" v 262 unqtDot (Ordering v) = printField "ordering" v 263 unqtDot (Orientation v) = printField "orientation" v 264 unqtDot (OutputOrder v) = printField "outputorder" v 265 unqtDot (OverlapScaling v) = printField "overlap_scaling" v 266 unqtDot (Overlap v) = printField "overlap" v 267 unqtDot (PackMode v) = printField "packmode" v 268 unqtDot (Pack v) = printField "pack" v 269 unqtDot (Pad v) = printField "pad" v 270 unqtDot (PageDir v) = printField "pagedir" v 271 unqtDot (Page v) = printField "page" v 272 unqtDot (PenColor v) = printField "pencolor" v 273 unqtDot (PenWidth v) = printField "penwidth" v 274 unqtDot (Peripheries v) = printField "peripheries" v 275 unqtDot (Pin v) = printField "pin" v 276 unqtDot (Pos v) = printField "pos" v 277 unqtDot (QuadTree v) = printField "quadtree" v 278 unqtDot (Quantum v) = printField "quantum" v 279 unqtDot (RankDir v) = printField "rankdir" v 280 unqtDot (RankSep v) = printField "ranksep" v 281 unqtDot (Rank v) = printField "rank" v 282 unqtDot (Ratio v) = printField "ratio" v 283 unqtDot (Rects v) = printField "rects" v 284 unqtDot (Regular v) = printField "regular" v 285 unqtDot (ReMinCross v) = printField "remincross" v 286 unqtDot (RepulsiveForce v) = printField "repulsiveforce" v 287 unqtDot (Root v) = printField "root" v 288 unqtDot (Rotate v) = printField "rotate" v 289 unqtDot (SameHead v) = printField "samehead" v 290 unqtDot (SameTail v) = printField "sametail" v 291 unqtDot (SamplePoints v) = printField "samplepoints" v 292 unqtDot (SearchSize v) = printField "searchsize" v 293 unqtDot (Sep v) = printField "sep" v 294 unqtDot (ShapeFile v) = printField "shapefile" v 295 unqtDot (Shape v) = printField "shape" v 296 unqtDot (ShowBoxes v) = printField "showboxes" v 297 unqtDot (Sides v) = printField "sides" v 298 unqtDot (Size v) = printField "size" v 299 unqtDot (Skew v) = printField "skew" v 300 unqtDot (Smoothing v) = printField "smoothing" v 301 unqtDot (SortV v) = printField "sortv" v 302 unqtDot (Splines v) = printField "splines" v 303 unqtDot (Start v) = printField "start" v 304 unqtDot (StyleSheet v) = printField "stylesheet" v 305 unqtDot (Style v) = printField "style" v 306 unqtDot (TailURL v) = printField "tailURL" v 307 unqtDot (TailClip v) = printField "tailclip" v 308 unqtDot (TailLabel v) = printField "taillabel" v 309 unqtDot (TailPort v) = printField "tailport" v 310 unqtDot (TailTarget v) = printField "tailtarget" v 311 unqtDot (TailTooltip v) = printField "tailtooltip" v 312 unqtDot (Target v) = printField "target" v 313 unqtDot (Tooltip v) = printField "tooltip" v 314 unqtDot (TrueColor v) = printField "truecolor" v 315 unqtDot (Vertices v) = printField "vertices" v 316 unqtDot (ViewPort v) = printField "viewport" v 317 unqtDot (VoroMargin v) = printField "voro_margin" v 318 unqtDot (Weight v) = printField "weight" v 319 unqtDot (Width v) = printField "width" v 320 unqtDot (Z v) = printField "z" v 321 listToDot = unqtListToDot 322 323instance ParseDot Attribute where 324 parseUnqt 325 = oneOf 326 [liftM Damping $ parseField "Damping", liftM K $ parseField "K", 327 liftM URL $ parseFields ["URL", "href"], 328 liftM ArrowHead $ parseField "arrowhead", 329 liftM ArrowSize $ parseField "arrowsize", 330 liftM ArrowTail $ parseField "arrowtail", 331 liftM Aspect $ parseField "aspect", liftM Bb $ parseField "bb", 332 liftM BgColor $ parseField "bgcolor", 333 liftM Center $ parseFieldBool "center", 334 liftM Charset $ parseField "charset", 335 liftM ClusterRank $ parseField "clusterrank", 336 liftM ColorScheme $ parseField "colorscheme", 337 liftM Color $ parseField "color", 338 liftM Comment $ parseField "comment", 339 liftM Compound $ parseFieldBool "compound", 340 liftM Concentrate $ parseFieldBool "concentrate", 341 liftM Constraint $ parseFieldBool "constraint", 342 liftM Decorate $ parseFieldBool "decorate", 343 liftM DefaultDist $ parseField "defaultdist", 344 liftM Dimen $ parseField "dimen", liftM Dim $ parseField "dim", 345 liftM Dir $ parseField "dir", 346 liftM DirEdgeConstraints $ 347 parseFieldDef EdgeConstraints "diredgeconstraints", 348 liftM Distortion $ parseField "distortion", 349 liftM DPI $ parseFields ["dpi", "resolution"], 350 liftM EdgeURL $ parseFields ["edgeURL", "edgehref"], 351 liftM EdgeTarget $ parseField "edgetarget", 352 liftM EdgeTooltip $ parseField "edgetooltip", 353 liftM Epsilon $ parseField "epsilon", 354 liftM ESep $ parseField "esep", 355 liftM FillColor $ parseField "fillcolor", 356 liftM FixedSize $ parseFieldBool "fixedsize", 357 liftM FontColor $ parseField "fontcolor", 358 liftM FontName $ parseField "fontname", 359 liftM FontNames $ parseField "fontnames", 360 liftM FontPath $ parseField "fontpath", 361 liftM FontSize $ parseField "fontsize", 362 liftM Group $ parseField "group", 363 liftM HeadURL $ parseFields ["headURL", "headhref"], 364 liftM HeadClip $ parseFieldBool "headclip", 365 liftM HeadLabel $ parseField "headlabel", 366 liftM HeadPort $ parseField "headport", 367 liftM HeadTarget $ parseField "headtarget", 368 liftM HeadTooltip $ parseField "headtooltip", 369 liftM Height $ parseField "height", liftM ID $ parseField "id", 370 liftM Image $ parseField "image", 371 liftM ImageScale $ parseFieldDef UniformScale "imagescale", 372 liftM LabelURL $ parseFields ["labelURL", "labelhref"], 373 liftM LabelAngle $ parseField "labelangle", 374 liftM LabelDistance $ parseField "labeldistance", 375 liftM LabelFloat $ parseFieldBool "labelfloat", 376 liftM LabelFontColor $ parseField "labelfontcolor", 377 liftM LabelFontName $ parseField "labelfontname", 378 liftM LabelFontSize $ parseField "labelfontsize", 379 liftM LabelJust $ parseField "labeljust", 380 liftM LabelLoc $ parseField "labelloc", 381 liftM LabelTarget $ parseField "labeltarget", 382 liftM LabelTooltip $ parseField "labeltooltip", 383 liftM Label $ parseField "label", 384 liftM Landscape $ parseFieldBool "landscape", 385 liftM LayerSep $ parseField "layersep", 386 liftM Layers $ parseField "layers", 387 liftM Layer $ parseField "layer", 388 liftM Layout $ parseField "layout", liftM Len $ parseField "len", 389 liftM LevelsGap $ parseField "levelsgap", 390 liftM Levels $ parseField "levels", 391 liftM LHead $ parseField "lhead", liftM LPos $ parseField "lp", 392 liftM LTail $ parseField "ltail", 393 liftM Margin $ parseField "margin", 394 liftM MaxIter $ parseField "maxiter", 395 liftM MCLimit $ parseField "mclimit", 396 liftM MinDist $ parseField "mindist", 397 liftM MinLen $ parseField "minlen", 398 liftM Model $ parseField "model", liftM Mode $ parseField "mode", 399 liftM Mosek $ parseFieldBool "mosek", 400 liftM NodeSep $ parseField "nodesep", 401 liftM NoJustify $ parseFieldBool "nojustify", 402 liftM Normalize $ parseFieldBool "normalize", 403 liftM Nslimit1 $ parseField "nslimit1", 404 liftM Nslimit $ parseField "nslimit", 405 liftM Ordering $ parseField "ordering", 406 liftM Orientation $ parseField "orientation", 407 liftM OutputOrder $ parseField "outputorder", 408 liftM OverlapScaling $ parseField "overlap_scaling", 409 liftM Overlap $ parseFieldDef KeepOverlaps "overlap", 410 liftM PackMode $ parseField "packmode", 411 liftM Pack $ parseFieldDef DoPack "pack", 412 liftM Pad $ parseField "pad", liftM PageDir $ parseField "pagedir", 413 liftM Page $ parseField "page", 414 liftM PenColor $ parseField "pencolor", 415 liftM PenWidth $ parseField "penwidth", 416 liftM Peripheries $ parseField "peripheries", 417 liftM Pin $ parseFieldBool "pin", liftM Pos $ parseField "pos", 418 liftM QuadTree $ parseFieldDef NormalQT "quadtree", 419 liftM Quantum $ parseField "quantum", 420 liftM RankDir $ parseField "rankdir", 421 liftM RankSep $ parseField "ranksep", 422 liftM Rank $ parseField "rank", liftM Ratio $ parseField "ratio", 423 liftM Rects $ parseField "rects", 424 liftM Regular $ parseFieldBool "regular", 425 liftM ReMinCross $ parseFieldBool "remincross", 426 liftM RepulsiveForce $ parseField "repulsiveforce", 427 liftM Root $ parseFieldDef IsCentral "root", 428 liftM Rotate $ parseField "rotate", 429 liftM SameHead $ parseField "samehead", 430 liftM SameTail $ parseField "sametail", 431 liftM SamplePoints $ parseField "samplepoints", 432 liftM SearchSize $ parseField "searchsize", 433 liftM Sep $ parseField "sep", 434 liftM ShapeFile $ parseField "shapefile", 435 liftM Shape $ parseField "shape", 436 liftM ShowBoxes $ parseField "showboxes", 437 liftM Sides $ parseField "sides", liftM Size $ parseField "size", 438 liftM Skew $ parseField "skew", 439 liftM Smoothing $ parseField "smoothing", 440 liftM SortV $ parseField "sortv", 441 liftM Splines $ parseFieldDef SplineEdges "splines", 442 liftM Start $ parseField "start", 443 liftM StyleSheet $ parseField "stylesheet", 444 liftM Style $ parseField "style", 445 liftM TailURL $ parseFields ["tailURL", "tailhref"], 446 liftM TailClip $ parseFieldBool "tailclip", 447 liftM TailLabel $ parseField "taillabel", 448 liftM TailPort $ parseField "tailport", 449 liftM TailTarget $ parseField "tailtarget", 450 liftM TailTooltip $ parseField "tailtooltip", 451 liftM Target $ parseField "target", 452 liftM Tooltip $ parseField "tooltip", 453 liftM TrueColor $ parseFieldBool "truecolor", 454 liftM Vertices $ parseField "vertices", 455 liftM ViewPort $ parseField "viewport", 456 liftM VoroMargin $ parseField "voro_margin", 457 liftM Weight $ parseField "weight", 458 liftM Width $ parseField "width", liftM Z $ parseField "z"] 459 parse = parseUnqt 460 parseList = parseUnqtList 461 462usedByGraphs :: Attribute -> Bool 463usedByGraphs Damping{} = True 464usedByGraphs K{} = True 465usedByGraphs URL{} = True 466usedByGraphs Aspect{} = True 467usedByGraphs Bb{} = True 468usedByGraphs BgColor{} = True 469usedByGraphs Center{} = True 470usedByGraphs Charset{} = True 471usedByGraphs ClusterRank{} = True 472usedByGraphs ColorScheme{} = True 473usedByGraphs Comment{} = True 474usedByGraphs Compound{} = True 475usedByGraphs Concentrate{} = True 476usedByGraphs DefaultDist{} = True 477usedByGraphs Dimen{} = True 478usedByGraphs Dim{} = True 479usedByGraphs DirEdgeConstraints{} = True 480usedByGraphs DPI{} = True 481usedByGraphs Epsilon{} = True 482usedByGraphs ESep{} = True 483usedByGraphs FontColor{} = True 484usedByGraphs FontName{} = True 485usedByGraphs FontNames{} = True 486usedByGraphs FontPath{} = True 487usedByGraphs FontSize{} = True 488usedByGraphs ID{} = True 489usedByGraphs LabelJust{} = True 490usedByGraphs LabelLoc{} = True 491usedByGraphs Label{} = True 492usedByGraphs Landscape{} = True 493usedByGraphs LayerSep{} = True 494usedByGraphs Layers{} = True 495usedByGraphs Layout{} = True 496usedByGraphs LevelsGap{} = True 497usedByGraphs Levels{} = True 498usedByGraphs LPos{} = True 499usedByGraphs Margin{} = True 500usedByGraphs MaxIter{} = True 501usedByGraphs MCLimit{} = True 502usedByGraphs MinDist{} = True 503usedByGraphs Model{} = True 504usedByGraphs Mode{} = True 505usedByGraphs Mosek{} = True 506usedByGraphs NodeSep{} = True 507usedByGraphs NoJustify{} = True 508usedByGraphs Normalize{} = True 509usedByGraphs Nslimit1{} = True 510usedByGraphs Nslimit{} = True 511usedByGraphs Ordering{} = True 512usedByGraphs OutputOrder{} = True 513usedByGraphs OverlapScaling{} = True 514usedByGraphs Overlap{} = True 515usedByGraphs PackMode{} = True 516usedByGraphs Pack{} = True 517usedByGraphs Pad{} = True 518usedByGraphs PageDir{} = True 519usedByGraphs Page{} = True 520usedByGraphs QuadTree{} = True 521usedByGraphs Quantum{} = True 522usedByGraphs RankDir{} = True 523usedByGraphs RankSep{} = True 524usedByGraphs Ratio{} = True 525usedByGraphs ReMinCross{} = True 526usedByGraphs RepulsiveForce{} = True 527usedByGraphs Root{} = True 528usedByGraphs Rotate{} = True 529usedByGraphs SearchSize{} = True 530usedByGraphs Sep{} = True 531usedByGraphs ShowBoxes{} = True 532usedByGraphs Size{} = True 533usedByGraphs Smoothing{} = True 534usedByGraphs SortV{} = True 535usedByGraphs Splines{} = True 536usedByGraphs Start{} = True 537usedByGraphs StyleSheet{} = True 538usedByGraphs Target{} = True 539usedByGraphs TrueColor{} = True 540usedByGraphs ViewPort{} = True 541usedByGraphs VoroMargin{} = True 542usedByGraphs _ = False 543 544usedByClusters :: Attribute -> Bool 545usedByClusters K{} = True 546usedByClusters URL{} = True 547usedByClusters BgColor{} = True 548usedByClusters ColorScheme{} = True 549usedByClusters Color{} = True 550usedByClusters FillColor{} = True 551usedByClusters FontColor{} = True 552usedByClusters FontName{} = True 553usedByClusters FontSize{} = True 554usedByClusters LabelJust{} = True 555usedByClusters LabelLoc{} = True 556usedByClusters Label{} = True 557usedByClusters LPos{} = True 558usedByClusters NoJustify{} = True 559usedByClusters PenColor{} = True 560usedByClusters PenWidth{} = True 561usedByClusters Peripheries{} = True 562usedByClusters Rank{} = True 563usedByClusters SortV{} = True 564usedByClusters Style{} = True 565usedByClusters Target{} = True 566usedByClusters Tooltip{} = True 567usedByClusters _ = False 568 569usedBySubGraphs :: Attribute -> Bool 570usedBySubGraphs Rank{} = True 571usedBySubGraphs _ = False 572 573usedByNodes :: Attribute -> Bool 574usedByNodes URL{} = True 575usedByNodes ColorScheme{} = True 576usedByNodes Color{} = True 577usedByNodes Comment{} = True 578usedByNodes Distortion{} = True 579usedByNodes FillColor{} = True 580usedByNodes FixedSize{} = True 581usedByNodes FontColor{} = True 582usedByNodes FontName{} = True 583usedByNodes FontSize{} = True 584usedByNodes Group{} = True 585usedByNodes Height{} = True 586usedByNodes ID{} = True 587usedByNodes Image{} = True 588usedByNodes ImageScale{} = True 589usedByNodes LabelLoc{} = True 590usedByNodes Label{} = True 591usedByNodes Layer{} = True 592usedByNodes Margin{} = True 593usedByNodes NoJustify{} = True 594usedByNodes Orientation{} = True 595usedByNodes PenWidth{} = True 596usedByNodes Peripheries{} = True 597usedByNodes Pin{} = True 598usedByNodes Pos{} = True 599usedByNodes Rects{} = True 600usedByNodes Regular{} = True 601usedByNodes Root{} = True 602usedByNodes SamplePoints{} = True 603usedByNodes ShapeFile{} = True 604usedByNodes Shape{} = True 605usedByNodes ShowBoxes{} = True 606usedByNodes Sides{} = True 607usedByNodes Skew{} = True 608usedByNodes SortV{} = True 609usedByNodes Style{} = True 610usedByNodes Target{} = True 611usedByNodes Tooltip{} = True 612usedByNodes Vertices{} = True 613usedByNodes Width{} = True 614usedByNodes Z{} = True 615usedByNodes _ = False 616 617usedByEdges :: Attribute -> Bool 618usedByEdges URL{} = True 619usedByEdges ArrowHead{} = True 620usedByEdges ArrowSize{} = True 621usedByEdges ArrowTail{} = True 622usedByEdges ColorScheme{} = True 623usedByEdges Color{} = True 624usedByEdges Comment{} = True 625usedByEdges Constraint{} = True 626usedByEdges Decorate{} = True 627usedByEdges Dir{} = True 628usedByEdges EdgeURL{} = True 629usedByEdges EdgeTarget{} = True 630usedByEdges EdgeTooltip{} = True 631usedByEdges FontColor{} = True 632usedByEdges FontName{} = True 633usedByEdges FontSize{} = True 634usedByEdges HeadURL{} = True 635usedByEdges HeadClip{} = True 636usedByEdges HeadLabel{} = True 637usedByEdges HeadPort{} = True 638usedByEdges HeadTarget{} = True 639usedByEdges HeadTooltip{} = True 640usedByEdges ID{} = True 641usedByEdges LabelURL{} = True 642usedByEdges LabelAngle{} = True 643usedByEdges LabelDistance{} = True 644usedByEdges LabelFloat{} = True 645usedByEdges LabelFontColor{} = True 646usedByEdges LabelFontName{} = True 647usedByEdges LabelFontSize{} = True 648usedByEdges LabelTarget{} = True 649usedByEdges LabelTooltip{} = True 650usedByEdges Label{} = True 651usedByEdges Layer{} = True 652usedByEdges Len{} = True 653usedByEdges LHead{} = True 654usedByEdges LPos{} = True 655usedByEdges LTail{} = True 656usedByEdges MinLen{} = True 657usedByEdges NoJustify{} = True 658usedByEdges PenWidth{} = True 659usedByEdges Pos{} = True 660usedByEdges SameHead{} = True 661usedByEdges SameTail{} = True 662usedByEdges ShowBoxes{} = True 663usedByEdges Style{} = True 664usedByEdges TailURL{} = True 665usedByEdges TailClip{} = True 666usedByEdges TailLabel{} = True 667usedByEdges TailPort{} = True 668usedByEdges TailTarget{} = True 669usedByEdges TailTooltip{} = True 670usedByEdges Target{} = True 671usedByEdges Tooltip{} = True 672usedByEdges Weight{} = True 673usedByEdges _ = False 674 675type EscString = String 676 677newtype URL = UStr{urlString :: EscString} 678 deriving (Eq, Ord, Show, Read) 679 680instance PrintDot URL where 681 unqtDot = wrap (char '<') (char '>') . text . urlString 682 683instance ParseDot URL where 684 parseUnqt 685 = liftM UStr $ 686 bracket (character open) (character close) 687 (many1 $ satisfy ((/=) close)) 688 where open = '<' 689 close = '>' 690 parse = parseUnqt 691 692newtype ArrowType = AType [(ArrowModifier, ArrowShape)] 693 deriving (Eq, Ord, Show, Read) 694 695box, crow, diamond, dotArrow, inv, noArrow, normal, tee, vee :: 696 ArrowType 697 698oDot, invDot, invODot, oBox, oDiamond :: ArrowType 699 700eDiamond, openArr, halfOpen, emptyArr, invEmpty :: ArrowType 701normal = AType [(noMods, Normal)] 702inv = AType [(noMods, Inv)] 703dotArrow = AType [(noMods, DotArrow)] 704invDot = AType [(noMods, Inv), (noMods, DotArrow)] 705oDot = AType [(ArrMod OpenArrow BothSides, DotArrow)] 706invODot = AType [(noMods, Inv), (openMod, DotArrow)] 707noArrow = AType [(noMods, NoArrow)] 708tee = AType [(noMods, Tee)] 709emptyArr = AType [(openMod, Normal)] 710invEmpty = AType [(noMods, Inv), (openMod, Normal)] 711diamond = AType [(noMods, Diamond)] 712oDiamond = AType [(openMod, Diamond)] 713eDiamond = oDiamond 714crow = AType [(noMods, Crow)] 715box = AType [(noMods, Box)] 716oBox = AType [(openMod, Box)] 717openArr = vee 718halfOpen = AType [(ArrMod FilledArrow LeftSide, Vee)] 719vee = AType [(noMods, Vee)] 720 721instance PrintDot ArrowType where 722 unqtDot (AType mas) = hcat $ map appMod mas 723 where appMod (m, a) = unqtDot m <> unqtDot a 724 725instance ParseDot ArrowType where 726 parseUnqt 727 = do mas <- many1 $ 728 do m <- parseUnqt 729 a <- parseUnqt 730 return (m, a) 731 return $ AType mas 732 `onFail` specialArrowParse 733 734specialArrowParse :: Parse ArrowType 735specialArrowParse 736 = oneOf 737 [stringRep eDiamond "ediamond", stringRep openArr "open", 738 stringRep halfOpen "halfopen", stringRep emptyArr "empty", 739 stringRep invEmpty "invempty"] 740 741data ArrowShape = Box 742 | Crow 743 | Diamond 744 | DotArrow 745 | Inv 746 | NoArrow 747 | Normal 748 | Tee 749 | Vee 750 deriving (Eq, Ord, Bounded, Enum, Show, Read) 751 752instance PrintDot ArrowShape where 753 unqtDot Box = unqtDot "box" 754 unqtDot Crow = unqtDot "crow" 755 unqtDot Diamond = unqtDot "diamond" 756 unqtDot DotArrow = unqtDot "dot" 757 unqtDot Inv = unqtDot "inv" 758 unqtDot NoArrow = unqtDot "none" 759 unqtDot Normal = unqtDot "normal" 760 unqtDot Tee = unqtDot "tee" 761 unqtDot Vee = unqtDot "vee" 762 763instance ParseDot ArrowShape where 764 parseUnqt 765 = oneOf 766 [stringRep Box "box", stringRep Crow "crow", 767 stringRep Diamond "diamond", stringRep DotArrow "dot", 768 stringRep Inv "inv", stringRep NoArrow "none", 769 stringRep Normal "normal", stringRep Tee "tee", 770 stringRep Vee "vee"] 771 772data ArrowModifier = ArrMod{arrowFill :: ArrowFill, 773 arrowSide :: ArrowSide} 774 deriving (Eq, Ord, Show, Read) 775 776noMods :: ArrowModifier 777noMods = ArrMod FilledArrow BothSides 778 779openMod :: ArrowModifier 780openMod = ArrMod OpenArrow BothSides 781 782instance PrintDot ArrowModifier where 783 unqtDot (ArrMod f s) = unqtDot f <> unqtDot s 784 785instance ParseDot ArrowModifier where 786 parseUnqt 787 = do f <- parseUnqt 788 s <- parseUnqt 789 return $ ArrMod f s 790 791data ArrowFill = OpenArrow 792 | FilledArrow 793 deriving (Eq, Ord, Bounded, Enum, Show, Read) 794 795instance PrintDot ArrowFill where 796 unqtDot OpenArrow = char 'o' 797 unqtDot FilledArrow = empty 798 799instance ParseDot ArrowFill where 800 parseUnqt 801 = liftM (bool FilledArrow OpenArrow . isJust) $ 802 optional (character 'o') 803 parse = parseUnqt 804 805data ArrowSide = LeftSide 806 | RightSide 807 | BothSides 808 deriving (Eq, Ord, Bounded, Enum, Show, Read) 809 810instance PrintDot ArrowSide where 811 unqtDot LeftSide = char 'l' 812 unqtDot RightSide = char 'r' 813 unqtDot BothSides = empty 814 815instance ParseDot ArrowSide where 816 parseUnqt 817 = liftM getSideType $ optional (oneOf $ map character ['l', 'r']) 818 where getSideType 819 = maybe BothSides (bool RightSide LeftSide . (==) 'l') 820 parse = parseUnqt 821 822data AspectType = RatioOnly Double 823 | RatioPassCount Double Int 824 deriving (Eq, Ord, Show, Read) 825 826instance PrintDot AspectType where 827 unqtDot (RatioOnly r) = unqtDot r 828 unqtDot (RatioPassCount r p) = commaDel r p 829 toDot at@RatioOnly{} = unqtDot at 830 toDot at@RatioPassCount{} = doubleQuotes $ unqtDot at 831 832instance ParseDot AspectType where 833 parseUnqt 834 = liftM (uncurry RatioPassCount) commaSepUnqt `onFail` 835 liftM RatioOnly parseUnqt 836 parse 837 = quotedParse (liftM (uncurry RatioPassCount) commaSepUnqt) 838 `onFail` liftM RatioOnly parse 839 840data Rect = Rect Point Point 841 deriving (Eq, Ord, Show, Read) 842 843instance PrintDot Rect where 844 unqtDot (Rect p1 p2) = commaDel p1 p2 845 toDot = doubleQuotes . unqtDot 846 847instance ParseDot Rect where 848 parseUnqt = liftM (uncurry Rect) commaSepUnqt 849 parse = quotedParse parseUnqt 850 851data ClusterMode = Local 852 | Global 853 | NoCluster 854 deriving (Eq, Ord, Bounded, Enum, Show, Read) 855 856instance PrintDot ClusterMode where 857 unqtDot Local = unqtDot "local" 858 unqtDot Global = unqtDot "global" 859 unqtDot NoCluster = unqtDot "none" 860 861instance ParseDot ClusterMode where 862 parseUnqt 863 = oneOf 864 [stringRep Local "local", stringRep Global "global", 865 stringRep NoCluster "none"] 866 867data DirType = Forward 868 | Back 869 | Both 870 | NoDir 871 deriving (Eq, Ord, Bounded, Enum, Show, Read) 872 873instance PrintDot DirType where 874 unqtDot Forward = unqtDot "forward" 875 unqtDot Back = unqtDot "back" 876 unqtDot Both = unqtDot "both" 877 unqtDot NoDir = unqtDot "none" 878 879instance ParseDot DirType where 880 parseUnqt 881 = oneOf 882 [stringRep Forward "forward", stringRep Back "back", 883 stringRep Both "both", stringRep NoDir "none"] 884 885data DEConstraints = EdgeConstraints 886 | NoConstraints 887 | HierConstraints 888 deriving (Eq, Ord, Bounded, Enum, Show, Read) 889 890instance PrintDot DEConstraints where 891 unqtDot EdgeConstraints = unqtDot True 892 unqtDot NoConstraints = unqtDot False 893 unqtDot HierConstraints = text "hier" 894 895instance ParseDot DEConstraints where 896 parseUnqt 897 = liftM (bool NoConstraints EdgeConstraints) parse `onFail` 898 stringRep HierConstraints "hier" 899 900data DPoint = DVal Double 901 | PVal Point 902 deriving (Eq, Ord, Show, Read) 903 904instance PrintDot DPoint where 905 unqtDot (DVal d) = unqtDot d 906 unqtDot (PVal p) = unqtDot p 907 toDot (DVal d) = toDot d 908 toDot (PVal p) = toDot p 909 910instance ParseDot DPoint where 911 parseUnqt = liftM PVal parseUnqt `onFail` liftM DVal parseUnqt 912 parse = liftM PVal parse `onFail` liftM DVal parse 913 914data ModeType = Major 915 | KK 916 | Hier 917 | IpSep 918 deriving (Eq, Ord, Bounded, Enum, Show, Read) 919 920instance PrintDot ModeType where 921 unqtDot Major = text "major" 922 unqtDot KK = text "KK" 923 unqtDot Hier = text "hier" 924 unqtDot IpSep = text "ipsep" 925 926instance ParseDot ModeType where 927 parseUnqt 928 = oneOf 929 [stringRep Major "major", stringRep KK "KK", stringRep Hier "hier", 930 stringRep IpSep "ipsep"] 931 932data Model = ShortPath 933 | SubSet 934 | Circuit 935 deriving (Eq, Ord, Bounded, Enum, Show, Read) 936 937instance PrintDot Model where 938 unqtDot ShortPath = text "shortpath" 939 unqtDot SubSet = text "subset" 940 unqtDot Circuit = text "circuit" 941 942instance ParseDot Model where 943 parseUnqt 944 = oneOf 945 [stringRep ShortPath "shortpath", stringRep SubSet "subset", 946 stringRep Circuit "circuit"] 947 948data Label = StrLabel EscString 949 | URLLabel URL 950 deriving (Eq, Ord, Show, Read) 951 952instance PrintDot Label where 953 unqtDot (StrLabel s) = unqtDot s 954 unqtDot (URLLabel u) = unqtDot u 955 toDot (StrLabel s) = toDot s 956 toDot (URLLabel u) = toDot u 957 958instance ParseDot Label where 959 parseUnqt 960 = liftM StrLabel parseUnqt `onFail` liftM URLLabel parseUnqt 961 parse = liftM StrLabel parse `onFail` liftM URLLabel parse 962 963data Point = Point Int Int 964 | PointD Double Double 965 deriving (Eq, Ord, Show, Read) 966 967instance PrintDot Point where 968 unqtDot (Point x y) = commaDel x y 969 unqtDot (PointD x y) = commaDel x y 970 toDot = doubleQuotes . unqtDot 971 unqtListToDot = hsep . map unqtDot 972 listToDot = doubleQuotes . unqtListToDot 973 974instance ParseDot Point where 975 parseUnqt 976 = intDblPoint `onFail` liftM (uncurry Point) commaSepUnqt `onFail` 977 liftM (uncurry PointD) commaSepUnqt 978 where intDblPoint 979 = liftM (uncurry PointD . first fI) $ 980 commaSep' parseUnqt parseStrictFloat 981 982 fI :: Int -> Double 983 fI = fromIntegral 984 parse = quotedParse parseUnqt 985 parseUnqtList = sepBy1 parseUnqt whitespace 986 987data Overlap = KeepOverlaps 988 | RemoveOverlaps 989 | ScaleOverlaps 990 | ScaleXYOverlaps 991 | PrismOverlap (Maybe Int) 992 | CompressOverlap 993 | VpscOverlap 994 | IpsepOverlap 995 deriving (Eq, Ord, Show, Read) 996 997instance PrintDot Overlap where 998 unqtDot KeepOverlaps = unqtDot True 999 unqtDot RemoveOverlaps = unqtDot False 1000 unqtDot ScaleOverlaps = text "scale" 1001 unqtDot ScaleXYOverlaps = text "scalexy" 1002 unqtDot (PrismOverlap i) 1003 = maybe id (flip (<>) . unqtDot) i $ text "prism" 1004 unqtDot CompressOverlap = text "compress" 1005 unqtDot VpscOverlap = text "vpsc" 1006 unqtDot IpsepOverlap = text "ipsep" 1007 1008instance ParseDot Overlap where 1009 parseUnqt 1010 = oneOf 1011 [stringRep KeepOverlaps "true", stringRep RemoveOverlaps "false", 1012 stringRep ScaleXYOverlaps "scalexy", 1013 stringRep ScaleOverlaps "scale", 1014 string "prism" >> liftM PrismOverlap (optional parse), 1015 stringRep CompressOverlap "compress", stringRep VpscOverlap "vpsc", 1016 stringRep IpsepOverlap "ipsep"] 1017 1018data LayerRange = LRID LayerID 1019 | LRS LayerID String LayerID 1020 deriving (Eq, Ord, Show, Read) 1021 1022instance PrintDot LayerRange where 1023 unqtDot (LRID lid) = unqtDot lid 1024 unqtDot (LRS id1 s id2) = unqtDot id1 <> unqtDot s <> unqtDot id2 1025 toDot (LRID lid) = toDot lid 1026 toDot lrs = doubleQuotes $ unqtDot lrs 1027 1028instance ParseDot LayerRange where 1029 parseUnqt 1030 = do id1 <- parseUnqt 1031 s <- parseLayerSep 1032 id2 <- parseUnqt 1033 return $ LRS id1 s id2 1034 `onFail` liftM LRID parseUnqt 1035 parse 1036 = quotedParse 1037 (do id1 <- parseUnqt 1038 s <- parseLayerSep 1039 id2 <- parseUnqt 1040 return $ LRS id1 s id2) 1041 `onFail` liftM LRID parse 1042 1043parseLayerSep :: Parse String 1044parseLayerSep = many1 . oneOf $ map character defLayerSep 1045 1046defLayerSep :: [Char] 1047defLayerSep = [' ', ':', '\t'] 1048 1049parseLayerName :: Parse String 1050parseLayerName 1051 = many1 . orQuote $ 1052 satisfy (liftM2 (&&) notLayerSep ((/=) quoteChar)) 1053 1054parseLayerName' :: Parse String 1055parseLayerName' = stringBlock `onFail` quotedParse parseLayerName 1056 1057notLayerSep :: Char -> Bool 1058notLayerSep = flip notElem defLayerSep 1059 1060data LayerID = AllLayers 1061 | LRInt Int 1062 | LRName String 1063 deriving (Eq, Ord, Show, Read) 1064 1065instance PrintDot LayerID where 1066 unqtDot AllLayers = text "all" 1067 unqtDot (LRInt n) = unqtDot n 1068 unqtDot (LRName nm) = unqtDot nm 1069 toDot (LRName nm) = toDot nm 1070 toDot li = unqtDot li 1071 1072instance ParseDot LayerID where 1073 parseUnqt = liftM checkLayerName parseLayerName 1074 parse 1075 = oneOf [liftM checkLayerName parseLayerName', liftM LRInt parse] 1076 1077checkLayerName :: String -> LayerID 1078checkLayerName str = maybe checkAll LRInt $ stringToInt str 1079 where checkAll 1080 = if map toLower str == "all" then AllLayers else LRName str 1081 1082data LayerList = LL String [(String, String)] 1083 deriving (Eq, Ord, Show, Read) 1084 1085instance PrintDot LayerList where 1086 unqtDot (LL l1 ols) = unqtDot l1 <> hcat (map subLL ols) 1087 where subLL (s, l) = unqtDot s <> unqtDot l 1088 toDot (LL l1 []) = toDot l1 1089 toDot ll = doubleQuotes $ unqtDot ll 1090 1091instance ParseDot LayerList where 1092 parseUnqt 1093 = do l1 <- parseLayerName 1094 ols <- many $ 1095 do s <- parseLayerSep 1096 lnm <- parseLayerName 1097 return (s, lnm) 1098 return $ LL l1 ols 1099 parse 1100 = quotedParse parseUnqt `onFail` 1101 liftM (flip LL []) (parseLayerName' `onFail` numString) 1102 1103data OutputMode = BreadthFirst 1104 | NodesFirst 1105 | EdgesFirst 1106 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1107 1108instance PrintDot OutputMode where 1109 unqtDot BreadthFirst = text "breadthfirst" 1110 unqtDot NodesFirst = text "nodesfirst" 1111 unqtDot EdgesFirst = text "edgesfirst" 1112 1113instance ParseDot OutputMode where 1114 parseUnqt 1115 = oneOf 1116 [stringRep BreadthFirst "breadthfirst", 1117 stringRep NodesFirst "nodesfirst", 1118 stringRep EdgesFirst "edgesfirst"] 1119 1120data Pack = DoPack 1121 | DontPack 1122 | PackMargin Int 1123 deriving (Eq, Ord, Show, Read) 1124 1125instance PrintDot Pack where 1126 unqtDot DoPack = unqtDot True 1127 unqtDot DontPack = unqtDot False 1128 unqtDot (PackMargin m) = unqtDot m 1129 1130instance ParseDot Pack where 1131 parseUnqt 1132 = oneOf 1133 [liftM PackMargin parseUnqt, liftM (bool DontPack DoPack) onlyBool] 1134 1135data PackMode = PackNode 1136 | PackClust 1137 | PackGraph 1138 | PackArray Bool Bool (Maybe Int) 1139 deriving (Eq, Ord, Show, Read) 1140 1141instance PrintDot PackMode where 1142 unqtDot PackNode = text "node" 1143 unqtDot PackClust = text "clust" 1144 unqtDot PackGraph = text "graph" 1145 unqtDot (PackArray c u mi) 1146 = addNum . isU . isC . isUnder $ text "array" 1147 where addNum = maybe id (flip (<>) . unqtDot) mi 1148 isUnder = if c || u then flip (<>) $ char '_' else id 1149 isC = if c then flip (<>) $ char 'c' else id 1150 isU = if u then flip (<>) $ char 'u' else id 1151 1152instance ParseDot PackMode where 1153 parseUnqt 1154 = oneOf 1155 [stringRep PackNode "node", stringRep PackClust "clust", 1156 stringRep PackGraph "graph", 1157 do string "array" 1158 mcu <- optional $ 1159 do character '_' 1160 many1 $ satisfy isCU 1161 let c = hasCharacter mcu 'c' 1162 u = hasCharacter mcu 'u' 1163 mi <- optional parseUnqt 1164 return $ PackArray c u mi] 1165 where hasCharacter ms c = maybe False (elem c) ms 1166 isCU = flip elem ['c', 'u'] 1167 1168data Pos = PointPos Point 1169 | SplinePos [Spline] 1170 deriving (Eq, Ord, Show, Read) 1171 1172instance PrintDot Pos where 1173 unqtDot (PointPos p) = unqtDot p 1174 unqtDot (SplinePos ss) = unqtDot ss 1175 toDot (PointPos p) = toDot p 1176 toDot (SplinePos ss) = toDot ss 1177 1178instance ParseDot Pos where 1179 parseUnqt 1180 = do splns <- parseUnqt 1181 case splns of 1182 [Spline Nothing Nothing [p]] -> return $ PointPos p 1183 _ -> return $ SplinePos splns 1184 parse = quotedParse parseUnqt 1185 1186data EdgeType = SplineEdges 1187 | LineEdges 1188 | NoEdges 1189 | PolyLine 1190 | CompoundEdge 1191 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1192 1193instance PrintDot EdgeType where 1194 unqtDot SplineEdges = toDot True 1195 unqtDot LineEdges = toDot False 1196 unqtDot NoEdges = empty 1197 unqtDot PolyLine = text "polyline" 1198 unqtDot CompoundEdge = text "compound" 1199 toDot NoEdges = doubleQuotes empty 1200 toDot et = unqtDot et 1201 1202instance ParseDot EdgeType where 1203 parseUnqt 1204 = oneOf 1205 [liftM (bool LineEdges SplineEdges) parse, 1206 stringRep SplineEdges "spline", stringRep LineEdges "line", 1207 stringRep PolyLine "polyline", stringRep CompoundEdge "compound"] 1208 parse = stringRep NoEdges "\"\"" `onFail` optionalQuoted parseUnqt 1209 1210data PageDir = Bl 1211 | Br 1212 | Tl 1213 | Tr 1214 | Rb 1215 | Rt 1216 | Lb 1217 | Lt 1218 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1219 1220instance PrintDot PageDir where 1221 unqtDot Bl = text "BL" 1222 unqtDot Br = text "BR" 1223 unqtDot Tl = text "TL" 1224 unqtDot Tr = text "TR" 1225 unqtDot Rb = text "RB" 1226 unqtDot Rt = text "RT" 1227 unqtDot Lb = text "LB" 1228 unqtDot Lt = text "LT" 1229 1230instance ParseDot PageDir where 1231 parseUnqt 1232 = oneOf 1233 [stringRep Bl "BL", stringRep Br "BR", stringRep Tl "TL", 1234 stringRep Tr "TR", stringRep Rb "RB", stringRep Rt "RT", 1235 stringRep Lb "LB", stringRep Lt "LT"] 1236 1237data Spline = Spline (Maybe Point) (Maybe Point) [Point] 1238 deriving (Eq, Ord, Show, Read) 1239 1240instance PrintDot Spline where 1241 unqtDot (Spline ms me ps) = addS . addE . hsep $ map unqtDot ps 1242 where addP t = maybe id ((<+>) . commaDel t) 1243 addS = addP 's' ms 1244 addE = addP 'e' me 1245 toDot = doubleQuotes . unqtDot 1246 unqtListToDot = hcat . punctuate semi . map unqtDot 1247 listToDot = doubleQuotes . unqtListToDot 1248 1249instance ParseDot Spline where 1250 parseUnqt 1251 = do ms <- parseP 's' 1252 me <- parseP 'e' 1253 ps <- sepBy1 parseUnqt whitespace 1254 return $ Spline ms me ps 1255 where parseP t 1256 = optional $ 1257 do character t 1258 parseComma 1259 parseUnqt `discard` whitespace 1260 parse = quotedParse parseUnqt 1261 parseUnqtList = sepBy1 parseUnqt (character ';') 1262 1263data QuadType = NormalQT 1264 | FastQT 1265 | NoQT 1266 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1267 1268instance PrintDot QuadType where 1269 unqtDot NormalQT = text "normal" 1270 unqtDot FastQT = text "fast" 1271 unqtDot NoQT = text "none" 1272 1273instance ParseDot QuadType where 1274 parseUnqt 1275 = oneOf 1276 [stringRep NormalQT "normal", stringRep FastQT "fast", 1277 stringRep NoQT "none", character '2' >> return FastQT, 1278 liftM (bool NoQT NormalQT) parse] 1279 1280data Root = IsCentral 1281 | NotCentral 1282 | NodeName String 1283 deriving (Eq, Ord, Show, Read) 1284 1285instance PrintDot Root where 1286 unqtDot IsCentral = unqtDot True 1287 unqtDot NotCentral = unqtDot False 1288 unqtDot (NodeName n) = unqtDot n 1289 toDot (NodeName n) = toDot n 1290 toDot r = unqtDot r 1291 1292instance ParseDot Root where 1293 parseUnqt 1294 = liftM (bool NotCentral IsCentral) onlyBool `onFail` 1295 liftM NodeName parseUnqt 1296 parse 1297 = optionalQuoted (liftM (bool NotCentral IsCentral) onlyBool) 1298 `onFail` liftM NodeName parse 1299 1300data RankType = SameRank 1301 | MinRank 1302 | SourceRank 1303 | MaxRank 1304 | SinkRank 1305 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1306 1307instance PrintDot RankType where 1308 unqtDot SameRank = text "same" 1309 unqtDot MinRank = text "min" 1310 unqtDot SourceRank = text "source" 1311 unqtDot MaxRank = text "max" 1312 unqtDot SinkRank = text "sink" 1313 1314instance ParseDot RankType where 1315 parseUnqt 1316 = oneOf 1317 [stringRep SameRank "same", stringRep MinRank "min", 1318 stringRep SourceRank "source", stringRep MaxRank "max", 1319 stringRep SinkRank "sink"] 1320 1321data RankDir = FromTop 1322 | FromLeft 1323 | FromBottom 1324 | FromRight 1325 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1326 1327instance PrintDot RankDir where 1328 unqtDot FromTop = text "TB" 1329 unqtDot FromLeft = text "LR" 1330 unqtDot FromBottom = text "BT" 1331 unqtDot FromRight = text "RL" 1332 1333instance ParseDot RankDir where 1334 parseUnqt 1335 = oneOf 1336 [stringRep FromTop "TB", stringRep FromLeft "LR", 1337 stringRep FromBottom "BT", stringRep FromRight "RL"] 1338 1339data Shape = BoxShape 1340 | Polygon 1341 | Ellipse 1342 | Circle 1343 | PointShape 1344 | Egg 1345 | Triangle 1346 | PlainText 1347 | DiamondShape 1348 | Trapezium 1349 | Parallelogram 1350 | House 1351 | Pentagon 1352 | Hexagon 1353 | Septagon 1354 | Octagon 1355 | DoubleCircle 1356 | DoubleOctagon 1357 | TripleOctagon 1358 | InvTriangle 1359 | InvTrapezium 1360 | InvHouse 1361 | MDiamond 1362 | MSquare 1363 | MCircle 1364 | Note 1365 | Tab 1366 | Folder 1367 | Box3D 1368 | Component 1369 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1370 1371instance PrintDot Shape where 1372 unqtDot BoxShape = text "box" 1373 unqtDot Polygon = text "polygon" 1374 unqtDot Ellipse = text "ellipse" 1375 unqtDot Circle = text "circle" 1376 unqtDot PointShape = text "point" 1377 unqtDot Egg = text "egg" 1378 unqtDot Triangle = text "triangle" 1379 unqtDot PlainText = text "plaintext" 1380 unqtDot DiamondShape = text "diamond" 1381 unqtDot Trapezium = text "trapezium" 1382 unqtDot Parallelogram = text "parallelogram" 1383 unqtDot House = text "house" 1384 unqtDot Pentagon = text "pentagon" 1385 unqtDot Hexagon = text "hexagon" 1386 unqtDot Septagon = text "septagon" 1387 unqtDot Octagon = text "octagon" 1388 unqtDot DoubleCircle = text "doublecircle" 1389 unqtDot DoubleOctagon = text "doubleoctagon" 1390 unqtDot TripleOctagon = text "tripleoctagon" 1391 unqtDot InvTriangle = text "invtriangle" 1392 unqtDot InvTrapezium = text "invtrapezium" 1393 unqtDot InvHouse = text "invhouse" 1394 unqtDot MDiamond = text "Mdiamond" 1395 unqtDot MSquare = text "Msquare" 1396 unqtDot MCircle = text "Mcircle" 1397 unqtDot Note = text "note" 1398 unqtDot Tab = text "tab" 1399 unqtDot Folder = text "folder" 1400 unqtDot Box3D = text "box3d" 1401 unqtDot Component = text "component" 1402 1403instance ParseDot Shape where 1404 parseUnqt 1405 = oneOf 1406 [stringRep Box3D "box3d", 1407 stringReps BoxShape ["box", "rectangle", "rect"], 1408 stringRep Polygon "polygon", stringRep Ellipse "ellipse", 1409 stringRep Circle "circle", stringRep PointShape "point", 1410 stringRep Egg "egg", stringRep Triangle "triangle", 1411 stringReps PlainText ["plaintext", "none"], 1412 stringRep DiamondShape "diamond", stringRep Trapezium "trapezium", 1413 stringRep Parallelogram "parallelogram", stringRep House "house", 1414 stringRep Pentagon "pentagon", stringRep Hexagon "hexagon", 1415 stringRep Septagon "septagon", stringRep Octagon "octagon", 1416 stringRep DoubleCircle "doublecircle", 1417 stringRep DoubleOctagon "doubleoctagon", 1418 stringRep TripleOctagon "tripleoctagon", 1419 stringRep InvTriangle "invtriangle", 1420 stringRep InvTrapezium "invtrapezium", 1421 stringRep InvHouse "invhouse", stringRep MDiamond "Mdiamond", 1422 stringRep MSquare "Msquare", stringRep MCircle "Mcircle", 1423 stringRep Note "note", stringRep Tab "tab", 1424 stringRep Folder "folder", stringRep Component "component"] 1425 1426data SmoothType = NoSmooth 1427 | AvgDist 1428 | GraphDist 1429 | PowerDist 1430 | RNG 1431 | Spring 1432 | TriangleSmooth 1433 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1434 1435instance PrintDot SmoothType where 1436 unqtDot NoSmooth = text "none" 1437 unqtDot AvgDist = text "avg_dist" 1438 unqtDot GraphDist = text "graph_dist" 1439 unqtDot PowerDist = text "power_dist" 1440 unqtDot RNG = text "rng" 1441 unqtDot Spring = text "spring" 1442 unqtDot TriangleSmooth = text "triangle" 1443 1444instance ParseDot SmoothType where 1445 parseUnqt 1446 = oneOf 1447 [stringRep NoSmooth "none", stringRep AvgDist "avg_dist", 1448 stringRep GraphDist "graph_dist", stringRep PowerDist "power_dist", 1449 stringRep RNG "rng", stringRep Spring "spring", 1450 stringRep TriangleSmooth "triangle"] 1451 1452data StartType = StartStyle STStyle 1453 | StartSeed Int 1454 | StartStyleSeed STStyle Int 1455 deriving (Eq, Ord, Show, Read) 1456 1457instance PrintDot StartType where 1458 unqtDot (StartStyle ss) = unqtDot ss 1459 unqtDot (StartSeed s) = unqtDot s 1460 unqtDot (StartStyleSeed ss s) = unqtDot ss <> unqtDot s 1461 1462instance ParseDot StartType where 1463 parseUnqt 1464 = oneOf 1465 [do ss <- parseUnqt 1466 s <- parseUnqt 1467 return $ StartStyleSeed ss s, 1468 liftM StartStyle parseUnqt, liftM StartSeed parseUnqt] 1469 1470data STStyle = RegularStyle 1471 | SelfStyle 1472 | RandomStyle 1473 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1474 1475instance PrintDot STStyle where 1476 unqtDot RegularStyle = text "regular" 1477 unqtDot SelfStyle = text "self" 1478 unqtDot RandomStyle = text "random" 1479 1480instance ParseDot STStyle where 1481 parseUnqt 1482 = oneOf 1483 [stringRep RegularStyle "regular", stringRep SelfStyle "self", 1484 stringRep RandomStyle "random"] 1485 1486data StyleItem = SItem StyleName [String] 1487 deriving (Eq, Ord, Show, Read) 1488 1489instance PrintDot StyleItem where 1490 unqtDot (SItem nm args) 1491 | null args = dnm 1492 | otherwise = dnm <> parens args' 1493 where dnm = unqtDot nm 1494 args' = hcat . punctuate comma $ map unqtDot args 1495 toDot si@(SItem nm args) 1496 | null args = toDot nm 1497 | otherwise = doubleQuotes $ unqtDot si 1498 unqtListToDot = hcat . punctuate comma . map unqtDot 1499 listToDot [SItem nm []] = toDot nm 1500 listToDot sis = doubleQuotes $ unqtListToDot sis 1501 1502instance ParseDot StyleItem where 1503 parseUnqt 1504 = do nm <- parseUnqt 1505 args <- tryParseList' parseArgs 1506 return $ SItem nm args 1507 parse 1508 = quotedParse (liftM2 SItem parseUnqt parseArgs) `onFail` 1509 liftM (flip SItem []) parse 1510 parseUnqtList = sepBy1 parseUnqt parseComma 1511 parseList = quotedParse parseUnqtList `onFail` liftM return parse 1512 1513parseArgs :: Parse [String] 1514parseArgs 1515 = bracketSep (character '(') parseComma (character ')') 1516 parseStyleName 1517 1518data StyleName = Dashed 1519 | Dotted 1520 | Solid 1521 | Bold 1522 | Invisible 1523 | Filled 1524 | Diagonals 1525 | Rounded 1526 | DD String 1527 deriving (Eq, Ord, Show, Read) 1528 1529instance PrintDot StyleName where 1530 unqtDot Dashed = text "dashed" 1531 unqtDot Dotted = text "dotted" 1532 unqtDot Solid = text "solid" 1533 unqtDot Bold = text "bold" 1534 unqtDot Invisible = text "invis" 1535 unqtDot Filled = text "filled" 1536 unqtDot Diagonals = text "diagonals" 1537 unqtDot Rounded = text "rounded" 1538 unqtDot (DD nm) = unqtDot nm 1539 toDot (DD nm) = toDot nm 1540 toDot sn = unqtDot sn 1541 1542instance ParseDot StyleName where 1543 parseUnqt = liftM checkDD parseStyleName 1544 parse 1545 = liftM checkDD $ 1546 quotedParse parseStyleName `onFail` 1547 do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' ', ']'] 1548 r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',', ']']) 1549 return $ f : r 1550 1551checkDD :: String -> StyleName 1552checkDD str 1553 = case map toLower str of 1554 "dashed" -> Dashed 1555 "dotted" -> Dotted 1556 "solid" -> Solid 1557 "bold" -> Bold 1558 "invis" -> Invisible 1559 "filled" -> Filled 1560 "diagonals" -> Diagonals 1561 "rounded" -> Rounded 1562 _ -> DD str 1563 1564parseStyleName :: Parse String 1565parseStyleName 1566 = do f <- orQuote $ noneOf [quoteChar, '(', ')', ',', ' '] 1567 r <- many (orQuote $ noneOf [quoteChar, '(', ')', ',']) 1568 return $ f : r 1569 1570newtype PortPos = PP CompassPoint 1571 deriving (Eq, Ord, Show, Read) 1572 1573instance PrintDot PortPos where 1574 unqtDot (PP cp) = unqtDot cp 1575 toDot (PP cp) = toDot cp 1576 1577instance ParseDot PortPos where 1578 parseUnqt = liftM PP parseUnqt 1579 1580data CompassPoint = North 1581 | NorthEast 1582 | East 1583 | SouthEast 1584 | South 1585 | SouthWest 1586 | West 1587 | NorthWest 1588 | CenterPoint 1589 | NoCP 1590 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1591 1592instance PrintDot CompassPoint where 1593 unqtDot NorthEast = text "ne" 1594 unqtDot NorthWest = text "nw" 1595 unqtDot North = text "n" 1596 unqtDot East = text "e" 1597 unqtDot SouthEast = text "se" 1598 unqtDot SouthWest = text "sw" 1599 unqtDot South = text "s" 1600 unqtDot West = text "w" 1601 unqtDot CenterPoint = text "c" 1602 unqtDot NoCP = text "_" 1603 1604instance ParseDot CompassPoint where 1605 parseUnqt 1606 = oneOf 1607 [stringRep NorthEast "ne", stringRep NorthWest "nw", 1608 stringRep North "n", stringRep SouthEast "se", 1609 stringRep SouthWest "sw", stringRep South "s", stringRep East "e", 1610 stringRep West "w", stringRep CenterPoint "c", stringRep NoCP "_"] 1611 1612data ViewPort = VP{wVal :: Double, hVal :: Double, zVal :: Double, 1613 focus :: Maybe FocusType} 1614 deriving (Eq, Ord, Show, Read) 1615 1616instance PrintDot ViewPort where 1617 unqtDot vp = maybe vs ((<>) (vs <> comma) . unqtDot) $ focus vp 1618 where vs 1619 = hcat . punctuate comma $ 1620 map (unqtDot . flip ($) vp) [wVal, hVal, zVal] 1621 toDot = doubleQuotes . unqtDot 1622 1623instance ParseDot ViewPort where 1624 parseUnqt 1625 = do wv <- parseUnqt 1626 parseComma 1627 hv <- parseUnqt 1628 parseComma 1629 zv <- parseUnqt 1630 mf <- optional $ parseComma >> parseUnqt 1631 return $ VP wv hv zv mf 1632 parse = quotedParse parseUnqt 1633 1634data FocusType = XY Point 1635 | NodeFocus String 1636 deriving (Eq, Ord, Show, Read) 1637 1638instance PrintDot FocusType where 1639 unqtDot (XY p) = unqtDot p 1640 unqtDot (NodeFocus nm) = unqtDot nm 1641 toDot (XY p) = toDot p 1642 toDot (NodeFocus nm) = toDot nm 1643 1644instance ParseDot FocusType where 1645 parseUnqt = liftM XY parseUnqt `onFail` liftM NodeFocus parseUnqt 1646 parse = liftM XY parse `onFail` liftM NodeFocus parse 1647 1648data VerticalPlacement = VTop 1649 | VCenter 1650 | VBottom 1651 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1652 1653instance PrintDot VerticalPlacement where 1654 unqtDot VTop = char 't' 1655 unqtDot VCenter = char 'c' 1656 unqtDot VBottom = char 'b' 1657 1658instance ParseDot VerticalPlacement where 1659 parseUnqt 1660 = oneOf 1661 [stringRep VTop "t", stringRep VCenter "c", stringRep VBottom "b"] 1662 1663data ScaleType = UniformScale 1664 | NoScale 1665 | FillWidth 1666 | FillHeight 1667 | FillBoth 1668 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1669 1670instance PrintDot ScaleType where 1671 unqtDot UniformScale = unqtDot True 1672 unqtDot NoScale = unqtDot False 1673 unqtDot FillWidth = text "width" 1674 unqtDot FillHeight = text "height" 1675 unqtDot FillBoth = text "both" 1676 1677instance ParseDot ScaleType where 1678 parseUnqt 1679 = oneOf 1680 [stringRep UniformScale "true", stringRep NoScale "false", 1681 stringRep FillWidth "width", stringRep FillHeight "height", 1682 stringRep FillBoth "both"] 1683 1684data Justification = JLeft 1685 | JRight 1686 | JCenter 1687 deriving (Eq, Ord, Bounded, Enum, Show, Read) 1688 1689instance PrintDot Justification where 1690 unqtDot JLeft = char 'l' 1691 unqtDot JRight = char 'r' 1692 unqtDot JCenter = char 'c' 1693 1694instance ParseDot Justification where 1695 parseUnqt 1696 = oneOf 1697 [stringRep JLeft "l", stringRep JRight "r", stringRep JCenter "c"] 1698 1699data Ratios = AspectRatio Double 1700 | FillRatio 1701 | CompressRatio 1702 | ExpandRatio 1703 | AutoRatio 1704 deriving (Eq, Ord, Show, Read) 1705 1706instance PrintDot Ratios where 1707 unqtDot (AspectRatio r) = unqtDot r 1708 unqtDot FillRatio = text "fill" 1709 unqtDot CompressRatio = text "compress" 1710 unqtDot ExpandRatio = text "expand" 1711 unqtDot AutoRatio = text "auto" 1712 1713instance ParseDot Ratios where 1714 parseUnqt 1715 = oneOf 1716 [liftM AspectRatio parseUnqt, stringRep FillRatio "fill", 1717 stringRep CompressRatio "compress", stringRep ExpandRatio "expand", 1718 stringRep AutoRatio "auto"] 1719