{-# LANGUAGE CPP, OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide #-}
{- |
   Module      : Data.GraphViz.Attributes.Values
   Description : Values for use with the Attribute data type
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   Defined to have smaller modules and thus faster compilation times.

 -}
module Data.GraphViz.Attributes.Values where

import qualified Data.GraphViz.Attributes.HTML     as Html
import           Data.GraphViz.Attributes.Internal
import           Data.GraphViz.Internal.State      (getLayerListSep,
                                                    getLayerSep,
                                                    setLayerListSep,
                                                    setLayerSep)
import           Data.GraphViz.Internal.Util       (bool, stringToInt)
import           Data.GraphViz.Parsing
import           Data.GraphViz.Printing

import           Data.List       (intercalate)
import           Data.Maybe      (isJust)
import           Data.Text.Lazy  (Text)
import qualified Data.Text.Lazy  as T
import           Data.Word       (Word16)
import           System.FilePath (searchPathSeparator, splitSearchPath)

#if !MIN_VERSION_base (4,13,0)
import Data.Monoid ((<>))
#endif

-- -----------------------------------------------------------------------------

{- |

   Some 'Attribute's (mainly label-like ones) take a 'String' argument
   that allows for extra escape codes.  This library doesn't do any
   extra checks or special parsing for these escape codes, but usage
   of 'EscString' rather than 'Text' indicates that the Graphviz
   tools will recognise these extra escape codes for these
   'Attribute's.

   The extra escape codes include (note that these are all Strings):

     [@\\N@] Replace with the name of the node (for Node 'Attribute's).

     [@\\G@] Replace with the name of the graph (for Node 'Attribute's)
             or the name of the graph or cluster, whichever is
             applicable (for Graph, Cluster and Edge 'Attribute's).

     [@\\E@] Replace with the name of the edge, formed by the two
             adjoining nodes and the edge type (for Edge 'Attribute's).

     [@\\T@] Replace with the name of the tail node (for Edge
             'Attribute's).

     [@\\H@] Replace with the name of the head node (for Edge
             'Attribute's).

     [@\\L@] Replace with the object's label (for all 'Attribute's).

   Also, if the 'Attribute' in question is 'Label', 'HeadLabel' or
   'TailLabel', then @\\n@, @\\l@ and @\\r@ split the label into lines
   centered, left-justified and right-justified respectively.

 -}
type EscString = Text

-- -----------------------------------------------------------------------------

-- | Should only have 2D points (i.e. created with 'createPoint').
data Rect = Rect Point Point
            deriving (Rect -> Rect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c== :: Rect -> Rect -> Bool
Eq, Eq Rect
Rect -> Rect -> Bool
Rect -> Rect -> Ordering
Rect -> Rect -> Rect
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Rect -> Rect -> Rect
$cmin :: Rect -> Rect -> Rect
max :: Rect -> Rect -> Rect
$cmax :: Rect -> Rect -> Rect
>= :: Rect -> Rect -> Bool
$c>= :: Rect -> Rect -> Bool
> :: Rect -> Rect -> Bool
$c> :: Rect -> Rect -> Bool
<= :: Rect -> Rect -> Bool
$c<= :: Rect -> Rect -> Bool
< :: Rect -> Rect -> Bool
$c< :: Rect -> Rect -> Bool
compare :: Rect -> Rect -> Ordering
$ccompare :: Rect -> Rect -> Ordering
Ord, Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect] -> ShowS
$cshowList :: [Rect] -> ShowS
show :: Rect -> String
$cshow :: Rect -> String
showsPrec :: Int -> Rect -> ShowS
$cshowsPrec :: Int -> Rect -> ShowS
Show, ReadPrec [Rect]
ReadPrec Rect
Int -> ReadS Rect
ReadS [Rect]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rect]
$creadListPrec :: ReadPrec [Rect]
readPrec :: ReadPrec Rect
$creadPrec :: ReadPrec Rect
readList :: ReadS [Rect]
$creadList :: ReadS [Rect]
readsPrec :: Int -> ReadS Rect
$creadsPrec :: Int -> ReadS Rect
Read)

instance PrintDot Rect where
  unqtDot :: Rect -> DotCode
unqtDot (Rect Point
p1 Point
p2) = Point -> DotCode
printPoint2DUnqt Point
p1 forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
comma forall a. Semigroup a => a -> a -> a
<> Point -> DotCode
printPoint2DUnqt Point
p2

  toDot :: Rect -> DotCode
toDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot

  unqtListToDot :: [Rect] -> DotCode
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot

instance ParseDot Rect where
  parseUnqt :: Parse Rect
parseUnqt = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Point -> Point -> Rect
Rect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Parse a -> Parse b -> Parse (a, b)
commaSep' Parse Point
parsePoint2D Parse Point
parsePoint2D

  parse :: Parse Rect
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse [Rect]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt Parse ()
whitespace1

-- -----------------------------------------------------------------------------

-- | If 'Local', then sub-graphs that are clusters are given special
--   treatment.  'Global' and 'NoCluster' currently appear to be
--   identical and turn off the special cluster processing.
data ClusterMode = Local
                 | Global
                 | NoCluster
                 deriving (ClusterMode -> ClusterMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterMode -> ClusterMode -> Bool
$c/= :: ClusterMode -> ClusterMode -> Bool
== :: ClusterMode -> ClusterMode -> Bool
$c== :: ClusterMode -> ClusterMode -> Bool
Eq, Eq ClusterMode
ClusterMode -> ClusterMode -> Bool
ClusterMode -> ClusterMode -> Ordering
ClusterMode -> ClusterMode -> ClusterMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClusterMode -> ClusterMode -> ClusterMode
$cmin :: ClusterMode -> ClusterMode -> ClusterMode
max :: ClusterMode -> ClusterMode -> ClusterMode
$cmax :: ClusterMode -> ClusterMode -> ClusterMode
>= :: ClusterMode -> ClusterMode -> Bool
$c>= :: ClusterMode -> ClusterMode -> Bool
> :: ClusterMode -> ClusterMode -> Bool
$c> :: ClusterMode -> ClusterMode -> Bool
<= :: ClusterMode -> ClusterMode -> Bool
$c<= :: ClusterMode -> ClusterMode -> Bool
< :: ClusterMode -> ClusterMode -> Bool
$c< :: ClusterMode -> ClusterMode -> Bool
compare :: ClusterMode -> ClusterMode -> Ordering
$ccompare :: ClusterMode -> ClusterMode -> Ordering
Ord, ClusterMode
forall a. a -> a -> Bounded a
maxBound :: ClusterMode
$cmaxBound :: ClusterMode
minBound :: ClusterMode
$cminBound :: ClusterMode
Bounded, Int -> ClusterMode
ClusterMode -> Int
ClusterMode -> [ClusterMode]
ClusterMode -> ClusterMode
ClusterMode -> ClusterMode -> [ClusterMode]
ClusterMode -> ClusterMode -> ClusterMode -> [ClusterMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClusterMode -> ClusterMode -> ClusterMode -> [ClusterMode]
$cenumFromThenTo :: ClusterMode -> ClusterMode -> ClusterMode -> [ClusterMode]
enumFromTo :: ClusterMode -> ClusterMode -> [ClusterMode]
$cenumFromTo :: ClusterMode -> ClusterMode -> [ClusterMode]
enumFromThen :: ClusterMode -> ClusterMode -> [ClusterMode]
$cenumFromThen :: ClusterMode -> ClusterMode -> [ClusterMode]
enumFrom :: ClusterMode -> [ClusterMode]
$cenumFrom :: ClusterMode -> [ClusterMode]
fromEnum :: ClusterMode -> Int
$cfromEnum :: ClusterMode -> Int
toEnum :: Int -> ClusterMode
$ctoEnum :: Int -> ClusterMode
pred :: ClusterMode -> ClusterMode
$cpred :: ClusterMode -> ClusterMode
succ :: ClusterMode -> ClusterMode
$csucc :: ClusterMode -> ClusterMode
Enum, Int -> ClusterMode -> ShowS
[ClusterMode] -> ShowS
ClusterMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterMode] -> ShowS
$cshowList :: [ClusterMode] -> ShowS
show :: ClusterMode -> String
$cshow :: ClusterMode -> String
showsPrec :: Int -> ClusterMode -> ShowS
$cshowsPrec :: Int -> ClusterMode -> ShowS
Show, ReadPrec [ClusterMode]
ReadPrec ClusterMode
Int -> ReadS ClusterMode
ReadS [ClusterMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterMode]
$creadListPrec :: ReadPrec [ClusterMode]
readPrec :: ReadPrec ClusterMode
$creadPrec :: ReadPrec ClusterMode
readList :: ReadS [ClusterMode]
$creadList :: ReadS [ClusterMode]
readsPrec :: Int -> ReadS ClusterMode
$creadsPrec :: Int -> ReadS ClusterMode
Read)

instance PrintDot ClusterMode where
  unqtDot :: ClusterMode -> DotCode
unqtDot ClusterMode
Local     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"local"
  unqtDot ClusterMode
Global    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"global"
  unqtDot ClusterMode
NoCluster = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"none"

instance ParseDot ClusterMode where
  parseUnqt :: Parse ClusterMode
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep ClusterMode
Local String
"local"
                    , forall a. a -> String -> Parse a
stringRep ClusterMode
Global String
"global"
                    , forall a. a -> String -> Parse a
stringRep ClusterMode
NoCluster String
"none"
                    ]

-- -----------------------------------------------------------------------------

-- | Specify where to place arrow heads on an edge.
data DirType = Forward -- ^ Draw a directed edge with an arrow to the
                       --   node it's pointing go.
             | Back    -- ^ Draw a reverse directed edge with an arrow
                       --   to the node it's coming from.
             | Both    -- ^ Draw arrows on both ends of the edge.
             | NoDir   -- ^ Draw an undirected edge.
             deriving (DirType -> DirType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirType -> DirType -> Bool
$c/= :: DirType -> DirType -> Bool
== :: DirType -> DirType -> Bool
$c== :: DirType -> DirType -> Bool
Eq, Eq DirType
DirType -> DirType -> Bool
DirType -> DirType -> Ordering
DirType -> DirType -> DirType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DirType -> DirType -> DirType
$cmin :: DirType -> DirType -> DirType
max :: DirType -> DirType -> DirType
$cmax :: DirType -> DirType -> DirType
>= :: DirType -> DirType -> Bool
$c>= :: DirType -> DirType -> Bool
> :: DirType -> DirType -> Bool
$c> :: DirType -> DirType -> Bool
<= :: DirType -> DirType -> Bool
$c<= :: DirType -> DirType -> Bool
< :: DirType -> DirType -> Bool
$c< :: DirType -> DirType -> Bool
compare :: DirType -> DirType -> Ordering
$ccompare :: DirType -> DirType -> Ordering
Ord, DirType
forall a. a -> a -> Bounded a
maxBound :: DirType
$cmaxBound :: DirType
minBound :: DirType
$cminBound :: DirType
Bounded, Int -> DirType
DirType -> Int
DirType -> [DirType]
DirType -> DirType
DirType -> DirType -> [DirType]
DirType -> DirType -> DirType -> [DirType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DirType -> DirType -> DirType -> [DirType]
$cenumFromThenTo :: DirType -> DirType -> DirType -> [DirType]
enumFromTo :: DirType -> DirType -> [DirType]
$cenumFromTo :: DirType -> DirType -> [DirType]
enumFromThen :: DirType -> DirType -> [DirType]
$cenumFromThen :: DirType -> DirType -> [DirType]
enumFrom :: DirType -> [DirType]
$cenumFrom :: DirType -> [DirType]
fromEnum :: DirType -> Int
$cfromEnum :: DirType -> Int
toEnum :: Int -> DirType
$ctoEnum :: Int -> DirType
pred :: DirType -> DirType
$cpred :: DirType -> DirType
succ :: DirType -> DirType
$csucc :: DirType -> DirType
Enum, Int -> DirType -> ShowS
[DirType] -> ShowS
DirType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirType] -> ShowS
$cshowList :: [DirType] -> ShowS
show :: DirType -> String
$cshow :: DirType -> String
showsPrec :: Int -> DirType -> ShowS
$cshowsPrec :: Int -> DirType -> ShowS
Show, ReadPrec [DirType]
ReadPrec DirType
Int -> ReadS DirType
ReadS [DirType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DirType]
$creadListPrec :: ReadPrec [DirType]
readPrec :: ReadPrec DirType
$creadPrec :: ReadPrec DirType
readList :: ReadS [DirType]
$creadList :: ReadS [DirType]
readsPrec :: Int -> ReadS DirType
$creadsPrec :: Int -> ReadS DirType
Read)

instance PrintDot DirType where
  unqtDot :: DirType -> DotCode
unqtDot DirType
Forward = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"forward"
  unqtDot DirType
Back    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"back"
  unqtDot DirType
Both    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"both"
  unqtDot DirType
NoDir   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"none"

instance ParseDot DirType where
  parseUnqt :: Parse DirType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep DirType
Forward String
"forward"
                    , forall a. a -> String -> Parse a
stringRep DirType
Back String
"back"
                    , forall a. a -> String -> Parse a
stringRep DirType
Both String
"both"
                    , forall a. a -> String -> Parse a
stringRep DirType
NoDir String
"none"
                    ]

-- -----------------------------------------------------------------------------

-- | Only when @mode == 'IpSep'@.
data DEConstraints = EdgeConstraints
                   | NoConstraints
                   | HierConstraints
                   deriving (DEConstraints -> DEConstraints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DEConstraints -> DEConstraints -> Bool
$c/= :: DEConstraints -> DEConstraints -> Bool
== :: DEConstraints -> DEConstraints -> Bool
$c== :: DEConstraints -> DEConstraints -> Bool
Eq, Eq DEConstraints
DEConstraints -> DEConstraints -> Bool
DEConstraints -> DEConstraints -> Ordering
DEConstraints -> DEConstraints -> DEConstraints
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DEConstraints -> DEConstraints -> DEConstraints
$cmin :: DEConstraints -> DEConstraints -> DEConstraints
max :: DEConstraints -> DEConstraints -> DEConstraints
$cmax :: DEConstraints -> DEConstraints -> DEConstraints
>= :: DEConstraints -> DEConstraints -> Bool
$c>= :: DEConstraints -> DEConstraints -> Bool
> :: DEConstraints -> DEConstraints -> Bool
$c> :: DEConstraints -> DEConstraints -> Bool
<= :: DEConstraints -> DEConstraints -> Bool
$c<= :: DEConstraints -> DEConstraints -> Bool
< :: DEConstraints -> DEConstraints -> Bool
$c< :: DEConstraints -> DEConstraints -> Bool
compare :: DEConstraints -> DEConstraints -> Ordering
$ccompare :: DEConstraints -> DEConstraints -> Ordering
Ord, DEConstraints
forall a. a -> a -> Bounded a
maxBound :: DEConstraints
$cmaxBound :: DEConstraints
minBound :: DEConstraints
$cminBound :: DEConstraints
Bounded, Int -> DEConstraints
DEConstraints -> Int
DEConstraints -> [DEConstraints]
DEConstraints -> DEConstraints
DEConstraints -> DEConstraints -> [DEConstraints]
DEConstraints -> DEConstraints -> DEConstraints -> [DEConstraints]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DEConstraints -> DEConstraints -> DEConstraints -> [DEConstraints]
$cenumFromThenTo :: DEConstraints -> DEConstraints -> DEConstraints -> [DEConstraints]
enumFromTo :: DEConstraints -> DEConstraints -> [DEConstraints]
$cenumFromTo :: DEConstraints -> DEConstraints -> [DEConstraints]
enumFromThen :: DEConstraints -> DEConstraints -> [DEConstraints]
$cenumFromThen :: DEConstraints -> DEConstraints -> [DEConstraints]
enumFrom :: DEConstraints -> [DEConstraints]
$cenumFrom :: DEConstraints -> [DEConstraints]
fromEnum :: DEConstraints -> Int
$cfromEnum :: DEConstraints -> Int
toEnum :: Int -> DEConstraints
$ctoEnum :: Int -> DEConstraints
pred :: DEConstraints -> DEConstraints
$cpred :: DEConstraints -> DEConstraints
succ :: DEConstraints -> DEConstraints
$csucc :: DEConstraints -> DEConstraints
Enum, Int -> DEConstraints -> ShowS
[DEConstraints] -> ShowS
DEConstraints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DEConstraints] -> ShowS
$cshowList :: [DEConstraints] -> ShowS
show :: DEConstraints -> String
$cshow :: DEConstraints -> String
showsPrec :: Int -> DEConstraints -> ShowS
$cshowsPrec :: Int -> DEConstraints -> ShowS
Show, ReadPrec [DEConstraints]
ReadPrec DEConstraints
Int -> ReadS DEConstraints
ReadS [DEConstraints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DEConstraints]
$creadListPrec :: ReadPrec [DEConstraints]
readPrec :: ReadPrec DEConstraints
$creadPrec :: ReadPrec DEConstraints
readList :: ReadS [DEConstraints]
$creadList :: ReadS [DEConstraints]
readsPrec :: Int -> ReadS DEConstraints
$creadsPrec :: Int -> ReadS DEConstraints
Read)

instance PrintDot DEConstraints where
  unqtDot :: DEConstraints -> DotCode
unqtDot DEConstraints
EdgeConstraints = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot DEConstraints
NoConstraints   = forall a. PrintDot a => a -> DotCode
unqtDot Bool
False
  unqtDot DEConstraints
HierConstraints = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"hier"

instance ParseDot DEConstraints where
  parseUnqt :: Parse DEConstraints
parseUnqt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Bool -> a
bool DEConstraints
NoConstraints DEConstraints
EdgeConstraints) forall a. ParseDot a => Parse a
parse
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall a. a -> String -> Parse a
stringRep DEConstraints
HierConstraints String
"hier"

-- -----------------------------------------------------------------------------

-- | Either a 'Double' or a (2D) 'Point' (i.e. created with
--   'createPoint').
--
--   Whilst it is possible to create a 'Point' value with either a
--   third co-ordinate or a forced position, these are ignored for
--   printing/parsing.
--
--   An optional prefix of @\'+\'@ is allowed when parsing.
data DPoint = DVal Double
            | PVal Point
            deriving (DPoint -> DPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DPoint -> DPoint -> Bool
$c/= :: DPoint -> DPoint -> Bool
== :: DPoint -> DPoint -> Bool
$c== :: DPoint -> DPoint -> Bool
Eq, Eq DPoint
DPoint -> DPoint -> Bool
DPoint -> DPoint -> Ordering
DPoint -> DPoint -> DPoint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DPoint -> DPoint -> DPoint
$cmin :: DPoint -> DPoint -> DPoint
max :: DPoint -> DPoint -> DPoint
$cmax :: DPoint -> DPoint -> DPoint
>= :: DPoint -> DPoint -> Bool
$c>= :: DPoint -> DPoint -> Bool
> :: DPoint -> DPoint -> Bool
$c> :: DPoint -> DPoint -> Bool
<= :: DPoint -> DPoint -> Bool
$c<= :: DPoint -> DPoint -> Bool
< :: DPoint -> DPoint -> Bool
$c< :: DPoint -> DPoint -> Bool
compare :: DPoint -> DPoint -> Ordering
$ccompare :: DPoint -> DPoint -> Ordering
Ord, Int -> DPoint -> ShowS
[DPoint] -> ShowS
DPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DPoint] -> ShowS
$cshowList :: [DPoint] -> ShowS
show :: DPoint -> String
$cshow :: DPoint -> String
showsPrec :: Int -> DPoint -> ShowS
$cshowsPrec :: Int -> DPoint -> ShowS
Show, ReadPrec [DPoint]
ReadPrec DPoint
Int -> ReadS DPoint
ReadS [DPoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DPoint]
$creadListPrec :: ReadPrec [DPoint]
readPrec :: ReadPrec DPoint
$creadPrec :: ReadPrec DPoint
readList :: ReadS [DPoint]
$creadList :: ReadS [DPoint]
readsPrec :: Int -> ReadS DPoint
$creadsPrec :: Int -> ReadS DPoint
Read)

instance PrintDot DPoint where
  unqtDot :: DPoint -> DotCode
unqtDot (DVal Double
d) = forall a. PrintDot a => a -> DotCode
unqtDot Double
d
  unqtDot (PVal Point
p) = Point -> DotCode
printPoint2DUnqt Point
p

  toDot :: DPoint -> DotCode
toDot (DVal Double
d) = forall a. PrintDot a => a -> DotCode
toDot Double
d
  toDot (PVal Point
p) = Point -> DotCode
printPoint2D Point
p

instance ParseDot DPoint where
  parseUnqt :: Parse DPoint
parseUnqt = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parse Char
character Char
'+')
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Point -> DPoint
PVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Point
parsePoint2D
                       , Double -> DPoint
DVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                       ]

  parse :: Parse DPoint
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt -- A `+' would need to be quoted.
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> DPoint
DVal (Bool -> Parse Double
parseSignedFloat Bool
False) -- Don't use parseUnqt!

-- -----------------------------------------------------------------------------

-- | The mapping used for 'FontName' values in SVG output.
--
--   More information can be found at <http://www.graphviz.org/doc/fontfaq.txt>.
data SVGFontNames = SvgNames        -- ^ Use the legal generic SVG font names.
                  | PostScriptNames -- ^ Use PostScript font names.
                  | FontConfigNames -- ^ Use fontconfig font conventions.
                  deriving (SVGFontNames -> SVGFontNames -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SVGFontNames -> SVGFontNames -> Bool
$c/= :: SVGFontNames -> SVGFontNames -> Bool
== :: SVGFontNames -> SVGFontNames -> Bool
$c== :: SVGFontNames -> SVGFontNames -> Bool
Eq, Eq SVGFontNames
SVGFontNames -> SVGFontNames -> Bool
SVGFontNames -> SVGFontNames -> Ordering
SVGFontNames -> SVGFontNames -> SVGFontNames
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SVGFontNames -> SVGFontNames -> SVGFontNames
$cmin :: SVGFontNames -> SVGFontNames -> SVGFontNames
max :: SVGFontNames -> SVGFontNames -> SVGFontNames
$cmax :: SVGFontNames -> SVGFontNames -> SVGFontNames
>= :: SVGFontNames -> SVGFontNames -> Bool
$c>= :: SVGFontNames -> SVGFontNames -> Bool
> :: SVGFontNames -> SVGFontNames -> Bool
$c> :: SVGFontNames -> SVGFontNames -> Bool
<= :: SVGFontNames -> SVGFontNames -> Bool
$c<= :: SVGFontNames -> SVGFontNames -> Bool
< :: SVGFontNames -> SVGFontNames -> Bool
$c< :: SVGFontNames -> SVGFontNames -> Bool
compare :: SVGFontNames -> SVGFontNames -> Ordering
$ccompare :: SVGFontNames -> SVGFontNames -> Ordering
Ord, SVGFontNames
forall a. a -> a -> Bounded a
maxBound :: SVGFontNames
$cmaxBound :: SVGFontNames
minBound :: SVGFontNames
$cminBound :: SVGFontNames
Bounded, Int -> SVGFontNames
SVGFontNames -> Int
SVGFontNames -> [SVGFontNames]
SVGFontNames -> SVGFontNames
SVGFontNames -> SVGFontNames -> [SVGFontNames]
SVGFontNames -> SVGFontNames -> SVGFontNames -> [SVGFontNames]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SVGFontNames -> SVGFontNames -> SVGFontNames -> [SVGFontNames]
$cenumFromThenTo :: SVGFontNames -> SVGFontNames -> SVGFontNames -> [SVGFontNames]
enumFromTo :: SVGFontNames -> SVGFontNames -> [SVGFontNames]
$cenumFromTo :: SVGFontNames -> SVGFontNames -> [SVGFontNames]
enumFromThen :: SVGFontNames -> SVGFontNames -> [SVGFontNames]
$cenumFromThen :: SVGFontNames -> SVGFontNames -> [SVGFontNames]
enumFrom :: SVGFontNames -> [SVGFontNames]
$cenumFrom :: SVGFontNames -> [SVGFontNames]
fromEnum :: SVGFontNames -> Int
$cfromEnum :: SVGFontNames -> Int
toEnum :: Int -> SVGFontNames
$ctoEnum :: Int -> SVGFontNames
pred :: SVGFontNames -> SVGFontNames
$cpred :: SVGFontNames -> SVGFontNames
succ :: SVGFontNames -> SVGFontNames
$csucc :: SVGFontNames -> SVGFontNames
Enum, Int -> SVGFontNames -> ShowS
[SVGFontNames] -> ShowS
SVGFontNames -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SVGFontNames] -> ShowS
$cshowList :: [SVGFontNames] -> ShowS
show :: SVGFontNames -> String
$cshow :: SVGFontNames -> String
showsPrec :: Int -> SVGFontNames -> ShowS
$cshowsPrec :: Int -> SVGFontNames -> ShowS
Show, ReadPrec [SVGFontNames]
ReadPrec SVGFontNames
Int -> ReadS SVGFontNames
ReadS [SVGFontNames]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SVGFontNames]
$creadListPrec :: ReadPrec [SVGFontNames]
readPrec :: ReadPrec SVGFontNames
$creadPrec :: ReadPrec SVGFontNames
readList :: ReadS [SVGFontNames]
$creadList :: ReadS [SVGFontNames]
readsPrec :: Int -> ReadS SVGFontNames
$creadsPrec :: Int -> ReadS SVGFontNames
Read)

instance PrintDot SVGFontNames where
  unqtDot :: SVGFontNames -> DotCode
unqtDot SVGFontNames
SvgNames        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"svg"
  unqtDot SVGFontNames
PostScriptNames = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ps"
  unqtDot SVGFontNames
FontConfigNames = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"gd"

instance ParseDot SVGFontNames where
  parseUnqt :: Parse SVGFontNames
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep SVGFontNames
SvgNames String
"svg"
                    , forall a. a -> String -> Parse a
stringRep SVGFontNames
PostScriptNames String
"ps"
                    , forall a. a -> String -> Parse a
stringRep SVGFontNames
FontConfigNames String
"gd"
                    ]

  parse :: Parse SVGFontNames
parse = forall a. a -> String -> Parse a
stringRep SVGFontNames
SvgNames String
"\"\""
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall a. Parse a -> Parse a
optionalQuoted forall a. ParseDot a => Parse a
parseUnqt

-- -----------------------------------------------------------------------------

-- | Maximum width and height of drawing in inches.
data GraphSize = GSize { GraphSize -> Double
width       :: Double
                         -- | If @Nothing@, then the height is the
                         --   same as the width.
                       , GraphSize -> Maybe Double
height      :: Maybe Double
                         -- | If drawing is smaller than specified
                         --   size, this value determines whether it
                         --   is scaled up.
                       , GraphSize -> Bool
desiredSize :: Bool
                       }
               deriving (GraphSize -> GraphSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphSize -> GraphSize -> Bool
$c/= :: GraphSize -> GraphSize -> Bool
== :: GraphSize -> GraphSize -> Bool
$c== :: GraphSize -> GraphSize -> Bool
Eq, Eq GraphSize
GraphSize -> GraphSize -> Bool
GraphSize -> GraphSize -> Ordering
GraphSize -> GraphSize -> GraphSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GraphSize -> GraphSize -> GraphSize
$cmin :: GraphSize -> GraphSize -> GraphSize
max :: GraphSize -> GraphSize -> GraphSize
$cmax :: GraphSize -> GraphSize -> GraphSize
>= :: GraphSize -> GraphSize -> Bool
$c>= :: GraphSize -> GraphSize -> Bool
> :: GraphSize -> GraphSize -> Bool
$c> :: GraphSize -> GraphSize -> Bool
<= :: GraphSize -> GraphSize -> Bool
$c<= :: GraphSize -> GraphSize -> Bool
< :: GraphSize -> GraphSize -> Bool
$c< :: GraphSize -> GraphSize -> Bool
compare :: GraphSize -> GraphSize -> Ordering
$ccompare :: GraphSize -> GraphSize -> Ordering
Ord, Int -> GraphSize -> ShowS
[GraphSize] -> ShowS
GraphSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphSize] -> ShowS
$cshowList :: [GraphSize] -> ShowS
show :: GraphSize -> String
$cshow :: GraphSize -> String
showsPrec :: Int -> GraphSize -> ShowS
$cshowsPrec :: Int -> GraphSize -> ShowS
Show, ReadPrec [GraphSize]
ReadPrec GraphSize
Int -> ReadS GraphSize
ReadS [GraphSize]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GraphSize]
$creadListPrec :: ReadPrec [GraphSize]
readPrec :: ReadPrec GraphSize
$creadPrec :: ReadPrec GraphSize
readList :: ReadS [GraphSize]
$creadList :: ReadS [GraphSize]
readsPrec :: Int -> ReadS GraphSize
$creadsPrec :: Int -> ReadS GraphSize
Read)

instance PrintDot GraphSize where
  unqtDot :: GraphSize -> DotCode
unqtDot (GSize Double
w Maybe Double
mh Bool
ds) = forall a. a -> a -> Bool -> a
bool forall a. a -> a
id (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'!') Bool
ds
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Double
h -> (forall a. Semigroup a => a -> a -> a
<> forall a. PrintDot a => a -> DotCode
unqtDot Double
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
comma)) Maybe Double
mh
                            forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot Double
w

  toDot :: GraphSize -> DotCode
toDot (GSize Double
w Maybe Double
Nothing Bool
False) = forall a. PrintDot a => a -> DotCode
toDot Double
w
  toDot GraphSize
gs                      = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot GraphSize
gs

instance ParseDot GraphSize where
  parseUnqt :: Parse GraphSize
parseUnqt = Double -> Maybe Double -> Bool -> GraphSize
GSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parse ()
parseComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parseUnqt)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parse Char
character Char
'!'))

  parse :: Parse GraphSize
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Double
w -> Double -> Maybe Double -> Bool -> GraphSize
GSize Double
w forall a. Maybe a
Nothing Bool
False) (Bool -> Parse Double
parseSignedFloat Bool
False)

-- -----------------------------------------------------------------------------

-- | For 'Neato' unless indicated otherwise.
data ModeType = Major
              | KK
              | Hier
              | IpSep
              | SpringMode -- ^ For 'Sfdp', requires Graphviz >= 2.32.0.
              | MaxEnt     -- ^ For 'Sfdp', requires Graphviz >= 2.32.0.
              deriving (ModeType -> ModeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModeType -> ModeType -> Bool
$c/= :: ModeType -> ModeType -> Bool
== :: ModeType -> ModeType -> Bool
$c== :: ModeType -> ModeType -> Bool
Eq, Eq ModeType
ModeType -> ModeType -> Bool
ModeType -> ModeType -> Ordering
ModeType -> ModeType -> ModeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModeType -> ModeType -> ModeType
$cmin :: ModeType -> ModeType -> ModeType
max :: ModeType -> ModeType -> ModeType
$cmax :: ModeType -> ModeType -> ModeType
>= :: ModeType -> ModeType -> Bool
$c>= :: ModeType -> ModeType -> Bool
> :: ModeType -> ModeType -> Bool
$c> :: ModeType -> ModeType -> Bool
<= :: ModeType -> ModeType -> Bool
$c<= :: ModeType -> ModeType -> Bool
< :: ModeType -> ModeType -> Bool
$c< :: ModeType -> ModeType -> Bool
compare :: ModeType -> ModeType -> Ordering
$ccompare :: ModeType -> ModeType -> Ordering
Ord, ModeType
forall a. a -> a -> Bounded a
maxBound :: ModeType
$cmaxBound :: ModeType
minBound :: ModeType
$cminBound :: ModeType
Bounded, Int -> ModeType
ModeType -> Int
ModeType -> [ModeType]
ModeType -> ModeType
ModeType -> ModeType -> [ModeType]
ModeType -> ModeType -> ModeType -> [ModeType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModeType -> ModeType -> ModeType -> [ModeType]
$cenumFromThenTo :: ModeType -> ModeType -> ModeType -> [ModeType]
enumFromTo :: ModeType -> ModeType -> [ModeType]
$cenumFromTo :: ModeType -> ModeType -> [ModeType]
enumFromThen :: ModeType -> ModeType -> [ModeType]
$cenumFromThen :: ModeType -> ModeType -> [ModeType]
enumFrom :: ModeType -> [ModeType]
$cenumFrom :: ModeType -> [ModeType]
fromEnum :: ModeType -> Int
$cfromEnum :: ModeType -> Int
toEnum :: Int -> ModeType
$ctoEnum :: Int -> ModeType
pred :: ModeType -> ModeType
$cpred :: ModeType -> ModeType
succ :: ModeType -> ModeType
$csucc :: ModeType -> ModeType
Enum, Int -> ModeType -> ShowS
[ModeType] -> ShowS
ModeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModeType] -> ShowS
$cshowList :: [ModeType] -> ShowS
show :: ModeType -> String
$cshow :: ModeType -> String
showsPrec :: Int -> ModeType -> ShowS
$cshowsPrec :: Int -> ModeType -> ShowS
Show, ReadPrec [ModeType]
ReadPrec ModeType
Int -> ReadS ModeType
ReadS [ModeType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModeType]
$creadListPrec :: ReadPrec [ModeType]
readPrec :: ReadPrec ModeType
$creadPrec :: ReadPrec ModeType
readList :: ReadS [ModeType]
$creadList :: ReadS [ModeType]
readsPrec :: Int -> ReadS ModeType
$creadsPrec :: Int -> ReadS ModeType
Read)

instance PrintDot ModeType where
  unqtDot :: ModeType -> DotCode
unqtDot ModeType
Major      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"major"
  unqtDot ModeType
KK         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"KK"
  unqtDot ModeType
Hier       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"hier"
  unqtDot ModeType
IpSep      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ipsep"
  unqtDot ModeType
SpringMode = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"spring"
  unqtDot ModeType
MaxEnt     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"maxent"

instance ParseDot ModeType where
  parseUnqt :: Parse ModeType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep ModeType
Major String
"major"
                    , forall a. a -> String -> Parse a
stringRep ModeType
KK String
"KK"
                    , forall a. a -> String -> Parse a
stringRep ModeType
Hier String
"hier"
                    , forall a. a -> String -> Parse a
stringRep ModeType
IpSep String
"ipsep"
                    , forall a. a -> String -> Parse a
stringRep ModeType
SpringMode String
"spring"
                    , forall a. a -> String -> Parse a
stringRep ModeType
MaxEnt String
"maxent"
                    ]

-- -----------------------------------------------------------------------------

data Model = ShortPath
           | SubSet
           | Circuit
           | MDS
           deriving (Model -> Model -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c== :: Model -> Model -> Bool
Eq, Eq Model
Model -> Model -> Bool
Model -> Model -> Ordering
Model -> Model -> Model
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Model -> Model -> Model
$cmin :: Model -> Model -> Model
max :: Model -> Model -> Model
$cmax :: Model -> Model -> Model
>= :: Model -> Model -> Bool
$c>= :: Model -> Model -> Bool
> :: Model -> Model -> Bool
$c> :: Model -> Model -> Bool
<= :: Model -> Model -> Bool
$c<= :: Model -> Model -> Bool
< :: Model -> Model -> Bool
$c< :: Model -> Model -> Bool
compare :: Model -> Model -> Ordering
$ccompare :: Model -> Model -> Ordering
Ord, Model
forall a. a -> a -> Bounded a
maxBound :: Model
$cmaxBound :: Model
minBound :: Model
$cminBound :: Model
Bounded, Int -> Model
Model -> Int
Model -> [Model]
Model -> Model
Model -> Model -> [Model]
Model -> Model -> Model -> [Model]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Model -> Model -> Model -> [Model]
$cenumFromThenTo :: Model -> Model -> Model -> [Model]
enumFromTo :: Model -> Model -> [Model]
$cenumFromTo :: Model -> Model -> [Model]
enumFromThen :: Model -> Model -> [Model]
$cenumFromThen :: Model -> Model -> [Model]
enumFrom :: Model -> [Model]
$cenumFrom :: Model -> [Model]
fromEnum :: Model -> Int
$cfromEnum :: Model -> Int
toEnum :: Int -> Model
$ctoEnum :: Int -> Model
pred :: Model -> Model
$cpred :: Model -> Model
succ :: Model -> Model
$csucc :: Model -> Model
Enum, Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model] -> ShowS
$cshowList :: [Model] -> ShowS
show :: Model -> String
$cshow :: Model -> String
showsPrec :: Int -> Model -> ShowS
$cshowsPrec :: Int -> Model -> ShowS
Show, ReadPrec [Model]
ReadPrec Model
Int -> ReadS Model
ReadS [Model]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Model]
$creadListPrec :: ReadPrec [Model]
readPrec :: ReadPrec Model
$creadPrec :: ReadPrec Model
readList :: ReadS [Model]
$creadList :: ReadS [Model]
readsPrec :: Int -> ReadS Model
$creadsPrec :: Int -> ReadS Model
Read)

instance PrintDot Model where
  unqtDot :: Model -> DotCode
unqtDot Model
ShortPath = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"shortpath"
  unqtDot Model
SubSet    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"subset"
  unqtDot Model
Circuit   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"circuit"
  unqtDot Model
MDS       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"mds"

instance ParseDot Model where
  parseUnqt :: Parse Model
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Model
ShortPath String
"shortpath"
                    , forall a. a -> String -> Parse a
stringRep Model
SubSet String
"subset"
                    , forall a. a -> String -> Parse a
stringRep Model
Circuit String
"circuit"
                    , forall a. a -> String -> Parse a
stringRep Model
MDS String
"mds"
                    ]

-- -----------------------------------------------------------------------------

data Label = StrLabel EscString
           | HtmlLabel Html.Label -- ^ If 'PlainText' is used, the
                                  --   'Html.Label' value is the entire
                                  --   \"shape\"; if anything else
                                  --   except 'PointShape' is used then
                                  --   the 'Html.Label' is embedded
                                  --   within the shape.
           | RecordLabel RecordFields -- ^ For nodes only; requires
                                      --   either 'Record' or
                                      --   'MRecord' as the shape.
           deriving (Label -> Label -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
Ord, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Label]
$creadListPrec :: ReadPrec [Label]
readPrec :: ReadPrec Label
$creadPrec :: ReadPrec Label
readList :: ReadS [Label]
$creadList :: ReadS [Label]
readsPrec :: Int -> ReadS Label
$creadsPrec :: Int -> ReadS Label
Read)

instance PrintDot Label where
  unqtDot :: Label -> DotCode
unqtDot (StrLabel Text
s)     = forall a. PrintDot a => a -> DotCode
unqtDot Text
s
  unqtDot (HtmlLabel Label
h)    = DotCode -> DotCode
angled forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot Label
h
  unqtDot (RecordLabel RecordFields
fs) = forall a. PrintDot a => a -> DotCode
unqtDot RecordFields
fs

  toDot :: Label -> DotCode
toDot (StrLabel Text
s)     = forall a. PrintDot a => a -> DotCode
toDot Text
s
  toDot h :: Label
h@HtmlLabel{}    = forall a. PrintDot a => a -> DotCode
unqtDot Label
h
  toDot (RecordLabel RecordFields
fs) = forall a. PrintDot a => a -> DotCode
toDot RecordFields
fs

instance ParseDot Label where
  -- Don't have to worry about being able to tell the difference
  -- between an HtmlLabel and a RecordLabel starting with a PortPos,
  -- since the latter will be in quotes and the former won't.

  parseUnqt :: Parse Label
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Label -> Label
HtmlLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parse a -> Parse a
parseAngled forall a. ParseDot a => Parse a
parseUnqt
                    , RecordFields -> Label
RecordLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                    , Text -> Label
StrLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                    ]

  parse :: Parse Label
parse = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Label -> Label
HtmlLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parse a -> Parse a
parseAngled forall a. ParseDot a => Parse a
parse
                , RecordFields -> Label
RecordLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse
                , Text -> Label
StrLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse
                ]

-- -----------------------------------------------------------------------------

-- | A RecordFields value should never be empty.
type RecordFields = [RecordField]

-- | Specifies the sub-values of a record-based label.  By default,
--   the cells are laid out horizontally; use 'FlipFields' to change
--   the orientation of the fields (can be applied recursively).  To
--   change the default orientation, use 'RankDir'.
data RecordField = LabelledTarget PortName EscString
                 | PortName PortName -- ^ Will result in no label for
                                     --   that cell.
                 | FieldLabel EscString
                 | FlipFields RecordFields
                 deriving (RecordField -> RecordField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordField -> RecordField -> Bool
$c/= :: RecordField -> RecordField -> Bool
== :: RecordField -> RecordField -> Bool
$c== :: RecordField -> RecordField -> Bool
Eq, Eq RecordField
RecordField -> RecordField -> Bool
RecordField -> RecordField -> Ordering
RecordField -> RecordField -> RecordField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RecordField -> RecordField -> RecordField
$cmin :: RecordField -> RecordField -> RecordField
max :: RecordField -> RecordField -> RecordField
$cmax :: RecordField -> RecordField -> RecordField
>= :: RecordField -> RecordField -> Bool
$c>= :: RecordField -> RecordField -> Bool
> :: RecordField -> RecordField -> Bool
$c> :: RecordField -> RecordField -> Bool
<= :: RecordField -> RecordField -> Bool
$c<= :: RecordField -> RecordField -> Bool
< :: RecordField -> RecordField -> Bool
$c< :: RecordField -> RecordField -> Bool
compare :: RecordField -> RecordField -> Ordering
$ccompare :: RecordField -> RecordField -> Ordering
Ord, Int -> RecordField -> ShowS
RecordFields -> ShowS
RecordField -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: RecordFields -> ShowS
$cshowList :: RecordFields -> ShowS
show :: RecordField -> String
$cshow :: RecordField -> String
showsPrec :: Int -> RecordField -> ShowS
$cshowsPrec :: Int -> RecordField -> ShowS
Show, ReadPrec RecordFields
ReadPrec RecordField
Int -> ReadS RecordField
ReadS RecordFields
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec RecordFields
$creadListPrec :: ReadPrec RecordFields
readPrec :: ReadPrec RecordField
$creadPrec :: ReadPrec RecordField
readList :: ReadS RecordFields
$creadList :: ReadS RecordFields
readsPrec :: Int -> ReadS RecordField
$creadsPrec :: Int -> ReadS RecordField
Read)

instance PrintDot RecordField where
  -- Have to use 'printPortName' to add the @\'<\'@ and @\'>\'@.
  unqtDot :: RecordField -> DotCode
unqtDot (LabelledTarget PortName
t Text
s) = PortName -> DotCode
printPortName PortName
t forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Text -> DotCode
unqtRecordString Text
s
  unqtDot (PortName PortName
t)         = PortName -> DotCode
printPortName PortName
t
  unqtDot (FieldLabel Text
s)       = Text -> DotCode
unqtRecordString Text
s
  unqtDot (FlipFields RecordFields
rs)      = forall (m :: * -> *). Functor m => m Doc -> m Doc
braces forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot RecordFields
rs

  toDot :: RecordField -> DotCode
toDot (FieldLabel Text
s) = String -> Text -> DotCode
printEscaped String
recordEscChars Text
s
  toDot RecordField
rf             = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot RecordField
rf

  unqtListToDot :: RecordFields -> DotCode
unqtListToDot [RecordField
f] = forall a. PrintDot a => a -> DotCode
unqtDot RecordField
f
  unqtListToDot RecordFields
fs  = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate (forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'|') forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot RecordFields
fs

  listToDot :: RecordFields -> DotCode
listToDot [RecordField
f] = forall a. PrintDot a => a -> DotCode
toDot RecordField
f
  listToDot RecordFields
fs  = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => [a] -> DotCode
unqtListToDot RecordFields
fs

instance ParseDot RecordField where
  parseUnqt :: Parse RecordField
parseUnqt = (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall b a. b -> (a -> b) -> Maybe a -> b
maybe PortName -> RecordField
PortName PortName -> Text -> RecordField
LabelledTarget
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> PortName
PN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parse a -> Parse a
parseAngled Parse Text
parseRecord)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parse ()
whitespace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse Text
parseRecord)
              )
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RecordField
FieldLabel Parse Text
parseRecord
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RecordFields -> RecordField
FlipFields (forall a. Parse a -> Parse a
parseBraced forall a. ParseDot a => Parse a
parseUnqt)
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse RecordField"

  parse :: Parse RecordField
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse RecordFields
parseUnqtList = forall a. Parse a -> Parse a
wrapWhitespace forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt (forall a. Parse a -> Parse a
wrapWhitespace forall a b. (a -> b) -> a -> b
$ Char -> Parse Char
character Char
'|')

  -- Note: a singleton unquoted 'FieldLabel' is /not/ valid, as it
  -- will cause parsing problems for other 'Label' types.
  parseList :: Parse RecordFields
parseList = do RecordFields
rfs <- forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse [a]
parseUnqtList
                 if RecordFields -> Bool
validRFs RecordFields
rfs
                   then forall (m :: * -> *) a. Monad m => a -> m a
return RecordFields
rfs
                   else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"This is a StrLabel, not a RecordLabel"
    where
      validRFs :: RecordFields -> Bool
validRFs [FieldLabel Text
str] = (Char -> Bool) -> Text -> Bool
T.any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
recordEscChars) Text
str
      validRFs RecordFields
_                = Bool
True

-- | Print a 'PortName' value as expected within a Record data
--   structure.
printPortName :: PortName -> DotCode
printPortName :: PortName -> DotCode
printPortName = DotCode -> DotCode
angled forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCode
unqtRecordString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortName -> Text
portName

parseRecord :: Parse Text
parseRecord :: Parse Text
parseRecord = Bool -> String -> String -> Parse Text
parseEscaped Bool
False String
recordEscChars []

unqtRecordString :: Text -> DotCode
unqtRecordString :: Text -> DotCode
unqtRecordString = String -> Text -> DotCode
unqtEscaped String
recordEscChars

recordEscChars :: [Char]
recordEscChars :: String
recordEscChars = [Char
'{', Char
'}', Char
'|', Char
' ', Char
'<', Char
'>']

-- -----------------------------------------------------------------------------

-- | How to treat a node whose name is of the form \"@|edgelabel|*@\"
--   as a special node representing an edge label.
data LabelScheme = NotEdgeLabel        -- ^ No effect
                 | CloseToCenter       -- ^ Make node close to center of neighbor
                 | CloseToOldCenter    -- ^ Make node close to old center of neighbor
                 | RemoveAndStraighten -- ^ Use a two-step process.
                 deriving (LabelScheme -> LabelScheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelScheme -> LabelScheme -> Bool
$c/= :: LabelScheme -> LabelScheme -> Bool
== :: LabelScheme -> LabelScheme -> Bool
$c== :: LabelScheme -> LabelScheme -> Bool
Eq, Eq LabelScheme
LabelScheme -> LabelScheme -> Bool
LabelScheme -> LabelScheme -> Ordering
LabelScheme -> LabelScheme -> LabelScheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LabelScheme -> LabelScheme -> LabelScheme
$cmin :: LabelScheme -> LabelScheme -> LabelScheme
max :: LabelScheme -> LabelScheme -> LabelScheme
$cmax :: LabelScheme -> LabelScheme -> LabelScheme
>= :: LabelScheme -> LabelScheme -> Bool
$c>= :: LabelScheme -> LabelScheme -> Bool
> :: LabelScheme -> LabelScheme -> Bool
$c> :: LabelScheme -> LabelScheme -> Bool
<= :: LabelScheme -> LabelScheme -> Bool
$c<= :: LabelScheme -> LabelScheme -> Bool
< :: LabelScheme -> LabelScheme -> Bool
$c< :: LabelScheme -> LabelScheme -> Bool
compare :: LabelScheme -> LabelScheme -> Ordering
$ccompare :: LabelScheme -> LabelScheme -> Ordering
Ord, LabelScheme
forall a. a -> a -> Bounded a
maxBound :: LabelScheme
$cmaxBound :: LabelScheme
minBound :: LabelScheme
$cminBound :: LabelScheme
Bounded, Int -> LabelScheme
LabelScheme -> Int
LabelScheme -> [LabelScheme]
LabelScheme -> LabelScheme
LabelScheme -> LabelScheme -> [LabelScheme]
LabelScheme -> LabelScheme -> LabelScheme -> [LabelScheme]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LabelScheme -> LabelScheme -> LabelScheme -> [LabelScheme]
$cenumFromThenTo :: LabelScheme -> LabelScheme -> LabelScheme -> [LabelScheme]
enumFromTo :: LabelScheme -> LabelScheme -> [LabelScheme]
$cenumFromTo :: LabelScheme -> LabelScheme -> [LabelScheme]
enumFromThen :: LabelScheme -> LabelScheme -> [LabelScheme]
$cenumFromThen :: LabelScheme -> LabelScheme -> [LabelScheme]
enumFrom :: LabelScheme -> [LabelScheme]
$cenumFrom :: LabelScheme -> [LabelScheme]
fromEnum :: LabelScheme -> Int
$cfromEnum :: LabelScheme -> Int
toEnum :: Int -> LabelScheme
$ctoEnum :: Int -> LabelScheme
pred :: LabelScheme -> LabelScheme
$cpred :: LabelScheme -> LabelScheme
succ :: LabelScheme -> LabelScheme
$csucc :: LabelScheme -> LabelScheme
Enum, Int -> LabelScheme -> ShowS
[LabelScheme] -> ShowS
LabelScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelScheme] -> ShowS
$cshowList :: [LabelScheme] -> ShowS
show :: LabelScheme -> String
$cshow :: LabelScheme -> String
showsPrec :: Int -> LabelScheme -> ShowS
$cshowsPrec :: Int -> LabelScheme -> ShowS
Show, ReadPrec [LabelScheme]
ReadPrec LabelScheme
Int -> ReadS LabelScheme
ReadS [LabelScheme]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LabelScheme]
$creadListPrec :: ReadPrec [LabelScheme]
readPrec :: ReadPrec LabelScheme
$creadPrec :: ReadPrec LabelScheme
readList :: ReadS [LabelScheme]
$creadList :: ReadS [LabelScheme]
readsPrec :: Int -> ReadS LabelScheme
$creadsPrec :: Int -> ReadS LabelScheme
Read)

instance PrintDot LabelScheme where
  unqtDot :: LabelScheme -> DotCode
unqtDot LabelScheme
NotEdgeLabel        = forall (m :: * -> *). Applicative m => Int -> m Doc
int Int
0
  unqtDot LabelScheme
CloseToCenter       = forall (m :: * -> *). Applicative m => Int -> m Doc
int Int
1
  unqtDot LabelScheme
CloseToOldCenter    = forall (m :: * -> *). Applicative m => Int -> m Doc
int Int
2
  unqtDot LabelScheme
RemoveAndStraighten = forall (m :: * -> *). Applicative m => Int -> m Doc
int Int
3

instance ParseDot LabelScheme where
  -- Use string-based parsing rather than parsing an integer just to make it easier
  parseUnqt :: Parse LabelScheme
parseUnqt = forall a. [(String, a)] -> Parse a
stringValue [ (String
"0", LabelScheme
NotEdgeLabel)
                          , (String
"1", LabelScheme
CloseToCenter)
                          , (String
"2", LabelScheme
CloseToOldCenter)
                          , (String
"3", LabelScheme
RemoveAndStraighten)
                          ]

-- -----------------------------------------------------------------------------

data Point = Point { Point -> Double
xCoord   :: Double
                   , Point -> Double
yCoord   :: Double
                      -- | Can only be 'Just' for @'Dim' 3@ or greater.
                   , Point -> Maybe Double
zCoord   :: Maybe Double
                     -- | Input to Graphviz only: specify that the
                     --   node position should not change.
                   , Point -> Bool
forcePos :: Bool
                   }
           deriving (Point -> Point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, Eq Point
Point -> Point -> Bool
Point -> Point -> Ordering
Point -> Point -> Point
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Point -> Point -> Point
$cmin :: Point -> Point -> Point
max :: Point -> Point -> Point
$cmax :: Point -> Point -> Point
>= :: Point -> Point -> Bool
$c>= :: Point -> Point -> Bool
> :: Point -> Point -> Bool
$c> :: Point -> Point -> Bool
<= :: Point -> Point -> Bool
$c<= :: Point -> Point -> Bool
< :: Point -> Point -> Bool
$c< :: Point -> Point -> Bool
compare :: Point -> Point -> Ordering
$ccompare :: Point -> Point -> Ordering
Ord, Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show, ReadPrec [Point]
ReadPrec Point
Int -> ReadS Point
ReadS [Point]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Point]
$creadListPrec :: ReadPrec [Point]
readPrec :: ReadPrec Point
$creadPrec :: ReadPrec Point
readList :: ReadS [Point]
$creadList :: ReadS [Point]
readsPrec :: Int -> ReadS Point
$creadsPrec :: Int -> ReadS Point
Read)

-- | Create a point with only @x@ and @y@ values.
createPoint     :: Double -> Double -> Point
createPoint :: Double -> Double -> Point
createPoint Double
x Double
y = Double -> Double -> Maybe Double -> Bool -> Point
Point Double
x Double
y forall a. Maybe a
Nothing Bool
False

printPoint2DUnqt   :: Point -> DotCode
printPoint2DUnqt :: Point -> DotCode
printPoint2DUnqt Point
p = forall a b. (PrintDot a, PrintDot b) => a -> b -> DotCode
commaDel (Point -> Double
xCoord Point
p) (Point -> Double
yCoord Point
p)

printPoint2D :: Point -> DotCode
printPoint2D :: Point -> DotCode
printPoint2D = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> DotCode
printPoint2DUnqt

parsePoint2D :: Parse Point
parsePoint2D :: Parse Point
parsePoint2D = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Point
createPoint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ParseDot a, ParseDot b) => Parse (a, b)
commaSepUnqt

instance PrintDot Point where
  unqtDot :: Point -> DotCode
unqtDot (Point Double
x Double
y Maybe Double
mz Bool
frs) = forall a. a -> a -> Bool -> a
bool forall a. a -> a
id (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'!') Bool
frs
                               forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\ Double
z -> (forall a. Semigroup a => a -> a -> a
<> forall a. PrintDot a => a -> DotCode
unqtDot Double
z) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
comma)) Maybe Double
mz
                               forall a b. (a -> b) -> a -> b
$ forall a b. (PrintDot a, PrintDot b) => a -> b -> DotCode
commaDel Double
x Double
y

  toDot :: Point -> DotCode
toDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot

  unqtListToDot :: [Point] -> DotCode
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot

  listToDot :: [Point] -> DotCode
listToDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => [a] -> DotCode
unqtListToDot

instance ParseDot Point where
  parseUnqt :: Parse Point
parseUnqt = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Maybe Double -> Bool -> Point
Point
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ParseDot a, ParseDot b) => Parse (a, b)
commaSepUnqt
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parse ()
parseComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parseUnqt)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parse Char
character Char
'!'))

  parse :: Parse Point
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse [Point]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt Parse ()
whitespace1

-- -----------------------------------------------------------------------------

-- | How to deal with node overlaps.
--
--   Defaults to 'KeepOverlaps' /except/ for 'Fdp' and 'Sfdp'.
--
--   The ability to specify the number of tries for 'Fdp''s initial
--   force-directed technique is /not/ supported (by default, 'Fdp' uses
--   @9@ passes of its in-built technique, and then @'PrismOverlap'
--   Nothing@).
--
--   For 'Sfdp', the default is @'PrismOverlap' (Just 0)@.
data Overlap = KeepOverlaps
             | ScaleOverlaps -- ^ Remove overlaps by uniformly scaling in x and y.
             | ScaleXYOverlaps -- ^ Remove overlaps by separately scaling x and y.
             | PrismOverlap (Maybe Word16) -- ^ Requires the Prism
                                           --   library to be
                                           --   available (if not,
                                           --   this is equivalent to
                                           --   'VoronoiOverlap'). @'Nothing'@
                                           --   is equivalent to
                                           --   @'Just' 1000@.
                                           --   Influenced by
                                           --   'OverlapScaling'.
             | VoronoiOverlap -- ^ Requires Graphviz >= 2.30.0.
             | CompressOverlap -- ^ Scale layout down as much as
                               --   possible without introducing
                               --   overlaps, assuming none to begin
                               --   with.
             | VpscOverlap -- ^ Uses quadratic optimization to
                           --   minimize node displacement.
             | IpsepOverlap -- ^ Only when @mode == 'IpSep'@
             deriving (Overlap -> Overlap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Overlap -> Overlap -> Bool
$c/= :: Overlap -> Overlap -> Bool
== :: Overlap -> Overlap -> Bool
$c== :: Overlap -> Overlap -> Bool
Eq, Eq Overlap
Overlap -> Overlap -> Bool
Overlap -> Overlap -> Ordering
Overlap -> Overlap -> Overlap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Overlap -> Overlap -> Overlap
$cmin :: Overlap -> Overlap -> Overlap
max :: Overlap -> Overlap -> Overlap
$cmax :: Overlap -> Overlap -> Overlap
>= :: Overlap -> Overlap -> Bool
$c>= :: Overlap -> Overlap -> Bool
> :: Overlap -> Overlap -> Bool
$c> :: Overlap -> Overlap -> Bool
<= :: Overlap -> Overlap -> Bool
$c<= :: Overlap -> Overlap -> Bool
< :: Overlap -> Overlap -> Bool
$c< :: Overlap -> Overlap -> Bool
compare :: Overlap -> Overlap -> Ordering
$ccompare :: Overlap -> Overlap -> Ordering
Ord, Int -> Overlap -> ShowS
[Overlap] -> ShowS
Overlap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Overlap] -> ShowS
$cshowList :: [Overlap] -> ShowS
show :: Overlap -> String
$cshow :: Overlap -> String
showsPrec :: Int -> Overlap -> ShowS
$cshowsPrec :: Int -> Overlap -> ShowS
Show, ReadPrec [Overlap]
ReadPrec Overlap
Int -> ReadS Overlap
ReadS [Overlap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Overlap]
$creadListPrec :: ReadPrec [Overlap]
readPrec :: ReadPrec Overlap
$creadPrec :: ReadPrec Overlap
readList :: ReadS [Overlap]
$creadList :: ReadS [Overlap]
readsPrec :: Int -> ReadS Overlap
$creadsPrec :: Int -> ReadS Overlap
Read)

instance PrintDot Overlap where
  unqtDot :: Overlap -> DotCode
unqtDot Overlap
KeepOverlaps     = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot Overlap
ScaleOverlaps    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"scale"
  unqtDot Overlap
ScaleXYOverlaps  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"scalexy"
  unqtDot (PrismOverlap Maybe Word16
i) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot) Maybe Word16
i forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"prism"
  unqtDot Overlap
VoronoiOverlap   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"voronoi"
  unqtDot Overlap
CompressOverlap  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"compress"
  unqtDot Overlap
VpscOverlap      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"vpsc"
  unqtDot Overlap
IpsepOverlap     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ipsep"

-- | Note that @overlap=false@ defaults to @'PrismOverlap' Nothing@,
--   but if the Prism library isn't available then it is equivalent to
--   'VoronoiOverlap'.
instance ParseDot Overlap where
  parseUnqt :: Parse Overlap
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Overlap
KeepOverlaps String
"true"
                    , forall a. a -> String -> Parse a
stringRep Overlap
ScaleXYOverlaps String
"scalexy"
                    , forall a. a -> String -> Parse a
stringRep Overlap
ScaleOverlaps String
"scale"
                    , String -> Parse ()
string String
"prism" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Word16 -> Overlap
PrismOverlap (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a. ParseDot a => Parse a
parse)
                    , forall a. a -> String -> Parse a
stringRep (Maybe Word16 -> Overlap
PrismOverlap forall a. Maybe a
Nothing) String
"false"
                    , forall a. a -> String -> Parse a
stringRep Overlap
VoronoiOverlap String
"voronoi"
                    , forall a. a -> String -> Parse a
stringRep Overlap
CompressOverlap String
"compress"
                    , forall a. a -> String -> Parse a
stringRep Overlap
VpscOverlap String
"vpsc"
                    , forall a. a -> String -> Parse a
stringRep Overlap
IpsepOverlap String
"ipsep"
                    ]

-- -----------------------------------------------------------------------------

newtype LayerSep = LSep Text
                 deriving (LayerSep -> LayerSep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerSep -> LayerSep -> Bool
$c/= :: LayerSep -> LayerSep -> Bool
== :: LayerSep -> LayerSep -> Bool
$c== :: LayerSep -> LayerSep -> Bool
Eq, Eq LayerSep
LayerSep -> LayerSep -> Bool
LayerSep -> LayerSep -> Ordering
LayerSep -> LayerSep -> LayerSep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayerSep -> LayerSep -> LayerSep
$cmin :: LayerSep -> LayerSep -> LayerSep
max :: LayerSep -> LayerSep -> LayerSep
$cmax :: LayerSep -> LayerSep -> LayerSep
>= :: LayerSep -> LayerSep -> Bool
$c>= :: LayerSep -> LayerSep -> Bool
> :: LayerSep -> LayerSep -> Bool
$c> :: LayerSep -> LayerSep -> Bool
<= :: LayerSep -> LayerSep -> Bool
$c<= :: LayerSep -> LayerSep -> Bool
< :: LayerSep -> LayerSep -> Bool
$c< :: LayerSep -> LayerSep -> Bool
compare :: LayerSep -> LayerSep -> Ordering
$ccompare :: LayerSep -> LayerSep -> Ordering
Ord, Int -> LayerSep -> ShowS
[LayerSep] -> ShowS
LayerSep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerSep] -> ShowS
$cshowList :: [LayerSep] -> ShowS
show :: LayerSep -> String
$cshow :: LayerSep -> String
showsPrec :: Int -> LayerSep -> ShowS
$cshowsPrec :: Int -> LayerSep -> ShowS
Show, ReadPrec [LayerSep]
ReadPrec LayerSep
Int -> ReadS LayerSep
ReadS [LayerSep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerSep]
$creadListPrec :: ReadPrec [LayerSep]
readPrec :: ReadPrec LayerSep
$creadPrec :: ReadPrec LayerSep
readList :: ReadS [LayerSep]
$creadList :: ReadS [LayerSep]
readsPrec :: Int -> ReadS LayerSep
$creadsPrec :: Int -> ReadS LayerSep
Read)

instance PrintDot LayerSep where
  unqtDot :: LayerSep -> DotCode
unqtDot (LSep Text
ls) = forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerSep (Text -> String
T.unpack Text
ls) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. PrintDot a => a -> DotCode
unqtDot Text
ls

  toDot :: LayerSep -> DotCode
toDot (LSep Text
ls) = forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerSep (Text -> String
T.unpack Text
ls) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. PrintDot a => a -> DotCode
toDot Text
ls

instance ParseDot LayerSep where
  parseUnqt :: Parse LayerSep
parseUnqt = do Text
ls <- forall a. ParseDot a => Parse a
parseUnqt
                 forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerSep forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ls
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LayerSep
LSep Text
ls

  parse :: Parse LayerSep
parse = do Text
ls <- forall a. ParseDot a => Parse a
parse
             forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerSep forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ls
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LayerSep
LSep Text
ls

newtype LayerListSep = LLSep Text
                     deriving (LayerListSep -> LayerListSep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerListSep -> LayerListSep -> Bool
$c/= :: LayerListSep -> LayerListSep -> Bool
== :: LayerListSep -> LayerListSep -> Bool
$c== :: LayerListSep -> LayerListSep -> Bool
Eq, Eq LayerListSep
LayerListSep -> LayerListSep -> Bool
LayerListSep -> LayerListSep -> Ordering
LayerListSep -> LayerListSep -> LayerListSep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayerListSep -> LayerListSep -> LayerListSep
$cmin :: LayerListSep -> LayerListSep -> LayerListSep
max :: LayerListSep -> LayerListSep -> LayerListSep
$cmax :: LayerListSep -> LayerListSep -> LayerListSep
>= :: LayerListSep -> LayerListSep -> Bool
$c>= :: LayerListSep -> LayerListSep -> Bool
> :: LayerListSep -> LayerListSep -> Bool
$c> :: LayerListSep -> LayerListSep -> Bool
<= :: LayerListSep -> LayerListSep -> Bool
$c<= :: LayerListSep -> LayerListSep -> Bool
< :: LayerListSep -> LayerListSep -> Bool
$c< :: LayerListSep -> LayerListSep -> Bool
compare :: LayerListSep -> LayerListSep -> Ordering
$ccompare :: LayerListSep -> LayerListSep -> Ordering
Ord, Int -> LayerListSep -> ShowS
[LayerListSep] -> ShowS
LayerListSep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerListSep] -> ShowS
$cshowList :: [LayerListSep] -> ShowS
show :: LayerListSep -> String
$cshow :: LayerListSep -> String
showsPrec :: Int -> LayerListSep -> ShowS
$cshowsPrec :: Int -> LayerListSep -> ShowS
Show, ReadPrec [LayerListSep]
ReadPrec LayerListSep
Int -> ReadS LayerListSep
ReadS [LayerListSep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerListSep]
$creadListPrec :: ReadPrec [LayerListSep]
readPrec :: ReadPrec LayerListSep
$creadPrec :: ReadPrec LayerListSep
readList :: ReadS [LayerListSep]
$creadList :: ReadS [LayerListSep]
readsPrec :: Int -> ReadS LayerListSep
$creadsPrec :: Int -> ReadS LayerListSep
Read)

instance PrintDot LayerListSep where
  unqtDot :: LayerListSep -> DotCode
unqtDot (LLSep Text
ls) = forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerListSep (Text -> String
T.unpack Text
ls) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. PrintDot a => a -> DotCode
unqtDot Text
ls

  toDot :: LayerListSep -> DotCode
toDot (LLSep Text
ls) = forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerListSep (Text -> String
T.unpack Text
ls) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. PrintDot a => a -> DotCode
toDot Text
ls

instance ParseDot LayerListSep where
  parseUnqt :: Parse LayerListSep
parseUnqt = do Text
ls <- forall a. ParseDot a => Parse a
parseUnqt
                 forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerListSep forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ls
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LayerListSep
LLSep Text
ls

  parse :: Parse LayerListSep
parse = do Text
ls <- forall a. ParseDot a => Parse a
parse
             forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerListSep forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ls
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LayerListSep
LLSep Text
ls

type LayerRange = [LayerRangeElem]

data LayerRangeElem = LRID LayerID
                    | LRS LayerID LayerID
                    deriving (LayerRangeElem -> LayerRangeElem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerRangeElem -> LayerRangeElem -> Bool
$c/= :: LayerRangeElem -> LayerRangeElem -> Bool
== :: LayerRangeElem -> LayerRangeElem -> Bool
$c== :: LayerRangeElem -> LayerRangeElem -> Bool
Eq, Eq LayerRangeElem
LayerRangeElem -> LayerRangeElem -> Bool
LayerRangeElem -> LayerRangeElem -> Ordering
LayerRangeElem -> LayerRangeElem -> LayerRangeElem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayerRangeElem -> LayerRangeElem -> LayerRangeElem
$cmin :: LayerRangeElem -> LayerRangeElem -> LayerRangeElem
max :: LayerRangeElem -> LayerRangeElem -> LayerRangeElem
$cmax :: LayerRangeElem -> LayerRangeElem -> LayerRangeElem
>= :: LayerRangeElem -> LayerRangeElem -> Bool
$c>= :: LayerRangeElem -> LayerRangeElem -> Bool
> :: LayerRangeElem -> LayerRangeElem -> Bool
$c> :: LayerRangeElem -> LayerRangeElem -> Bool
<= :: LayerRangeElem -> LayerRangeElem -> Bool
$c<= :: LayerRangeElem -> LayerRangeElem -> Bool
< :: LayerRangeElem -> LayerRangeElem -> Bool
$c< :: LayerRangeElem -> LayerRangeElem -> Bool
compare :: LayerRangeElem -> LayerRangeElem -> Ordering
$ccompare :: LayerRangeElem -> LayerRangeElem -> Ordering
Ord, Int -> LayerRangeElem -> ShowS
[LayerRangeElem] -> ShowS
LayerRangeElem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerRangeElem] -> ShowS
$cshowList :: [LayerRangeElem] -> ShowS
show :: LayerRangeElem -> String
$cshow :: LayerRangeElem -> String
showsPrec :: Int -> LayerRangeElem -> ShowS
$cshowsPrec :: Int -> LayerRangeElem -> ShowS
Show, ReadPrec [LayerRangeElem]
ReadPrec LayerRangeElem
Int -> ReadS LayerRangeElem
ReadS [LayerRangeElem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerRangeElem]
$creadListPrec :: ReadPrec [LayerRangeElem]
readPrec :: ReadPrec LayerRangeElem
$creadPrec :: ReadPrec LayerRangeElem
readList :: ReadS [LayerRangeElem]
$creadList :: ReadS [LayerRangeElem]
readsPrec :: Int -> ReadS LayerRangeElem
$creadsPrec :: Int -> ReadS LayerRangeElem
Read)

instance PrintDot LayerRangeElem where
  unqtDot :: LayerRangeElem -> DotCode
unqtDot (LRID LayerID
lid)    = forall a. PrintDot a => a -> DotCode
unqtDot LayerID
lid
  unqtDot (LRS LayerID
id1 LayerID
id2) = do String
ls <- forall (m :: * -> *). GraphvizStateM m => m String
getLayerSep
                             let s :: DotCode
s = forall a. PrintDot a => a -> DotCode
unqtDot forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head String
ls
                             forall a. PrintDot a => a -> DotCode
unqtDot LayerID
id1 forall a. Semigroup a => a -> a -> a
<> DotCode
s forall a. Semigroup a => a -> a -> a
<> forall a. PrintDot a => a -> DotCode
unqtDot LayerID
id2

  toDot :: LayerRangeElem -> DotCode
toDot (LRID LayerID
lid) = forall a. PrintDot a => a -> DotCode
toDot LayerID
lid
  toDot LayerRangeElem
lrs        = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot LayerRangeElem
lrs

  unqtListToDot :: [LayerRangeElem] -> DotCode
unqtListToDot [LayerRangeElem]
lr = do String
lls <- forall (m :: * -> *). GraphvizStateM m => m String
getLayerListSep
                        let s :: DotCode
s = forall a. PrintDot a => a -> DotCode
unqtDot forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head String
lls
                        forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate DotCode
s forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot [LayerRangeElem]
lr

  listToDot :: [LayerRangeElem] -> DotCode
listToDot [LayerRangeElem
lre] = forall a. PrintDot a => a -> DotCode
toDot LayerRangeElem
lre
  listToDot [LayerRangeElem]
lrs   = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => [a] -> DotCode
unqtListToDot [LayerRangeElem]
lrs

instance ParseDot LayerRangeElem where
  parseUnqt :: Parse LayerRangeElem
parseUnqt = forall a b c sep.
(a -> b -> c) -> Parse a -> Parse sep -> Parse b -> Parse c
ignoreSep LayerID -> LayerID -> LayerRangeElem
LRS forall a. ParseDot a => Parse a
parseUnqt Parse ()
parseLayerSep forall a. ParseDot a => Parse a
parseUnqt
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LayerID -> LayerRangeElem
LRID forall a. ParseDot a => Parse a
parseUnqt

  parse :: Parse LayerRangeElem
parse = forall a. Parse a -> Parse a
quotedParse (forall a b c sep.
(a -> b -> c) -> Parse a -> Parse sep -> Parse b -> Parse c
ignoreSep LayerID -> LayerID -> LayerRangeElem
LRS forall a. ParseDot a => Parse a
parseUnqt Parse ()
parseLayerSep forall a. ParseDot a => Parse a
parseUnqt)
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LayerID -> LayerRangeElem
LRID forall a. ParseDot a => Parse a
parse

  parseUnqtList :: Parse [LayerRangeElem]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy forall a. ParseDot a => Parse a
parseUnqt Parse ()
parseLayerListSep

  parseList :: Parse [LayerRangeElem]
parseList = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse [a]
parseUnqtList
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayerID -> LayerRangeElem
LRID) forall a. ParseDot a => Parse a
parse

parseLayerSep :: Parse ()
parseLayerSep :: Parse ()
parseLayerSep = do String
ls <- forall (m :: * -> *). GraphvizStateM m => m String
getLayerSep
                   forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ls) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()

parseLayerName :: Parse Text
parseLayerName :: Parse Text
parseLayerName = Bool -> String -> String -> Parse Text
parseEscaped Bool
False [] forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. [a] -> [a] -> [a]
(++) forall (m :: * -> *). GraphvizStateM m => m String
getLayerSep forall (m :: * -> *). GraphvizStateM m => m String
getLayerListSep

parseLayerName' :: Parse Text
parseLayerName' :: Parse Text
parseLayerName' = Parse Text
stringBlock
                  forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
                  forall a. Parse a -> Parse a
quotedParse Parse Text
parseLayerName

parseLayerListSep :: Parse ()
parseLayerListSep :: Parse ()
parseLayerListSep = do String
lls <- forall (m :: * -> *). GraphvizStateM m => m String
getLayerListSep
                       forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
lls) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | You should not have any layer separator characters for the
--   'LRName' option, as they won't be parseable.
data LayerID = AllLayers
             | LRInt Int
             | LRName Text -- ^ Should not be a number or @"all"@.
             deriving (LayerID -> LayerID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerID -> LayerID -> Bool
$c/= :: LayerID -> LayerID -> Bool
== :: LayerID -> LayerID -> Bool
$c== :: LayerID -> LayerID -> Bool
Eq, Eq LayerID
LayerID -> LayerID -> Bool
LayerID -> LayerID -> Ordering
LayerID -> LayerID -> LayerID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayerID -> LayerID -> LayerID
$cmin :: LayerID -> LayerID -> LayerID
max :: LayerID -> LayerID -> LayerID
$cmax :: LayerID -> LayerID -> LayerID
>= :: LayerID -> LayerID -> Bool
$c>= :: LayerID -> LayerID -> Bool
> :: LayerID -> LayerID -> Bool
$c> :: LayerID -> LayerID -> Bool
<= :: LayerID -> LayerID -> Bool
$c<= :: LayerID -> LayerID -> Bool
< :: LayerID -> LayerID -> Bool
$c< :: LayerID -> LayerID -> Bool
compare :: LayerID -> LayerID -> Ordering
$ccompare :: LayerID -> LayerID -> Ordering
Ord, Int -> LayerID -> ShowS
[LayerID] -> ShowS
LayerID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerID] -> ShowS
$cshowList :: [LayerID] -> ShowS
show :: LayerID -> String
$cshow :: LayerID -> String
showsPrec :: Int -> LayerID -> ShowS
$cshowsPrec :: Int -> LayerID -> ShowS
Show, ReadPrec [LayerID]
ReadPrec LayerID
Int -> ReadS LayerID
ReadS [LayerID]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerID]
$creadListPrec :: ReadPrec [LayerID]
readPrec :: ReadPrec LayerID
$creadPrec :: ReadPrec LayerID
readList :: ReadS [LayerID]
$creadList :: ReadS [LayerID]
readsPrec :: Int -> ReadS LayerID
$creadsPrec :: Int -> ReadS LayerID
Read)

instance PrintDot LayerID where
  unqtDot :: LayerID -> DotCode
unqtDot LayerID
AllLayers   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"all"
  unqtDot (LRInt Int
n)   = forall a. PrintDot a => a -> DotCode
unqtDot Int
n
  unqtDot (LRName Text
nm) = forall a. PrintDot a => a -> DotCode
unqtDot Text
nm

  toDot :: LayerID -> DotCode
toDot (LRName Text
nm) = forall a. PrintDot a => a -> DotCode
toDot Text
nm
  -- Other two don't need quotes
  toDot LayerID
li          = forall a. PrintDot a => a -> DotCode
unqtDot LayerID
li

  unqtListToDot :: [LayerID] -> DotCode
unqtListToDot [LayerID]
ll = do String
ls <- forall (m :: * -> *). GraphvizStateM m => m String
getLayerSep
                        let s :: DotCode
s = forall a. PrintDot a => a -> DotCode
unqtDot forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head String
ls
                        forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate DotCode
s forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot [LayerID]
ll

  listToDot :: [LayerID] -> DotCode
listToDot [LayerID
l] = forall a. PrintDot a => a -> DotCode
toDot LayerID
l
  -- Might not need quotes, but probably will.  Can't tell either
  -- way since we don't know what the separator character will be.
  listToDot [LayerID]
ll  = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot [LayerID]
ll

instance ParseDot LayerID where
  parseUnqt :: Parse LayerID
parseUnqt = Text -> LayerID
checkLayerName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Text
parseLayerName -- tests for Int and All

  parse :: Parse LayerID
parse = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Text -> LayerID
checkLayerName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Text
parseLayerName'
                , Int -> LayerID
LRInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse -- Mainly for unquoted case.
                ]

checkLayerName     :: Text -> LayerID
checkLayerName :: Text -> LayerID
checkLayerName Text
str = forall b a. b -> (a -> b) -> Maybe a -> b
maybe LayerID
checkAll Int -> LayerID
LRInt forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
stringToInt Text
str
  where
    checkAll :: LayerID
checkAll = if Text -> Text
T.toLower Text
str forall a. Eq a => a -> a -> Bool
== Text
"all"
               then LayerID
AllLayers
               else Text -> LayerID
LRName Text
str

-- Remember: this /must/ be a newtype as we can't use arbitrary
-- LayerID values!

-- | A list of layer names.  The names should all be unique 'LRName'
--   values, and when printed will use an arbitrary character from
--   'defLayerSep'.  The values in the list are implicitly numbered
--   @1, 2, ...@.
newtype LayerList = LL [LayerID]
                  deriving (LayerList -> LayerList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerList -> LayerList -> Bool
$c/= :: LayerList -> LayerList -> Bool
== :: LayerList -> LayerList -> Bool
$c== :: LayerList -> LayerList -> Bool
Eq, Eq LayerList
LayerList -> LayerList -> Bool
LayerList -> LayerList -> Ordering
LayerList -> LayerList -> LayerList
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LayerList -> LayerList -> LayerList
$cmin :: LayerList -> LayerList -> LayerList
max :: LayerList -> LayerList -> LayerList
$cmax :: LayerList -> LayerList -> LayerList
>= :: LayerList -> LayerList -> Bool
$c>= :: LayerList -> LayerList -> Bool
> :: LayerList -> LayerList -> Bool
$c> :: LayerList -> LayerList -> Bool
<= :: LayerList -> LayerList -> Bool
$c<= :: LayerList -> LayerList -> Bool
< :: LayerList -> LayerList -> Bool
$c< :: LayerList -> LayerList -> Bool
compare :: LayerList -> LayerList -> Ordering
$ccompare :: LayerList -> LayerList -> Ordering
Ord, Int -> LayerList -> ShowS
[LayerList] -> ShowS
LayerList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerList] -> ShowS
$cshowList :: [LayerList] -> ShowS
show :: LayerList -> String
$cshow :: LayerList -> String
showsPrec :: Int -> LayerList -> ShowS
$cshowsPrec :: Int -> LayerList -> ShowS
Show, ReadPrec [LayerList]
ReadPrec LayerList
Int -> ReadS LayerList
ReadS [LayerList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerList]
$creadListPrec :: ReadPrec [LayerList]
readPrec :: ReadPrec LayerList
$creadPrec :: ReadPrec LayerList
readList :: ReadS [LayerList]
$creadList :: ReadS [LayerList]
readsPrec :: Int -> ReadS LayerList
$creadsPrec :: Int -> ReadS LayerList
Read)

instance PrintDot LayerList where
  unqtDot :: LayerList -> DotCode
unqtDot (LL [LayerID]
ll) = forall a. PrintDot a => a -> DotCode
unqtDot [LayerID]
ll

  toDot :: LayerList -> DotCode
toDot (LL [LayerID]
ll) = forall a. PrintDot a => a -> DotCode
toDot [LayerID]
ll

instance ParseDot LayerList where
  parseUnqt :: Parse LayerList
parseUnqt = [LayerID] -> LayerList
LL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt Parse ()
parseLayerSep

  parse :: Parse LayerList
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([LayerID] -> LayerList
LL forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LayerID
LRName) Parse Text
stringBlock
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall a. Parse a -> Parse a
quotedParse (forall a. a -> String -> Parse a
stringRep ([LayerID] -> LayerList
LL []) String
"")

-- -----------------------------------------------------------------------------

data Order = OutEdges -- ^ Draw outgoing edges in order specified.
           | InEdges  -- ^ Draw incoming edges in order specified.
           deriving (Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Eq Order
Order -> Order -> Bool
Order -> Order -> Ordering
Order -> Order -> Order
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Order -> Order -> Order
$cmin :: Order -> Order -> Order
max :: Order -> Order -> Order
$cmax :: Order -> Order -> Order
>= :: Order -> Order -> Bool
$c>= :: Order -> Order -> Bool
> :: Order -> Order -> Bool
$c> :: Order -> Order -> Bool
<= :: Order -> Order -> Bool
$c<= :: Order -> Order -> Bool
< :: Order -> Order -> Bool
$c< :: Order -> Order -> Bool
compare :: Order -> Order -> Ordering
$ccompare :: Order -> Order -> Ordering
Ord, Order
forall a. a -> a -> Bounded a
maxBound :: Order
$cmaxBound :: Order
minBound :: Order
$cminBound :: Order
Bounded, Int -> Order
Order -> Int
Order -> [Order]
Order -> Order
Order -> Order -> [Order]
Order -> Order -> Order -> [Order]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Order -> Order -> Order -> [Order]
$cenumFromThenTo :: Order -> Order -> Order -> [Order]
enumFromTo :: Order -> Order -> [Order]
$cenumFromTo :: Order -> Order -> [Order]
enumFromThen :: Order -> Order -> [Order]
$cenumFromThen :: Order -> Order -> [Order]
enumFrom :: Order -> [Order]
$cenumFrom :: Order -> [Order]
fromEnum :: Order -> Int
$cfromEnum :: Order -> Int
toEnum :: Int -> Order
$ctoEnum :: Int -> Order
pred :: Order -> Order
$cpred :: Order -> Order
succ :: Order -> Order
$csucc :: Order -> Order
Enum, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show, ReadPrec [Order]
ReadPrec Order
Int -> ReadS Order
ReadS [Order]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Order]
$creadListPrec :: ReadPrec [Order]
readPrec :: ReadPrec Order
$creadPrec :: ReadPrec Order
readList :: ReadS [Order]
$creadList :: ReadS [Order]
readsPrec :: Int -> ReadS Order
$creadsPrec :: Int -> ReadS Order
Read)

instance PrintDot Order where
  unqtDot :: Order -> DotCode
unqtDot Order
OutEdges = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"out"
  unqtDot Order
InEdges  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"in"

instance ParseDot Order where
  parseUnqt :: Parse Order
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Order
OutEdges String
"out"
                    , forall a. a -> String -> Parse a
stringRep Order
InEdges  String
"in"
                    ]

-- -----------------------------------------------------------------------------

data OutputMode = BreadthFirst | NodesFirst | EdgesFirst
                deriving (OutputMode -> OutputMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputMode -> OutputMode -> Bool
$c/= :: OutputMode -> OutputMode -> Bool
== :: OutputMode -> OutputMode -> Bool
$c== :: OutputMode -> OutputMode -> Bool
Eq, Eq OutputMode
OutputMode -> OutputMode -> Bool
OutputMode -> OutputMode -> Ordering
OutputMode -> OutputMode -> OutputMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputMode -> OutputMode -> OutputMode
$cmin :: OutputMode -> OutputMode -> OutputMode
max :: OutputMode -> OutputMode -> OutputMode
$cmax :: OutputMode -> OutputMode -> OutputMode
>= :: OutputMode -> OutputMode -> Bool
$c>= :: OutputMode -> OutputMode -> Bool
> :: OutputMode -> OutputMode -> Bool
$c> :: OutputMode -> OutputMode -> Bool
<= :: OutputMode -> OutputMode -> Bool
$c<= :: OutputMode -> OutputMode -> Bool
< :: OutputMode -> OutputMode -> Bool
$c< :: OutputMode -> OutputMode -> Bool
compare :: OutputMode -> OutputMode -> Ordering
$ccompare :: OutputMode -> OutputMode -> Ordering
Ord, OutputMode
forall a. a -> a -> Bounded a
maxBound :: OutputMode
$cmaxBound :: OutputMode
minBound :: OutputMode
$cminBound :: OutputMode
Bounded, Int -> OutputMode
OutputMode -> Int
OutputMode -> [OutputMode]
OutputMode -> OutputMode
OutputMode -> OutputMode -> [OutputMode]
OutputMode -> OutputMode -> OutputMode -> [OutputMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OutputMode -> OutputMode -> OutputMode -> [OutputMode]
$cenumFromThenTo :: OutputMode -> OutputMode -> OutputMode -> [OutputMode]
enumFromTo :: OutputMode -> OutputMode -> [OutputMode]
$cenumFromTo :: OutputMode -> OutputMode -> [OutputMode]
enumFromThen :: OutputMode -> OutputMode -> [OutputMode]
$cenumFromThen :: OutputMode -> OutputMode -> [OutputMode]
enumFrom :: OutputMode -> [OutputMode]
$cenumFrom :: OutputMode -> [OutputMode]
fromEnum :: OutputMode -> Int
$cfromEnum :: OutputMode -> Int
toEnum :: Int -> OutputMode
$ctoEnum :: Int -> OutputMode
pred :: OutputMode -> OutputMode
$cpred :: OutputMode -> OutputMode
succ :: OutputMode -> OutputMode
$csucc :: OutputMode -> OutputMode
Enum, Int -> OutputMode -> ShowS
[OutputMode] -> ShowS
OutputMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputMode] -> ShowS
$cshowList :: [OutputMode] -> ShowS
show :: OutputMode -> String
$cshow :: OutputMode -> String
showsPrec :: Int -> OutputMode -> ShowS
$cshowsPrec :: Int -> OutputMode -> ShowS
Show, ReadPrec [OutputMode]
ReadPrec OutputMode
Int -> ReadS OutputMode
ReadS [OutputMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutputMode]
$creadListPrec :: ReadPrec [OutputMode]
readPrec :: ReadPrec OutputMode
$creadPrec :: ReadPrec OutputMode
readList :: ReadS [OutputMode]
$creadList :: ReadS [OutputMode]
readsPrec :: Int -> ReadS OutputMode
$creadsPrec :: Int -> ReadS OutputMode
Read)

instance PrintDot OutputMode where
  unqtDot :: OutputMode -> DotCode
unqtDot OutputMode
BreadthFirst = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"breadthfirst"
  unqtDot OutputMode
NodesFirst   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"nodesfirst"
  unqtDot OutputMode
EdgesFirst   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"edgesfirst"

instance ParseDot OutputMode where
  parseUnqt :: Parse OutputMode
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep OutputMode
BreadthFirst String
"breadthfirst"
                    , forall a. a -> String -> Parse a
stringRep OutputMode
NodesFirst String
"nodesfirst"
                    , forall a. a -> String -> Parse a
stringRep OutputMode
EdgesFirst String
"edgesfirst"
                    ]

-- -----------------------------------------------------------------------------

data Pack = DoPack
          | DontPack
          | PackMargin Int -- ^ If non-negative, then packs; otherwise doesn't.
          deriving (Pack -> Pack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pack -> Pack -> Bool
$c/= :: Pack -> Pack -> Bool
== :: Pack -> Pack -> Bool
$c== :: Pack -> Pack -> Bool
Eq, Eq Pack
Pack -> Pack -> Bool
Pack -> Pack -> Ordering
Pack -> Pack -> Pack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pack -> Pack -> Pack
$cmin :: Pack -> Pack -> Pack
max :: Pack -> Pack -> Pack
$cmax :: Pack -> Pack -> Pack
>= :: Pack -> Pack -> Bool
$c>= :: Pack -> Pack -> Bool
> :: Pack -> Pack -> Bool
$c> :: Pack -> Pack -> Bool
<= :: Pack -> Pack -> Bool
$c<= :: Pack -> Pack -> Bool
< :: Pack -> Pack -> Bool
$c< :: Pack -> Pack -> Bool
compare :: Pack -> Pack -> Ordering
$ccompare :: Pack -> Pack -> Ordering
Ord, Int -> Pack -> ShowS
[Pack] -> ShowS
Pack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pack] -> ShowS
$cshowList :: [Pack] -> ShowS
show :: Pack -> String
$cshow :: Pack -> String
showsPrec :: Int -> Pack -> ShowS
$cshowsPrec :: Int -> Pack -> ShowS
Show, ReadPrec [Pack]
ReadPrec Pack
Int -> ReadS Pack
ReadS [Pack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pack]
$creadListPrec :: ReadPrec [Pack]
readPrec :: ReadPrec Pack
$creadPrec :: ReadPrec Pack
readList :: ReadS [Pack]
$creadList :: ReadS [Pack]
readsPrec :: Int -> ReadS Pack
$creadsPrec :: Int -> ReadS Pack
Read)

instance PrintDot Pack where
  unqtDot :: Pack -> DotCode
unqtDot Pack
DoPack         = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot Pack
DontPack       = forall a. PrintDot a => a -> DotCode
unqtDot Bool
False
  unqtDot (PackMargin Int
m) = forall a. PrintDot a => a -> DotCode
unqtDot Int
m

instance ParseDot Pack where
  -- What happens if it parses 0?  It's non-negative, but parses as False
  parseUnqt :: Parse Pack
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Int -> Pack
PackMargin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                    , forall a. a -> a -> Bool -> a
bool Pack
DontPack Pack
DoPack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState Bool
onlyBool
                    ]

-- -----------------------------------------------------------------------------

data PackMode = PackNode
              | PackClust
              | PackGraph
              | PackArray Bool Bool (Maybe Int) -- ^ Sort by cols, sort
                                                -- by user, number of
                                                -- rows/cols
              deriving (PackMode -> PackMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackMode -> PackMode -> Bool
$c/= :: PackMode -> PackMode -> Bool
== :: PackMode -> PackMode -> Bool
$c== :: PackMode -> PackMode -> Bool
Eq, Eq PackMode
PackMode -> PackMode -> Bool
PackMode -> PackMode -> Ordering
PackMode -> PackMode -> PackMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackMode -> PackMode -> PackMode
$cmin :: PackMode -> PackMode -> PackMode
max :: PackMode -> PackMode -> PackMode
$cmax :: PackMode -> PackMode -> PackMode
>= :: PackMode -> PackMode -> Bool
$c>= :: PackMode -> PackMode -> Bool
> :: PackMode -> PackMode -> Bool
$c> :: PackMode -> PackMode -> Bool
<= :: PackMode -> PackMode -> Bool
$c<= :: PackMode -> PackMode -> Bool
< :: PackMode -> PackMode -> Bool
$c< :: PackMode -> PackMode -> Bool
compare :: PackMode -> PackMode -> Ordering
$ccompare :: PackMode -> PackMode -> Ordering
Ord, Int -> PackMode -> ShowS
[PackMode] -> ShowS
PackMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackMode] -> ShowS
$cshowList :: [PackMode] -> ShowS
show :: PackMode -> String
$cshow :: PackMode -> String
showsPrec :: Int -> PackMode -> ShowS
$cshowsPrec :: Int -> PackMode -> ShowS
Show, ReadPrec [PackMode]
ReadPrec PackMode
Int -> ReadS PackMode
ReadS [PackMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackMode]
$creadListPrec :: ReadPrec [PackMode]
readPrec :: ReadPrec PackMode
$creadPrec :: ReadPrec PackMode
readList :: ReadS [PackMode]
$creadList :: ReadS [PackMode]
readsPrec :: Int -> ReadS PackMode
$creadsPrec :: Int -> ReadS PackMode
Read)

instance PrintDot PackMode where
  unqtDot :: PackMode -> DotCode
unqtDot PackMode
PackNode           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"node"
  unqtDot PackMode
PackClust          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"clust"
  unqtDot PackMode
PackGraph          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"graph"
  unqtDot (PackArray Bool
c Bool
u Maybe Int
mi) = DotCode -> DotCode
addNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCode -> DotCode
isU forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCode -> DotCode
isC forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCode -> DotCode
isUnder
                               forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"array"
    where
      addNum :: DotCode -> DotCode
addNum = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot) Maybe Int
mi
      isUnder :: DotCode -> DotCode
isUnder = if Bool
c Bool -> Bool -> Bool
|| Bool
u
                then (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'_')
                else forall a. a -> a
id
      isC :: DotCode -> DotCode
isC = if Bool
c
            then (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'c')
            else forall a. a -> a
id
      isU :: DotCode -> DotCode
isU = if Bool
u
            then (forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'u')
            else forall a. a -> a
id

instance ParseDot PackMode where
  parseUnqt :: Parse PackMode
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep PackMode
PackNode String
"node"
                    , forall a. a -> String -> Parse a
stringRep PackMode
PackClust String
"clust"
                    , forall a. a -> String -> Parse a
stringRep PackMode
PackGraph String
"graph"
                    , do String -> Parse ()
string String
"array"
                         Maybe String
mcu <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Char -> Parse Char
character Char
'_' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
isCU)
                         let c :: Bool
c = forall {t :: * -> *} {a}.
(Foldable t, Eq a) =>
Maybe (t a) -> a -> Bool
hasCharacter Maybe String
mcu Char
'c'
                             u :: Bool
u = forall {t :: * -> *} {a}.
(Foldable t, Eq a) =>
Maybe (t a) -> a -> Bool
hasCharacter Maybe String
mcu Char
'u'
                         Maybe Int
mi <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a. ParseDot a => Parse a
parseUnqt
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Maybe Int -> PackMode
PackArray Bool
c Bool
u Maybe Int
mi
                    ]
    where
      hasCharacter :: Maybe (t a) -> a -> Bool
hasCharacter Maybe (t a)
ms a
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
c) Maybe (t a)
ms
      -- Also checks and removes quote characters
      isCU :: Char -> Bool
isCU = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'c', Char
'u'])

-- -----------------------------------------------------------------------------

data Pos = PointPos Point
         | SplinePos [Spline]
         deriving (Pos -> Pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
Ord, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, ReadPrec [Pos]
ReadPrec Pos
Int -> ReadS Pos
ReadS [Pos]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pos]
$creadListPrec :: ReadPrec [Pos]
readPrec :: ReadPrec Pos
$creadPrec :: ReadPrec Pos
readList :: ReadS [Pos]
$creadList :: ReadS [Pos]
readsPrec :: Int -> ReadS Pos
$creadsPrec :: Int -> ReadS Pos
Read)

instance PrintDot Pos where
  unqtDot :: Pos -> DotCode
unqtDot (PointPos Point
p)   = forall a. PrintDot a => a -> DotCode
unqtDot Point
p
  unqtDot (SplinePos [Spline]
ss) = forall a. PrintDot a => a -> DotCode
unqtDot [Spline]
ss

  toDot :: Pos -> DotCode
toDot (PointPos Point
p)   = forall a. PrintDot a => a -> DotCode
toDot Point
p
  toDot (SplinePos [Spline]
ss) = forall a. PrintDot a => a -> DotCode
toDot [Spline]
ss

instance ParseDot Pos where
  -- Have to be careful with this: if we try to parse points first,
  -- then a spline with no start and end points will erroneously get
  -- parsed as a point and then the parser will crash as it expects a
  -- closing quote character...
  parseUnqt :: Parse Pos
parseUnqt = do [Spline]
splns <- forall a. ParseDot a => Parse a
parseUnqt
                 case [Spline]
splns of
                   [Spline Maybe Point
Nothing Maybe Point
Nothing [Point
p]] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Point -> Pos
PointPos Point
p
                   [Spline]
_                            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Spline] -> Pos
SplinePos [Spline]
splns

  parse :: Parse Pos
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt

-- -----------------------------------------------------------------------------

-- | Controls how (and if) edges are represented.
--
--   For 'Dot', the default is 'SplineEdges'; for all other layouts
--   the default is 'LineEdges'.
data EdgeType = SplineEdges -- ^ Except for 'Dot', requires
                            --   non-overlapping nodes (see
                            --   'Overlap').
              | LineEdges
              | NoEdges
              | PolyLine
              | Ortho -- ^ Does not handle ports or edge labels in 'Dot'.
              | Curved -- ^ Requires Graphviz >= 2.30.0.
              | CompoundEdge -- ^ 'Fdp' only
              deriving (EdgeType -> EdgeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeType -> EdgeType -> Bool
$c/= :: EdgeType -> EdgeType -> Bool
== :: EdgeType -> EdgeType -> Bool
$c== :: EdgeType -> EdgeType -> Bool
Eq, Eq EdgeType
EdgeType -> EdgeType -> Bool
EdgeType -> EdgeType -> Ordering
EdgeType -> EdgeType -> EdgeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EdgeType -> EdgeType -> EdgeType
$cmin :: EdgeType -> EdgeType -> EdgeType
max :: EdgeType -> EdgeType -> EdgeType
$cmax :: EdgeType -> EdgeType -> EdgeType
>= :: EdgeType -> EdgeType -> Bool
$c>= :: EdgeType -> EdgeType -> Bool
> :: EdgeType -> EdgeType -> Bool
$c> :: EdgeType -> EdgeType -> Bool
<= :: EdgeType -> EdgeType -> Bool
$c<= :: EdgeType -> EdgeType -> Bool
< :: EdgeType -> EdgeType -> Bool
$c< :: EdgeType -> EdgeType -> Bool
compare :: EdgeType -> EdgeType -> Ordering
$ccompare :: EdgeType -> EdgeType -> Ordering
Ord, EdgeType
forall a. a -> a -> Bounded a
maxBound :: EdgeType
$cmaxBound :: EdgeType
minBound :: EdgeType
$cminBound :: EdgeType
Bounded, Int -> EdgeType
EdgeType -> Int
EdgeType -> [EdgeType]
EdgeType -> EdgeType
EdgeType -> EdgeType -> [EdgeType]
EdgeType -> EdgeType -> EdgeType -> [EdgeType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EdgeType -> EdgeType -> EdgeType -> [EdgeType]
$cenumFromThenTo :: EdgeType -> EdgeType -> EdgeType -> [EdgeType]
enumFromTo :: EdgeType -> EdgeType -> [EdgeType]
$cenumFromTo :: EdgeType -> EdgeType -> [EdgeType]
enumFromThen :: EdgeType -> EdgeType -> [EdgeType]
$cenumFromThen :: EdgeType -> EdgeType -> [EdgeType]
enumFrom :: EdgeType -> [EdgeType]
$cenumFrom :: EdgeType -> [EdgeType]
fromEnum :: EdgeType -> Int
$cfromEnum :: EdgeType -> Int
toEnum :: Int -> EdgeType
$ctoEnum :: Int -> EdgeType
pred :: EdgeType -> EdgeType
$cpred :: EdgeType -> EdgeType
succ :: EdgeType -> EdgeType
$csucc :: EdgeType -> EdgeType
Enum, Int -> EdgeType -> ShowS
[EdgeType] -> ShowS
EdgeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeType] -> ShowS
$cshowList :: [EdgeType] -> ShowS
show :: EdgeType -> String
$cshow :: EdgeType -> String
showsPrec :: Int -> EdgeType -> ShowS
$cshowsPrec :: Int -> EdgeType -> ShowS
Show, ReadPrec [EdgeType]
ReadPrec EdgeType
Int -> ReadS EdgeType
ReadS [EdgeType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EdgeType]
$creadListPrec :: ReadPrec [EdgeType]
readPrec :: ReadPrec EdgeType
$creadPrec :: ReadPrec EdgeType
readList :: ReadS [EdgeType]
$creadList :: ReadS [EdgeType]
readsPrec :: Int -> ReadS EdgeType
$creadsPrec :: Int -> ReadS EdgeType
Read)

instance PrintDot EdgeType where
  unqtDot :: EdgeType -> DotCode
unqtDot EdgeType
SplineEdges  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"spline"
  unqtDot EdgeType
LineEdges    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"line"
  unqtDot EdgeType
NoEdges      = forall (m :: * -> *). Applicative m => m Doc
empty
  unqtDot EdgeType
PolyLine     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"polyline"
  unqtDot EdgeType
Ortho        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ortho"
  unqtDot EdgeType
Curved       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"curved"
  unqtDot EdgeType
CompoundEdge = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"compound"

  toDot :: EdgeType -> DotCode
toDot EdgeType
NoEdges = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall (m :: * -> *). Applicative m => m Doc
empty
  toDot EdgeType
et      = forall a. PrintDot a => a -> DotCode
unqtDot EdgeType
et

instance ParseDot EdgeType where
  -- Can't parse NoEdges without quotes.
  parseUnqt :: Parse EdgeType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> a -> Bool -> a
bool EdgeType
LineEdges EdgeType
SplineEdges forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse
                    , forall a. a -> String -> Parse a
stringRep EdgeType
SplineEdges String
"spline"
                    , forall a. a -> String -> Parse a
stringRep EdgeType
LineEdges String
"line"
                    , forall a. a -> String -> Parse a
stringRep EdgeType
NoEdges String
"none"
                    , forall a. a -> String -> Parse a
stringRep EdgeType
PolyLine String
"polyline"
                    , forall a. a -> String -> Parse a
stringRep EdgeType
Ortho String
"ortho"
                    , forall a. a -> String -> Parse a
stringRep EdgeType
Curved String
"curved"
                    , forall a. a -> String -> Parse a
stringRep EdgeType
CompoundEdge String
"compound"
                    ]

  parse :: Parse EdgeType
parse = forall a. a -> String -> Parse a
stringRep EdgeType
NoEdges String
"\"\""
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall a. Parse a -> Parse a
optionalQuoted forall a. ParseDot a => Parse a
parseUnqt

-- -----------------------------------------------------------------------------

-- | Upper-case first character is major order;
--   lower-case second character is minor order.
data PageDir = Bl | Br | Tl | Tr | Rb | Rt | Lb | Lt
             deriving (PageDir -> PageDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageDir -> PageDir -> Bool
$c/= :: PageDir -> PageDir -> Bool
== :: PageDir -> PageDir -> Bool
$c== :: PageDir -> PageDir -> Bool
Eq, Eq PageDir
PageDir -> PageDir -> Bool
PageDir -> PageDir -> Ordering
PageDir -> PageDir -> PageDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PageDir -> PageDir -> PageDir
$cmin :: PageDir -> PageDir -> PageDir
max :: PageDir -> PageDir -> PageDir
$cmax :: PageDir -> PageDir -> PageDir
>= :: PageDir -> PageDir -> Bool
$c>= :: PageDir -> PageDir -> Bool
> :: PageDir -> PageDir -> Bool
$c> :: PageDir -> PageDir -> Bool
<= :: PageDir -> PageDir -> Bool
$c<= :: PageDir -> PageDir -> Bool
< :: PageDir -> PageDir -> Bool
$c< :: PageDir -> PageDir -> Bool
compare :: PageDir -> PageDir -> Ordering
$ccompare :: PageDir -> PageDir -> Ordering
Ord, PageDir
forall a. a -> a -> Bounded a
maxBound :: PageDir
$cmaxBound :: PageDir
minBound :: PageDir
$cminBound :: PageDir
Bounded, Int -> PageDir
PageDir -> Int
PageDir -> [PageDir]
PageDir -> PageDir
PageDir -> PageDir -> [PageDir]
PageDir -> PageDir -> PageDir -> [PageDir]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PageDir -> PageDir -> PageDir -> [PageDir]
$cenumFromThenTo :: PageDir -> PageDir -> PageDir -> [PageDir]
enumFromTo :: PageDir -> PageDir -> [PageDir]
$cenumFromTo :: PageDir -> PageDir -> [PageDir]
enumFromThen :: PageDir -> PageDir -> [PageDir]
$cenumFromThen :: PageDir -> PageDir -> [PageDir]
enumFrom :: PageDir -> [PageDir]
$cenumFrom :: PageDir -> [PageDir]
fromEnum :: PageDir -> Int
$cfromEnum :: PageDir -> Int
toEnum :: Int -> PageDir
$ctoEnum :: Int -> PageDir
pred :: PageDir -> PageDir
$cpred :: PageDir -> PageDir
succ :: PageDir -> PageDir
$csucc :: PageDir -> PageDir
Enum, Int -> PageDir -> ShowS
[PageDir] -> ShowS
PageDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageDir] -> ShowS
$cshowList :: [PageDir] -> ShowS
show :: PageDir -> String
$cshow :: PageDir -> String
showsPrec :: Int -> PageDir -> ShowS
$cshowsPrec :: Int -> PageDir -> ShowS
Show, ReadPrec [PageDir]
ReadPrec PageDir
Int -> ReadS PageDir
ReadS [PageDir]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PageDir]
$creadListPrec :: ReadPrec [PageDir]
readPrec :: ReadPrec PageDir
$creadPrec :: ReadPrec PageDir
readList :: ReadS [PageDir]
$creadList :: ReadS [PageDir]
readsPrec :: Int -> ReadS PageDir
$creadsPrec :: Int -> ReadS PageDir
Read)

instance PrintDot PageDir where
  unqtDot :: PageDir -> DotCode
unqtDot PageDir
Bl = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BL"
  unqtDot PageDir
Br = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BR"
  unqtDot PageDir
Tl = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TL"
  unqtDot PageDir
Tr = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TR"
  unqtDot PageDir
Rb = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RB"
  unqtDot PageDir
Rt = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RT"
  unqtDot PageDir
Lb = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LB"
  unqtDot PageDir
Lt = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LT"

instance ParseDot PageDir where
  parseUnqt :: Parse PageDir
parseUnqt = forall a. [(String, a)] -> Parse a
stringValue [ (String
"BL", PageDir
Bl)
                          , (String
"BR", PageDir
Br)
                          , (String
"TL", PageDir
Tl)
                          , (String
"TR", PageDir
Tr)
                          , (String
"RB", PageDir
Rb)
                          , (String
"RT", PageDir
Rt)
                          , (String
"LB", PageDir
Lb)
                          , (String
"LT", PageDir
Lt)
                          ]

-- -----------------------------------------------------------------------------

-- | The number of points in the list must be equivalent to 1 mod 3;
--   note that this is not checked.
data Spline = Spline { Spline -> Maybe Point
endPoint     :: Maybe Point
                     , Spline -> Maybe Point
startPoint   :: Maybe Point
                     , Spline -> [Point]
splinePoints :: [Point]
                     }
            deriving (Spline -> Spline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spline -> Spline -> Bool
$c/= :: Spline -> Spline -> Bool
== :: Spline -> Spline -> Bool
$c== :: Spline -> Spline -> Bool
Eq, Eq Spline
Spline -> Spline -> Bool
Spline -> Spline -> Ordering
Spline -> Spline -> Spline
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Spline -> Spline -> Spline
$cmin :: Spline -> Spline -> Spline
max :: Spline -> Spline -> Spline
$cmax :: Spline -> Spline -> Spline
>= :: Spline -> Spline -> Bool
$c>= :: Spline -> Spline -> Bool
> :: Spline -> Spline -> Bool
$c> :: Spline -> Spline -> Bool
<= :: Spline -> Spline -> Bool
$c<= :: Spline -> Spline -> Bool
< :: Spline -> Spline -> Bool
$c< :: Spline -> Spline -> Bool
compare :: Spline -> Spline -> Ordering
$ccompare :: Spline -> Spline -> Ordering
Ord, Int -> Spline -> ShowS
[Spline] -> ShowS
Spline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spline] -> ShowS
$cshowList :: [Spline] -> ShowS
show :: Spline -> String
$cshow :: Spline -> String
showsPrec :: Int -> Spline -> ShowS
$cshowsPrec :: Int -> Spline -> ShowS
Show, ReadPrec [Spline]
ReadPrec Spline
Int -> ReadS Spline
ReadS [Spline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Spline]
$creadListPrec :: ReadPrec [Spline]
readPrec :: ReadPrec Spline
$creadPrec :: ReadPrec Spline
readList :: ReadS [Spline]
$creadList :: ReadS [Spline]
readsPrec :: Int -> ReadS Spline
$creadsPrec :: Int -> ReadS Spline
Read)

instance PrintDot Spline where
  unqtDot :: Spline -> DotCode
unqtDot (Spline Maybe Point
me Maybe Point
ms [Point]
ps) = DotCode -> DotCode
addE forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCode -> DotCode
addS
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep
                             forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot [Point]
ps
    where
      addP :: a -> Maybe a -> DotCode -> DotCode
addP a
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
(<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (PrintDot a, PrintDot b) => a -> b -> DotCode
commaDel a
t)
      addS :: DotCode -> DotCode
addS = forall {a} {a}.
(PrintDot a, PrintDot a) =>
a -> Maybe a -> DotCode -> DotCode
addP Char
's' Maybe Point
ms
      addE :: DotCode -> DotCode
addE = forall {a} {a}.
(PrintDot a, PrintDot a) =>
a -> Maybe a -> DotCode -> DotCode
addP Char
'e' Maybe Point
me

  toDot :: Spline -> DotCode
toDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot

  unqtListToDot :: [Spline] -> DotCode
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate forall (m :: * -> *). Applicative m => m Doc
semi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot

  listToDot :: [Spline] -> DotCode
listToDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => [a] -> DotCode
unqtListToDot

instance ParseDot Spline where
  parseUnqt :: Parse Spline
parseUnqt = Maybe Point -> Maybe Point -> [Point] -> Spline
Spline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. ParseDot a => Char -> Parser GraphvizState (Maybe a)
parseP Char
'e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. ParseDot a => Char -> Parser GraphvizState (Maybe a)
parseP Char
's'
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt Parse ()
whitespace1
      where
        parseP :: Char -> Parser GraphvizState (Maybe a)
parseP Char
t = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parse Char
character Char
t forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
parseComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parseUnqt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parse ()
whitespace1)

  parse :: Parse Spline
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse [Spline]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt (Char -> Parse Char
character Char
';')

-- -----------------------------------------------------------------------------

data QuadType = NormalQT
              | FastQT
              | NoQT
              deriving (QuadType -> QuadType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadType -> QuadType -> Bool
$c/= :: QuadType -> QuadType -> Bool
== :: QuadType -> QuadType -> Bool
$c== :: QuadType -> QuadType -> Bool
Eq, Eq QuadType
QuadType -> QuadType -> Bool
QuadType -> QuadType -> Ordering
QuadType -> QuadType -> QuadType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuadType -> QuadType -> QuadType
$cmin :: QuadType -> QuadType -> QuadType
max :: QuadType -> QuadType -> QuadType
$cmax :: QuadType -> QuadType -> QuadType
>= :: QuadType -> QuadType -> Bool
$c>= :: QuadType -> QuadType -> Bool
> :: QuadType -> QuadType -> Bool
$c> :: QuadType -> QuadType -> Bool
<= :: QuadType -> QuadType -> Bool
$c<= :: QuadType -> QuadType -> Bool
< :: QuadType -> QuadType -> Bool
$c< :: QuadType -> QuadType -> Bool
compare :: QuadType -> QuadType -> Ordering
$ccompare :: QuadType -> QuadType -> Ordering
Ord, QuadType
forall a. a -> a -> Bounded a
maxBound :: QuadType
$cmaxBound :: QuadType
minBound :: QuadType
$cminBound :: QuadType
Bounded, Int -> QuadType
QuadType -> Int
QuadType -> [QuadType]
QuadType -> QuadType
QuadType -> QuadType -> [QuadType]
QuadType -> QuadType -> QuadType -> [QuadType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuadType -> QuadType -> QuadType -> [QuadType]
$cenumFromThenTo :: QuadType -> QuadType -> QuadType -> [QuadType]
enumFromTo :: QuadType -> QuadType -> [QuadType]
$cenumFromTo :: QuadType -> QuadType -> [QuadType]
enumFromThen :: QuadType -> QuadType -> [QuadType]
$cenumFromThen :: QuadType -> QuadType -> [QuadType]
enumFrom :: QuadType -> [QuadType]
$cenumFrom :: QuadType -> [QuadType]
fromEnum :: QuadType -> Int
$cfromEnum :: QuadType -> Int
toEnum :: Int -> QuadType
$ctoEnum :: Int -> QuadType
pred :: QuadType -> QuadType
$cpred :: QuadType -> QuadType
succ :: QuadType -> QuadType
$csucc :: QuadType -> QuadType
Enum, Int -> QuadType -> ShowS
[QuadType] -> ShowS
QuadType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuadType] -> ShowS
$cshowList :: [QuadType] -> ShowS
show :: QuadType -> String
$cshow :: QuadType -> String
showsPrec :: Int -> QuadType -> ShowS
$cshowsPrec :: Int -> QuadType -> ShowS
Show, ReadPrec [QuadType]
ReadPrec QuadType
Int -> ReadS QuadType
ReadS [QuadType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QuadType]
$creadListPrec :: ReadPrec [QuadType]
readPrec :: ReadPrec QuadType
$creadPrec :: ReadPrec QuadType
readList :: ReadS [QuadType]
$creadList :: ReadS [QuadType]
readsPrec :: Int -> ReadS QuadType
$creadsPrec :: Int -> ReadS QuadType
Read)

instance PrintDot QuadType where
  unqtDot :: QuadType -> DotCode
unqtDot QuadType
NormalQT = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"normal"
  unqtDot QuadType
FastQT   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"fast"
  unqtDot QuadType
NoQT     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"none"

instance ParseDot QuadType where
  -- Have to take into account the slightly different interpretation
  -- of Bool used as an option for parsing QuadType
  parseUnqt :: Parse QuadType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep QuadType
NormalQT String
"normal"
                    , forall a. a -> String -> Parse a
stringRep QuadType
FastQT String
"fast"
                    , forall a. a -> String -> Parse a
stringRep QuadType
NoQT String
"none"
                    , Char -> Parse Char
character Char
'2' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return QuadType
FastQT -- weird bool
                    , forall a. a -> a -> Bool -> a
bool QuadType
NoQT QuadType
NormalQT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse
                    ]

-- -----------------------------------------------------------------------------

-- | Specify the root node either as a Node attribute or a Graph attribute.
data Root = IsCentral     -- ^ For Nodes only
          | NotCentral    -- ^ For Nodes only
          | NodeName Text -- ^ For Graphs only
          deriving (Root -> Root -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c== :: Root -> Root -> Bool
Eq, Eq Root
Root -> Root -> Bool
Root -> Root -> Ordering
Root -> Root -> Root
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Root -> Root -> Root
$cmin :: Root -> Root -> Root
max :: Root -> Root -> Root
$cmax :: Root -> Root -> Root
>= :: Root -> Root -> Bool
$c>= :: Root -> Root -> Bool
> :: Root -> Root -> Bool
$c> :: Root -> Root -> Bool
<= :: Root -> Root -> Bool
$c<= :: Root -> Root -> Bool
< :: Root -> Root -> Bool
$c< :: Root -> Root -> Bool
compare :: Root -> Root -> Ordering
$ccompare :: Root -> Root -> Ordering
Ord, Int -> Root -> ShowS
[Root] -> ShowS
Root -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Root] -> ShowS
$cshowList :: [Root] -> ShowS
show :: Root -> String
$cshow :: Root -> String
showsPrec :: Int -> Root -> ShowS
$cshowsPrec :: Int -> Root -> ShowS
Show, ReadPrec [Root]
ReadPrec Root
Int -> ReadS Root
ReadS [Root]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Root]
$creadListPrec :: ReadPrec [Root]
readPrec :: ReadPrec Root
$creadPrec :: ReadPrec Root
readList :: ReadS [Root]
$creadList :: ReadS [Root]
readsPrec :: Int -> ReadS Root
$creadsPrec :: Int -> ReadS Root
Read)

instance PrintDot Root where
  unqtDot :: Root -> DotCode
unqtDot Root
IsCentral    = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot Root
NotCentral   = forall a. PrintDot a => a -> DotCode
unqtDot Bool
False
  unqtDot (NodeName Text
n) = forall a. PrintDot a => a -> DotCode
unqtDot Text
n

  toDot :: Root -> DotCode
toDot (NodeName Text
n) = forall a. PrintDot a => a -> DotCode
toDot Text
n
  toDot Root
r            = forall a. PrintDot a => a -> DotCode
unqtDot Root
r

instance ParseDot Root where
  parseUnqt :: Parse Root
parseUnqt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Bool -> a
bool Root
NotCentral Root
IsCentral) Parser GraphvizState Bool
onlyBool
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Root
NodeName forall a. ParseDot a => Parse a
parseUnqt

  parse :: Parse Root
parse = forall a. Parse a -> Parse a
optionalQuoted (forall a. a -> a -> Bool -> a
bool Root
NotCentral Root
IsCentral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState Bool
onlyBool)
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Root
NodeName forall a. ParseDot a => Parse a
parse

-- -----------------------------------------------------------------------------

data RankType = SameRank
              | MinRank
              | SourceRank
              | MaxRank
              | SinkRank
              deriving (RankType -> RankType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankType -> RankType -> Bool
$c/= :: RankType -> RankType -> Bool
== :: RankType -> RankType -> Bool
$c== :: RankType -> RankType -> Bool
Eq, Eq RankType
RankType -> RankType -> Bool
RankType -> RankType -> Ordering
RankType -> RankType -> RankType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RankType -> RankType -> RankType
$cmin :: RankType -> RankType -> RankType
max :: RankType -> RankType -> RankType
$cmax :: RankType -> RankType -> RankType
>= :: RankType -> RankType -> Bool
$c>= :: RankType -> RankType -> Bool
> :: RankType -> RankType -> Bool
$c> :: RankType -> RankType -> Bool
<= :: RankType -> RankType -> Bool
$c<= :: RankType -> RankType -> Bool
< :: RankType -> RankType -> Bool
$c< :: RankType -> RankType -> Bool
compare :: RankType -> RankType -> Ordering
$ccompare :: RankType -> RankType -> Ordering
Ord, RankType
forall a. a -> a -> Bounded a
maxBound :: RankType
$cmaxBound :: RankType
minBound :: RankType
$cminBound :: RankType
Bounded, Int -> RankType
RankType -> Int
RankType -> [RankType]
RankType -> RankType
RankType -> RankType -> [RankType]
RankType -> RankType -> RankType -> [RankType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RankType -> RankType -> RankType -> [RankType]
$cenumFromThenTo :: RankType -> RankType -> RankType -> [RankType]
enumFromTo :: RankType -> RankType -> [RankType]
$cenumFromTo :: RankType -> RankType -> [RankType]
enumFromThen :: RankType -> RankType -> [RankType]
$cenumFromThen :: RankType -> RankType -> [RankType]
enumFrom :: RankType -> [RankType]
$cenumFrom :: RankType -> [RankType]
fromEnum :: RankType -> Int
$cfromEnum :: RankType -> Int
toEnum :: Int -> RankType
$ctoEnum :: Int -> RankType
pred :: RankType -> RankType
$cpred :: RankType -> RankType
succ :: RankType -> RankType
$csucc :: RankType -> RankType
Enum, Int -> RankType -> ShowS
[RankType] -> ShowS
RankType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankType] -> ShowS
$cshowList :: [RankType] -> ShowS
show :: RankType -> String
$cshow :: RankType -> String
showsPrec :: Int -> RankType -> ShowS
$cshowsPrec :: Int -> RankType -> ShowS
Show, ReadPrec [RankType]
ReadPrec RankType
Int -> ReadS RankType
ReadS [RankType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankType]
$creadListPrec :: ReadPrec [RankType]
readPrec :: ReadPrec RankType
$creadPrec :: ReadPrec RankType
readList :: ReadS [RankType]
$creadList :: ReadS [RankType]
readsPrec :: Int -> ReadS RankType
$creadsPrec :: Int -> ReadS RankType
Read)

instance PrintDot RankType where
  unqtDot :: RankType -> DotCode
unqtDot RankType
SameRank   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"same"
  unqtDot RankType
MinRank    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"min"
  unqtDot RankType
SourceRank = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"source"
  unqtDot RankType
MaxRank    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"max"
  unqtDot RankType
SinkRank   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"sink"

instance ParseDot RankType where
  parseUnqt :: Parse RankType
parseUnqt = forall a. [(String, a)] -> Parse a
stringValue [ (String
"same", RankType
SameRank)
                          , (String
"min", RankType
MinRank)
                          , (String
"source", RankType
SourceRank)
                          , (String
"max", RankType
MaxRank)
                          , (String
"sink", RankType
SinkRank)
                          ]

-- -----------------------------------------------------------------------------

data RankDir = FromTop
             | FromLeft
             | FromBottom
             | FromRight
             deriving (RankDir -> RankDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankDir -> RankDir -> Bool
$c/= :: RankDir -> RankDir -> Bool
== :: RankDir -> RankDir -> Bool
$c== :: RankDir -> RankDir -> Bool
Eq, Eq RankDir
RankDir -> RankDir -> Bool
RankDir -> RankDir -> Ordering
RankDir -> RankDir -> RankDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RankDir -> RankDir -> RankDir
$cmin :: RankDir -> RankDir -> RankDir
max :: RankDir -> RankDir -> RankDir
$cmax :: RankDir -> RankDir -> RankDir
>= :: RankDir -> RankDir -> Bool
$c>= :: RankDir -> RankDir -> Bool
> :: RankDir -> RankDir -> Bool
$c> :: RankDir -> RankDir -> Bool
<= :: RankDir -> RankDir -> Bool
$c<= :: RankDir -> RankDir -> Bool
< :: RankDir -> RankDir -> Bool
$c< :: RankDir -> RankDir -> Bool
compare :: RankDir -> RankDir -> Ordering
$ccompare :: RankDir -> RankDir -> Ordering
Ord, RankDir
forall a. a -> a -> Bounded a
maxBound :: RankDir
$cmaxBound :: RankDir
minBound :: RankDir
$cminBound :: RankDir
Bounded, Int -> RankDir
RankDir -> Int
RankDir -> [RankDir]
RankDir -> RankDir
RankDir -> RankDir -> [RankDir]
RankDir -> RankDir -> RankDir -> [RankDir]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RankDir -> RankDir -> RankDir -> [RankDir]
$cenumFromThenTo :: RankDir -> RankDir -> RankDir -> [RankDir]
enumFromTo :: RankDir -> RankDir -> [RankDir]
$cenumFromTo :: RankDir -> RankDir -> [RankDir]
enumFromThen :: RankDir -> RankDir -> [RankDir]
$cenumFromThen :: RankDir -> RankDir -> [RankDir]
enumFrom :: RankDir -> [RankDir]
$cenumFrom :: RankDir -> [RankDir]
fromEnum :: RankDir -> Int
$cfromEnum :: RankDir -> Int
toEnum :: Int -> RankDir
$ctoEnum :: Int -> RankDir
pred :: RankDir -> RankDir
$cpred :: RankDir -> RankDir
succ :: RankDir -> RankDir
$csucc :: RankDir -> RankDir
Enum, Int -> RankDir -> ShowS
[RankDir] -> ShowS
RankDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankDir] -> ShowS
$cshowList :: [RankDir] -> ShowS
show :: RankDir -> String
$cshow :: RankDir -> String
showsPrec :: Int -> RankDir -> ShowS
$cshowsPrec :: Int -> RankDir -> ShowS
Show, ReadPrec [RankDir]
ReadPrec RankDir
Int -> ReadS RankDir
ReadS [RankDir]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankDir]
$creadListPrec :: ReadPrec [RankDir]
readPrec :: ReadPrec RankDir
$creadPrec :: ReadPrec RankDir
readList :: ReadS [RankDir]
$creadList :: ReadS [RankDir]
readsPrec :: Int -> ReadS RankDir
$creadsPrec :: Int -> ReadS RankDir
Read)

instance PrintDot RankDir where
  unqtDot :: RankDir -> DotCode
unqtDot RankDir
FromTop    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TB"
  unqtDot RankDir
FromLeft   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LR"
  unqtDot RankDir
FromBottom = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BT"
  unqtDot RankDir
FromRight  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RL"

instance ParseDot RankDir where
  parseUnqt :: Parse RankDir
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep RankDir
FromTop String
"TB"
                    , forall a. a -> String -> Parse a
stringRep RankDir
FromLeft String
"LR"
                    , forall a. a -> String -> Parse a
stringRep RankDir
FromBottom String
"BT"
                    , forall a. a -> String -> Parse a
stringRep RankDir
FromRight String
"RL"
                    ]

-- -----------------------------------------------------------------------------

-- | Geometries of shapes are affected by the attributes 'Regular',
--   'Peripheries' and 'Orientation'.
data Shape
    = BoxShape -- ^ Has synonyms of /rect/ and /rectangle/.
    | Polygon  -- ^ Also affected by 'Sides', 'Skew' and 'Distortion'.
    | Ellipse  -- ^ Has synonym of /oval/.
    | Circle
    | PointShape -- ^ Only affected by 'Peripheries', 'Width' and
                 --   'Height'.
    | Egg
    | Triangle
    | PlainText -- ^ Has synonym of /none/.  Recommended for
                --   'HtmlLabel's.
    | DiamondShape
    | Trapezium
    | Parallelogram
    | House
    | Pentagon
    | Hexagon
    | Septagon
    | Octagon
    | DoubleCircle
    | DoubleOctagon
    | TripleOctagon
    | InvTriangle
    | InvTrapezium
    | InvHouse
    | MDiamond
    | MSquare
    | MCircle
    | Square
    | Star      -- ^ Requires Graphviz >= 2.32.0.
    | Underline -- ^ Requires Graphviz >= 2.36.0.
    | Note
    | Tab
    | Folder
    | Box3D
    | Component
    | Promoter         -- ^ Requires Graphviz >= 2.30.0.
    | CDS              -- ^ Requires Graphviz >= 2.30.0.
    | Terminator       -- ^ Requires Graphviz >= 2.30.0.
    | UTR              -- ^ Requires Graphviz >= 2.30.0.
    | PrimerSite       -- ^ Requires Graphviz >= 2.30.0.
    | RestrictionSite  -- ^ Requires Graphviz >= 2.30.0.
    | FivePovOverhang  -- ^ Requires Graphviz >= 2.30.0.
    | ThreePovOverhang -- ^ Requires Graphviz >= 2.30.0.
    | NoOverhang       -- ^ Requires Graphviz >= 2.30.0.
    | Assembly         -- ^ Requires Graphviz >= 2.30.0.
    | Signature        -- ^ Requires Graphviz >= 2.30.0.
    | Insulator        -- ^ Requires Graphviz >= 2.30.0.
    | Ribosite         -- ^ Requires Graphviz >= 2.30.0.
    | RNAStab          -- ^ Requires Graphviz >= 2.30.0.
    | ProteaseSite     -- ^ Requires Graphviz >= 2.30.0.
    | ProteinStab      -- ^ Requires Graphviz >= 2.30.0.
    | RPromoter        -- ^ Requires Graphviz >= 2.30.0.
    | RArrow           -- ^ Requires Graphviz >= 2.30.0.
    | LArrow           -- ^ Requires Graphviz >= 2.30.0.
    | LPromoter        -- ^ Requires Graphviz >= 2.30.0.
    | Record  -- ^ Must specify the record shape with a 'Label'.
    | MRecord -- ^ Must specify the record shape with a 'Label'.
    deriving (Shape -> Shape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq, Eq Shape
Shape -> Shape -> Bool
Shape -> Shape -> Ordering
Shape -> Shape -> Shape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Shape -> Shape -> Shape
$cmin :: Shape -> Shape -> Shape
max :: Shape -> Shape -> Shape
$cmax :: Shape -> Shape -> Shape
>= :: Shape -> Shape -> Bool
$c>= :: Shape -> Shape -> Bool
> :: Shape -> Shape -> Bool
$c> :: Shape -> Shape -> Bool
<= :: Shape -> Shape -> Bool
$c<= :: Shape -> Shape -> Bool
< :: Shape -> Shape -> Bool
$c< :: Shape -> Shape -> Bool
compare :: Shape -> Shape -> Ordering
$ccompare :: Shape -> Shape -> Ordering
Ord, Shape
forall a. a -> a -> Bounded a
maxBound :: Shape
$cmaxBound :: Shape
minBound :: Shape
$cminBound :: Shape
Bounded, Int -> Shape
Shape -> Int
Shape -> [Shape]
Shape -> Shape
Shape -> Shape -> [Shape]
Shape -> Shape -> Shape -> [Shape]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Shape -> Shape -> Shape -> [Shape]
$cenumFromThenTo :: Shape -> Shape -> Shape -> [Shape]
enumFromTo :: Shape -> Shape -> [Shape]
$cenumFromTo :: Shape -> Shape -> [Shape]
enumFromThen :: Shape -> Shape -> [Shape]
$cenumFromThen :: Shape -> Shape -> [Shape]
enumFrom :: Shape -> [Shape]
$cenumFrom :: Shape -> [Shape]
fromEnum :: Shape -> Int
$cfromEnum :: Shape -> Int
toEnum :: Int -> Shape
$ctoEnum :: Int -> Shape
pred :: Shape -> Shape
$cpred :: Shape -> Shape
succ :: Shape -> Shape
$csucc :: Shape -> Shape
Enum, Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> Shape -> ShowS
Show, ReadPrec [Shape]
ReadPrec Shape
Int -> ReadS Shape
ReadS [Shape]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Shape]
$creadListPrec :: ReadPrec [Shape]
readPrec :: ReadPrec Shape
$creadPrec :: ReadPrec Shape
readList :: ReadS [Shape]
$creadList :: ReadS [Shape]
readsPrec :: Int -> ReadS Shape
$creadsPrec :: Int -> ReadS Shape
Read)

instance PrintDot Shape where
  unqtDot :: Shape -> DotCode
unqtDot Shape
BoxShape         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"box"
  unqtDot Shape
Polygon          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"polygon"
  unqtDot Shape
Ellipse          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ellipse"
  unqtDot Shape
Circle           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"circle"
  unqtDot Shape
PointShape       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"point"
  unqtDot Shape
Egg              = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"egg"
  unqtDot Shape
Triangle         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"triangle"
  unqtDot Shape
PlainText        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"plaintext"
  unqtDot Shape
DiamondShape     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"diamond"
  unqtDot Shape
Trapezium        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"trapezium"
  unqtDot Shape
Parallelogram    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"parallelogram"
  unqtDot Shape
House            = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"house"
  unqtDot Shape
Pentagon         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"pentagon"
  unqtDot Shape
Hexagon          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"hexagon"
  unqtDot Shape
Septagon         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"septagon"
  unqtDot Shape
Octagon          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"octagon"
  unqtDot Shape
DoubleCircle     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"doublecircle"
  unqtDot Shape
DoubleOctagon    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"doubleoctagon"
  unqtDot Shape
TripleOctagon    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"tripleoctagon"
  unqtDot Shape
InvTriangle      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"invtriangle"
  unqtDot Shape
InvTrapezium     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"invtrapezium"
  unqtDot Shape
InvHouse         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"invhouse"
  unqtDot Shape
MDiamond         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"Mdiamond"
  unqtDot Shape
MSquare          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"Msquare"
  unqtDot Shape
MCircle          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"Mcircle"
  unqtDot Shape
Square           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"square"
  unqtDot Shape
Star             = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"star"
  unqtDot Shape
Underline        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"underline"
  unqtDot Shape
Note             = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"note"
  unqtDot Shape
Tab              = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"tab"
  unqtDot Shape
Folder           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"folder"
  unqtDot Shape
Box3D            = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"box3d"
  unqtDot Shape
Component        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"component"
  unqtDot Shape
Promoter         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"promoter"
  unqtDot Shape
CDS              = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"cds"
  unqtDot Shape
Terminator       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"terminator"
  unqtDot Shape
UTR              = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"utr"
  unqtDot Shape
PrimerSite       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"primersite"
  unqtDot Shape
RestrictionSite  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"restrictionsite"
  unqtDot Shape
FivePovOverhang  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"fivepovoverhang"
  unqtDot Shape
ThreePovOverhang = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"threepovoverhang"
  unqtDot Shape
NoOverhang       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"nooverhang"
  unqtDot Shape
Assembly         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"assembly"
  unqtDot Shape
Signature        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"signature"
  unqtDot Shape
Insulator        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"insulator"
  unqtDot Shape
Ribosite         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ribosite"
  unqtDot Shape
RNAStab          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"rnastab"
  unqtDot Shape
ProteaseSite     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"proteasesite"
  unqtDot Shape
ProteinStab      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"proteinstab"
  unqtDot Shape
RPromoter        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"rpromoter"
  unqtDot Shape
RArrow           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"rarrow"
  unqtDot Shape
LArrow           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"larrow"
  unqtDot Shape
LPromoter        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"lpromoter"
  unqtDot Shape
Record           = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"record"
  unqtDot Shape
MRecord          = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"Mrecord"

instance ParseDot Shape where
  parseUnqt :: Parse Shape
parseUnqt = forall a. [(String, a)] -> Parse a
stringValue [ (String
"box3d", Shape
Box3D)
                          , (String
"box", Shape
BoxShape)
                          , (String
"rectangle", Shape
BoxShape)
                          , (String
"rect", Shape
BoxShape)
                          , (String
"polygon", Shape
Polygon)
                          , (String
"ellipse", Shape
Ellipse)
                          , (String
"oval", Shape
Ellipse)
                          , (String
"circle", Shape
Circle)
                          , (String
"point", Shape
PointShape)
                          , (String
"egg", Shape
Egg)
                          , (String
"triangle", Shape
Triangle)
                          , (String
"plaintext", Shape
PlainText)
                          , (String
"none", Shape
PlainText)
                          , (String
"diamond", Shape
DiamondShape)
                          , (String
"trapezium", Shape
Trapezium)
                          , (String
"parallelogram", Shape
Parallelogram)
                          , (String
"house", Shape
House)
                          , (String
"pentagon", Shape
Pentagon)
                          , (String
"hexagon", Shape
Hexagon)
                          , (String
"septagon", Shape
Septagon)
                          , (String
"octagon", Shape
Octagon)
                          , (String
"doublecircle", Shape
DoubleCircle)
                          , (String
"doubleoctagon", Shape
DoubleOctagon)
                          , (String
"tripleoctagon", Shape
TripleOctagon)
                          , (String
"invtriangle", Shape
InvTriangle)
                          , (String
"invtrapezium", Shape
InvTrapezium)
                          , (String
"invhouse", Shape
InvHouse)
                          , (String
"Mdiamond", Shape
MDiamond)
                          , (String
"Msquare", Shape
MSquare)
                          , (String
"Mcircle", Shape
MCircle)
                          , (String
"square", Shape
Square)
                          , (String
"star", Shape
Star)
                          , (String
"underline", Shape
Underline)
                          , (String
"note", Shape
Note)
                          , (String
"tab", Shape
Tab)
                          , (String
"folder", Shape
Folder)
                          , (String
"component", Shape
Component)
                          , (String
"promoter", Shape
Promoter)
                          , (String
"cds", Shape
CDS)
                          , (String
"terminator", Shape
Terminator)
                          , (String
"utr", Shape
UTR)
                          , (String
"primersite", Shape
PrimerSite)
                          , (String
"restrictionsite", Shape
RestrictionSite)
                          , (String
"fivepovoverhang", Shape
FivePovOverhang)
                          , (String
"threepovoverhang", Shape
ThreePovOverhang)
                          , (String
"nooverhang", Shape
NoOverhang)
                          , (String
"assembly", Shape
Assembly)
                          , (String
"signature", Shape
Signature)
                          , (String
"insulator", Shape
Insulator)
                          , (String
"ribosite", Shape
Ribosite)
                          , (String
"rnastab", Shape
RNAStab)
                          , (String
"proteasesite", Shape
ProteaseSite)
                          , (String
"proteinstab", Shape
ProteinStab)
                          , (String
"rpromoter", Shape
RPromoter)
                          , (String
"rarrow", Shape
RArrow)
                          , (String
"larrow", Shape
LArrow)
                          , (String
"lpromoter", Shape
LPromoter)
                          , (String
"record", Shape
Record)
                          , (String
"Mrecord", Shape
MRecord)
                          ]

-- -----------------------------------------------------------------------------

data SmoothType = NoSmooth
                | AvgDist
                | GraphDist
                | PowerDist
                | RNG
                | Spring
                | TriangleSmooth
                deriving (SmoothType -> SmoothType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmoothType -> SmoothType -> Bool
$c/= :: SmoothType -> SmoothType -> Bool
== :: SmoothType -> SmoothType -> Bool
$c== :: SmoothType -> SmoothType -> Bool
Eq, Eq SmoothType
SmoothType -> SmoothType -> Bool
SmoothType -> SmoothType -> Ordering
SmoothType -> SmoothType -> SmoothType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmoothType -> SmoothType -> SmoothType
$cmin :: SmoothType -> SmoothType -> SmoothType
max :: SmoothType -> SmoothType -> SmoothType
$cmax :: SmoothType -> SmoothType -> SmoothType
>= :: SmoothType -> SmoothType -> Bool
$c>= :: SmoothType -> SmoothType -> Bool
> :: SmoothType -> SmoothType -> Bool
$c> :: SmoothType -> SmoothType -> Bool
<= :: SmoothType -> SmoothType -> Bool
$c<= :: SmoothType -> SmoothType -> Bool
< :: SmoothType -> SmoothType -> Bool
$c< :: SmoothType -> SmoothType -> Bool
compare :: SmoothType -> SmoothType -> Ordering
$ccompare :: SmoothType -> SmoothType -> Ordering
Ord, SmoothType
forall a. a -> a -> Bounded a
maxBound :: SmoothType
$cmaxBound :: SmoothType
minBound :: SmoothType
$cminBound :: SmoothType
Bounded, Int -> SmoothType
SmoothType -> Int
SmoothType -> [SmoothType]
SmoothType -> SmoothType
SmoothType -> SmoothType -> [SmoothType]
SmoothType -> SmoothType -> SmoothType -> [SmoothType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SmoothType -> SmoothType -> SmoothType -> [SmoothType]
$cenumFromThenTo :: SmoothType -> SmoothType -> SmoothType -> [SmoothType]
enumFromTo :: SmoothType -> SmoothType -> [SmoothType]
$cenumFromTo :: SmoothType -> SmoothType -> [SmoothType]
enumFromThen :: SmoothType -> SmoothType -> [SmoothType]
$cenumFromThen :: SmoothType -> SmoothType -> [SmoothType]
enumFrom :: SmoothType -> [SmoothType]
$cenumFrom :: SmoothType -> [SmoothType]
fromEnum :: SmoothType -> Int
$cfromEnum :: SmoothType -> Int
toEnum :: Int -> SmoothType
$ctoEnum :: Int -> SmoothType
pred :: SmoothType -> SmoothType
$cpred :: SmoothType -> SmoothType
succ :: SmoothType -> SmoothType
$csucc :: SmoothType -> SmoothType
Enum, Int -> SmoothType -> ShowS
[SmoothType] -> ShowS
SmoothType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmoothType] -> ShowS
$cshowList :: [SmoothType] -> ShowS
show :: SmoothType -> String
$cshow :: SmoothType -> String
showsPrec :: Int -> SmoothType -> ShowS
$cshowsPrec :: Int -> SmoothType -> ShowS
Show, ReadPrec [SmoothType]
ReadPrec SmoothType
Int -> ReadS SmoothType
ReadS [SmoothType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SmoothType]
$creadListPrec :: ReadPrec [SmoothType]
readPrec :: ReadPrec SmoothType
$creadPrec :: ReadPrec SmoothType
readList :: ReadS [SmoothType]
$creadList :: ReadS [SmoothType]
readsPrec :: Int -> ReadS SmoothType
$creadsPrec :: Int -> ReadS SmoothType
Read)

instance PrintDot SmoothType where
  unqtDot :: SmoothType -> DotCode
unqtDot SmoothType
NoSmooth       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"none"
  unqtDot SmoothType
AvgDist        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"avg_dist"
  unqtDot SmoothType
GraphDist      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"graph_dist"
  unqtDot SmoothType
PowerDist      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"power_dist"
  unqtDot SmoothType
RNG            = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"rng"
  unqtDot SmoothType
Spring         = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"spring"
  unqtDot SmoothType
TriangleSmooth = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"triangle"

instance ParseDot SmoothType where
  parseUnqt :: Parse SmoothType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep SmoothType
NoSmooth String
"none"
                    , forall a. a -> String -> Parse a
stringRep SmoothType
AvgDist String
"avg_dist"
                    , forall a. a -> String -> Parse a
stringRep SmoothType
GraphDist String
"graph_dist"
                    , forall a. a -> String -> Parse a
stringRep SmoothType
PowerDist String
"power_dist"
                    , forall a. a -> String -> Parse a
stringRep SmoothType
RNG String
"rng"
                    , forall a. a -> String -> Parse a
stringRep SmoothType
Spring String
"spring"
                    , forall a. a -> String -> Parse a
stringRep SmoothType
TriangleSmooth String
"triangle"
                    ]

-- -----------------------------------------------------------------------------

data StartType = StartStyle STStyle
               | StartSeed Int
               | StartStyleSeed STStyle Int
               deriving (StartType -> StartType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartType -> StartType -> Bool
$c/= :: StartType -> StartType -> Bool
== :: StartType -> StartType -> Bool
$c== :: StartType -> StartType -> Bool
Eq, Eq StartType
StartType -> StartType -> Bool
StartType -> StartType -> Ordering
StartType -> StartType -> StartType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartType -> StartType -> StartType
$cmin :: StartType -> StartType -> StartType
max :: StartType -> StartType -> StartType
$cmax :: StartType -> StartType -> StartType
>= :: StartType -> StartType -> Bool
$c>= :: StartType -> StartType -> Bool
> :: StartType -> StartType -> Bool
$c> :: StartType -> StartType -> Bool
<= :: StartType -> StartType -> Bool
$c<= :: StartType -> StartType -> Bool
< :: StartType -> StartType -> Bool
$c< :: StartType -> StartType -> Bool
compare :: StartType -> StartType -> Ordering
$ccompare :: StartType -> StartType -> Ordering
Ord, Int -> StartType -> ShowS
[StartType] -> ShowS
StartType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartType] -> ShowS
$cshowList :: [StartType] -> ShowS
show :: StartType -> String
$cshow :: StartType -> String
showsPrec :: Int -> StartType -> ShowS
$cshowsPrec :: Int -> StartType -> ShowS
Show, ReadPrec [StartType]
ReadPrec StartType
Int -> ReadS StartType
ReadS [StartType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartType]
$creadListPrec :: ReadPrec [StartType]
readPrec :: ReadPrec StartType
$creadPrec :: ReadPrec StartType
readList :: ReadS [StartType]
$creadList :: ReadS [StartType]
readsPrec :: Int -> ReadS StartType
$creadsPrec :: Int -> ReadS StartType
Read)

instance PrintDot StartType where
  unqtDot :: StartType -> DotCode
unqtDot (StartStyle STStyle
ss)       = forall a. PrintDot a => a -> DotCode
unqtDot STStyle
ss
  unqtDot (StartSeed Int
s)         = forall a. PrintDot a => a -> DotCode
unqtDot Int
s
  unqtDot (StartStyleSeed STStyle
ss Int
s) = forall a. PrintDot a => a -> DotCode
unqtDot STStyle
ss forall a. Semigroup a => a -> a -> a
<> forall a. PrintDot a => a -> DotCode
unqtDot Int
s

instance ParseDot StartType where
  parseUnqt :: Parse StartType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 STStyle -> Int -> StartType
StartStyleSeed forall a. ParseDot a => Parse a
parseUnqt forall a. ParseDot a => Parse a
parseUnqt
                    , STStyle -> StartType
StartStyle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                    , Int -> StartType
StartSeed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                    ]

data STStyle = RegularStyle
             | SelfStyle
             | RandomStyle
             deriving (STStyle -> STStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: STStyle -> STStyle -> Bool
$c/= :: STStyle -> STStyle -> Bool
== :: STStyle -> STStyle -> Bool
$c== :: STStyle -> STStyle -> Bool
Eq, Eq STStyle
STStyle -> STStyle -> Bool
STStyle -> STStyle -> Ordering
STStyle -> STStyle -> STStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: STStyle -> STStyle -> STStyle
$cmin :: STStyle -> STStyle -> STStyle
max :: STStyle -> STStyle -> STStyle
$cmax :: STStyle -> STStyle -> STStyle
>= :: STStyle -> STStyle -> Bool
$c>= :: STStyle -> STStyle -> Bool
> :: STStyle -> STStyle -> Bool
$c> :: STStyle -> STStyle -> Bool
<= :: STStyle -> STStyle -> Bool
$c<= :: STStyle -> STStyle -> Bool
< :: STStyle -> STStyle -> Bool
$c< :: STStyle -> STStyle -> Bool
compare :: STStyle -> STStyle -> Ordering
$ccompare :: STStyle -> STStyle -> Ordering
Ord, STStyle
forall a. a -> a -> Bounded a
maxBound :: STStyle
$cmaxBound :: STStyle
minBound :: STStyle
$cminBound :: STStyle
Bounded, Int -> STStyle
STStyle -> Int
STStyle -> [STStyle]
STStyle -> STStyle
STStyle -> STStyle -> [STStyle]
STStyle -> STStyle -> STStyle -> [STStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: STStyle -> STStyle -> STStyle -> [STStyle]
$cenumFromThenTo :: STStyle -> STStyle -> STStyle -> [STStyle]
enumFromTo :: STStyle -> STStyle -> [STStyle]
$cenumFromTo :: STStyle -> STStyle -> [STStyle]
enumFromThen :: STStyle -> STStyle -> [STStyle]
$cenumFromThen :: STStyle -> STStyle -> [STStyle]
enumFrom :: STStyle -> [STStyle]
$cenumFrom :: STStyle -> [STStyle]
fromEnum :: STStyle -> Int
$cfromEnum :: STStyle -> Int
toEnum :: Int -> STStyle
$ctoEnum :: Int -> STStyle
pred :: STStyle -> STStyle
$cpred :: STStyle -> STStyle
succ :: STStyle -> STStyle
$csucc :: STStyle -> STStyle
Enum, Int -> STStyle -> ShowS
[STStyle] -> ShowS
STStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [STStyle] -> ShowS
$cshowList :: [STStyle] -> ShowS
show :: STStyle -> String
$cshow :: STStyle -> String
showsPrec :: Int -> STStyle -> ShowS
$cshowsPrec :: Int -> STStyle -> ShowS
Show, ReadPrec [STStyle]
ReadPrec STStyle
Int -> ReadS STStyle
ReadS [STStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [STStyle]
$creadListPrec :: ReadPrec [STStyle]
readPrec :: ReadPrec STStyle
$creadPrec :: ReadPrec STStyle
readList :: ReadS [STStyle]
$creadList :: ReadS [STStyle]
readsPrec :: Int -> ReadS STStyle
$creadsPrec :: Int -> ReadS STStyle
Read)

instance PrintDot STStyle where
  unqtDot :: STStyle -> DotCode
unqtDot STStyle
RegularStyle = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"regular"
  unqtDot STStyle
SelfStyle    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"self"
  unqtDot STStyle
RandomStyle  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"random"

instance ParseDot STStyle where
  parseUnqt :: Parse STStyle
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep STStyle
RegularStyle String
"regular"
                    , forall a. a -> String -> Parse a
stringRep STStyle
SelfStyle String
"self"
                    , forall a. a -> String -> Parse a
stringRep STStyle
RandomStyle String
"random"
                    ]

-- -----------------------------------------------------------------------------

-- | An individual style item.  Except for 'DD', the @['String']@
--   should be empty.
data StyleItem = SItem StyleName [Text]
               deriving (StyleItem -> StyleItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleItem -> StyleItem -> Bool
$c/= :: StyleItem -> StyleItem -> Bool
== :: StyleItem -> StyleItem -> Bool
$c== :: StyleItem -> StyleItem -> Bool
Eq, Eq StyleItem
StyleItem -> StyleItem -> Bool
StyleItem -> StyleItem -> Ordering
StyleItem -> StyleItem -> StyleItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StyleItem -> StyleItem -> StyleItem
$cmin :: StyleItem -> StyleItem -> StyleItem
max :: StyleItem -> StyleItem -> StyleItem
$cmax :: StyleItem -> StyleItem -> StyleItem
>= :: StyleItem -> StyleItem -> Bool
$c>= :: StyleItem -> StyleItem -> Bool
> :: StyleItem -> StyleItem -> Bool
$c> :: StyleItem -> StyleItem -> Bool
<= :: StyleItem -> StyleItem -> Bool
$c<= :: StyleItem -> StyleItem -> Bool
< :: StyleItem -> StyleItem -> Bool
$c< :: StyleItem -> StyleItem -> Bool
compare :: StyleItem -> StyleItem -> Ordering
$ccompare :: StyleItem -> StyleItem -> Ordering
Ord, Int -> StyleItem -> ShowS
[StyleItem] -> ShowS
StyleItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleItem] -> ShowS
$cshowList :: [StyleItem] -> ShowS
show :: StyleItem -> String
$cshow :: StyleItem -> String
showsPrec :: Int -> StyleItem -> ShowS
$cshowsPrec :: Int -> StyleItem -> ShowS
Show, ReadPrec [StyleItem]
ReadPrec StyleItem
Int -> ReadS StyleItem
ReadS [StyleItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StyleItem]
$creadListPrec :: ReadPrec [StyleItem]
readPrec :: ReadPrec StyleItem
$creadPrec :: ReadPrec StyleItem
readList :: ReadS [StyleItem]
$creadList :: ReadS [StyleItem]
readsPrec :: Int -> ReadS StyleItem
$creadsPrec :: Int -> ReadS StyleItem
Read)

instance PrintDot StyleItem where
  unqtDot :: StyleItem -> DotCode
unqtDot (SItem StyleName
nm [Text]
args)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
args = DotCode
dnm
    | Bool
otherwise = DotCode
dnm forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Functor m => m Doc -> m Doc
parens DotCode
args'
    where
      dnm :: DotCode
dnm = forall a. PrintDot a => a -> DotCode
unqtDot StyleName
nm
      args' :: DotCode
args' = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate forall (m :: * -> *). Applicative m => m Doc
comma forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot [Text]
args

  toDot :: StyleItem -> DotCode
toDot si :: StyleItem
si@(SItem StyleName
nm [Text]
args)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
args = forall a. PrintDot a => a -> DotCode
toDot StyleName
nm
    | Bool
otherwise = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot StyleItem
si

  unqtListToDot :: [StyleItem] -> DotCode
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate forall (m :: * -> *). Applicative m => m Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot

  listToDot :: [StyleItem] -> DotCode
listToDot [SItem StyleName
nm []] = forall a. PrintDot a => a -> DotCode
toDot StyleName
nm
  listToDot [StyleItem]
sis           = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => [a] -> DotCode
unqtListToDot [StyleItem]
sis

instance ParseDot StyleItem where
  parseUnqt :: Parse StyleItem
parseUnqt = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 StyleName -> [Text] -> StyleItem
SItem forall a. ParseDot a => Parse a
parseUnqt (forall a. Parse [a] -> Parse [a]
tryParseList' Parse [Text]
parseArgs)

  parse :: Parse StyleItem
parse = forall a. Parse a -> Parse a
quotedParse (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 StyleName -> [Text] -> StyleItem
SItem forall a. ParseDot a => Parse a
parseUnqt Parse [Text]
parseArgs)
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StyleName -> [Text] -> StyleItem
`SItem` []) forall a. ParseDot a => Parse a
parse

  parseUnqtList :: Parse [StyleItem]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt (forall a. Parse a -> Parse a
wrapWhitespace Parse ()
parseComma)

  parseList :: Parse [StyleItem]
parseList = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse [a]
parseUnqtList
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              -- Might not necessarily need to be quoted if a singleton...
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return forall a. ParseDot a => Parse a
parse

parseArgs :: Parse [Text]
parseArgs :: Parse [Text]
parseArgs = forall (p :: * -> *) bra sep ket a.
PolyParse p =>
p bra -> p sep -> p ket -> p a -> p [a]
bracketSep (Char -> Parse Char
character Char
'(')
                       Parse ()
parseComma
                       (Char -> Parse Char
character Char
')')
                       Parse Text
parseStyleName

data StyleName = Dashed    -- ^ Nodes and Edges
               | Dotted    -- ^ Nodes and Edges
               | Solid     -- ^ Nodes and Edges
               | Bold      -- ^ Nodes and Edges
               | Invisible -- ^ Nodes and Edges
               | Filled    -- ^ Nodes and Clusters
               | Striped   -- ^ Rectangularly-shaped Nodes and
                           --   Clusters; requires Graphviz >= 2.30.0
               | Wedged    -- ^ Elliptically-shaped Nodes only;
                           --   requires Graphviz >= 2.30.0
               | Diagonals -- ^ Nodes only
               | Rounded   -- ^ Nodes and Clusters
               | Tapered   -- ^ Edges only; requires Graphviz >=
                           --   2.29.0
               | Radial    -- ^ Nodes, Clusters and Graphs, for use
                           --   with 'GradientAngle'; requires
                           --   Graphviz >= 2.29.0
               | DD Text   -- ^ Device Dependent
               deriving (StyleName -> StyleName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleName -> StyleName -> Bool
$c/= :: StyleName -> StyleName -> Bool
== :: StyleName -> StyleName -> Bool
$c== :: StyleName -> StyleName -> Bool
Eq, Eq StyleName
StyleName -> StyleName -> Bool
StyleName -> StyleName -> Ordering
StyleName -> StyleName -> StyleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StyleName -> StyleName -> StyleName
$cmin :: StyleName -> StyleName -> StyleName
max :: StyleName -> StyleName -> StyleName
$cmax :: StyleName -> StyleName -> StyleName
>= :: StyleName -> StyleName -> Bool
$c>= :: StyleName -> StyleName -> Bool
> :: StyleName -> StyleName -> Bool
$c> :: StyleName -> StyleName -> Bool
<= :: StyleName -> StyleName -> Bool
$c<= :: StyleName -> StyleName -> Bool
< :: StyleName -> StyleName -> Bool
$c< :: StyleName -> StyleName -> Bool
compare :: StyleName -> StyleName -> Ordering
$ccompare :: StyleName -> StyleName -> Ordering
Ord, Int -> StyleName -> ShowS
[StyleName] -> ShowS
StyleName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleName] -> ShowS
$cshowList :: [StyleName] -> ShowS
show :: StyleName -> String
$cshow :: StyleName -> String
showsPrec :: Int -> StyleName -> ShowS
$cshowsPrec :: Int -> StyleName -> ShowS
Show, ReadPrec [StyleName]
ReadPrec StyleName
Int -> ReadS StyleName
ReadS [StyleName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StyleName]
$creadListPrec :: ReadPrec [StyleName]
readPrec :: ReadPrec StyleName
$creadPrec :: ReadPrec StyleName
readList :: ReadS [StyleName]
$creadList :: ReadS [StyleName]
readsPrec :: Int -> ReadS StyleName
$creadsPrec :: Int -> ReadS StyleName
Read)

instance PrintDot StyleName where
  unqtDot :: StyleName -> DotCode
unqtDot StyleName
Dashed    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"dashed"
  unqtDot StyleName
Dotted    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"dotted"
  unqtDot StyleName
Solid     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"solid"
  unqtDot StyleName
Bold      = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"bold"
  unqtDot StyleName
Invisible = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"invis"
  unqtDot StyleName
Filled    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"filled"
  unqtDot StyleName
Striped   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"striped"
  unqtDot StyleName
Wedged    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"wedged"
  unqtDot StyleName
Diagonals = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"diagonals"
  unqtDot StyleName
Rounded   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"rounded"
  unqtDot StyleName
Tapered   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"tapered"
  unqtDot StyleName
Radial    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"radial"
  unqtDot (DD Text
nm)   = forall a. PrintDot a => a -> DotCode
unqtDot Text
nm

  toDot :: StyleName -> DotCode
toDot (DD Text
nm) = forall a. PrintDot a => a -> DotCode
toDot Text
nm
  toDot StyleName
sn      = forall a. PrintDot a => a -> DotCode
unqtDot StyleName
sn

instance ParseDot StyleName where
  parseUnqt :: Parse StyleName
parseUnqt = Text -> StyleName
checkDD forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Text
parseStyleName

  parse :: Parse StyleName
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StyleName
checkDD Parse Text
quotelessString

checkDD     :: Text -> StyleName
checkDD :: Text -> StyleName
checkDD Text
str = case Text -> Text
T.toLower Text
str of
                Text
"dashed"    -> StyleName
Dashed
                Text
"dotted"    -> StyleName
Dotted
                Text
"solid"     -> StyleName
Solid
                Text
"bold"      -> StyleName
Bold
                Text
"invis"     -> StyleName
Invisible
                Text
"filled"    -> StyleName
Filled
                Text
"striped"   -> StyleName
Striped
                Text
"wedged"    -> StyleName
Wedged
                Text
"diagonals" -> StyleName
Diagonals
                Text
"rounded"   -> StyleName
Rounded
                Text
"tapered"   -> StyleName
Tapered
                Text
"radial"    -> StyleName
Radial
                Text
_           -> Text -> StyleName
DD Text
str

parseStyleName :: Parse Text
parseStyleName :: Parse Text
parseStyleName = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> Text -> Text
T.cons (Parse Char -> Parse Char
orEscaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parse Char
noneOf forall a b. (a -> b) -> a -> b
$ Char
' ' forall a. a -> [a] -> [a]
: String
disallowedChars)
                               (Bool -> String -> String -> Parse Text
parseEscaped Bool
True [] String
disallowedChars)
  where
    disallowedChars :: String
disallowedChars = [Char
quoteChar, Char
'(', Char
')', Char
',']
    -- Used because the first character has slightly stricter requirements than the rest.
    orSlash :: Parse Char -> Parse Char
orSlash Parse Char
p = forall a. a -> String -> Parse a
stringRep Char
'\\' String
"\\\\" forall s a. Parser s a -> Parser s a -> Parser s a
`onFail` Parse Char
p
    orEscaped :: Parse Char -> Parse Char
orEscaped = Parse Char -> Parse Char
orQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse Char -> Parse Char
orSlash

-- -----------------------------------------------------------------------------

data ViewPort = VP { ViewPort -> Double
wVal  :: Double
                   , ViewPort -> Double
hVal  :: Double
                   , ViewPort -> Double
zVal  :: Double
                   , ViewPort -> Maybe FocusType
focus :: Maybe FocusType
                   }
              deriving (ViewPort -> ViewPort -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewPort -> ViewPort -> Bool
$c/= :: ViewPort -> ViewPort -> Bool
== :: ViewPort -> ViewPort -> Bool
$c== :: ViewPort -> ViewPort -> Bool
Eq, Eq ViewPort
ViewPort -> ViewPort -> Bool
ViewPort -> ViewPort -> Ordering
ViewPort -> ViewPort -> ViewPort
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ViewPort -> ViewPort -> ViewPort
$cmin :: ViewPort -> ViewPort -> ViewPort
max :: ViewPort -> ViewPort -> ViewPort
$cmax :: ViewPort -> ViewPort -> ViewPort
>= :: ViewPort -> ViewPort -> Bool
$c>= :: ViewPort -> ViewPort -> Bool
> :: ViewPort -> ViewPort -> Bool
$c> :: ViewPort -> ViewPort -> Bool
<= :: ViewPort -> ViewPort -> Bool
$c<= :: ViewPort -> ViewPort -> Bool
< :: ViewPort -> ViewPort -> Bool
$c< :: ViewPort -> ViewPort -> Bool
compare :: ViewPort -> ViewPort -> Ordering
$ccompare :: ViewPort -> ViewPort -> Ordering
Ord, Int -> ViewPort -> ShowS
[ViewPort] -> ShowS
ViewPort -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewPort] -> ShowS
$cshowList :: [ViewPort] -> ShowS
show :: ViewPort -> String
$cshow :: ViewPort -> String
showsPrec :: Int -> ViewPort -> ShowS
$cshowsPrec :: Int -> ViewPort -> ShowS
Show, ReadPrec [ViewPort]
ReadPrec ViewPort
Int -> ReadS ViewPort
ReadS [ViewPort]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewPort]
$creadListPrec :: ReadPrec [ViewPort]
readPrec :: ReadPrec ViewPort
$creadPrec :: ReadPrec ViewPort
readList :: ReadS [ViewPort]
$creadList :: ReadS [ViewPort]
readsPrec :: Int -> ReadS ViewPort
$creadsPrec :: Int -> ReadS ViewPort
Read)

instance PrintDot ViewPort where
  unqtDot :: ViewPort -> DotCode
unqtDot ViewPort
vp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe DotCode
vs (forall a. Semigroup a => a -> a -> a
(<>) (DotCode
vs forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
comma) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot)
               forall a b. (a -> b) -> a -> b
$ ViewPort -> Maybe FocusType
focus ViewPort
vp
    where
      vs :: DotCode
vs = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate forall (m :: * -> *). Applicative m => m Doc
comma
           forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. PrintDot a => a -> DotCode
unqtDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ViewPort
vp)) [ViewPort -> Double
wVal, ViewPort -> Double
hVal, ViewPort -> Double
zVal]

  toDot :: ViewPort -> DotCode
toDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
unqtDot

instance ParseDot ViewPort where
  parseUnqt :: Parse ViewPort
parseUnqt = Double -> Double -> Double -> Maybe FocusType -> ViewPort
VP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
                 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parse ()
parseComma
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ParseDot a => Parse a
parseUnqt
                 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parse ()
parseComma
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ParseDot a => Parse a
parseUnqt
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parse ()
parseComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parseUnqt)

  parse :: Parse ViewPort
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt

-- | For use with 'ViewPort'.
data FocusType = XY Point
               | NodeFocus Text
               deriving (FocusType -> FocusType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocusType -> FocusType -> Bool
$c/= :: FocusType -> FocusType -> Bool
== :: FocusType -> FocusType -> Bool
$c== :: FocusType -> FocusType -> Bool
Eq, Eq FocusType
FocusType -> FocusType -> Bool
FocusType -> FocusType -> Ordering
FocusType -> FocusType -> FocusType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FocusType -> FocusType -> FocusType
$cmin :: FocusType -> FocusType -> FocusType
max :: FocusType -> FocusType -> FocusType
$cmax :: FocusType -> FocusType -> FocusType
>= :: FocusType -> FocusType -> Bool
$c>= :: FocusType -> FocusType -> Bool
> :: FocusType -> FocusType -> Bool
$c> :: FocusType -> FocusType -> Bool
<= :: FocusType -> FocusType -> Bool
$c<= :: FocusType -> FocusType -> Bool
< :: FocusType -> FocusType -> Bool
$c< :: FocusType -> FocusType -> Bool
compare :: FocusType -> FocusType -> Ordering
$ccompare :: FocusType -> FocusType -> Ordering
Ord, Int -> FocusType -> ShowS
[FocusType] -> ShowS
FocusType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusType] -> ShowS
$cshowList :: [FocusType] -> ShowS
show :: FocusType -> String
$cshow :: FocusType -> String
showsPrec :: Int -> FocusType -> ShowS
$cshowsPrec :: Int -> FocusType -> ShowS
Show, ReadPrec [FocusType]
ReadPrec FocusType
Int -> ReadS FocusType
ReadS [FocusType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusType]
$creadListPrec :: ReadPrec [FocusType]
readPrec :: ReadPrec FocusType
$creadPrec :: ReadPrec FocusType
readList :: ReadS [FocusType]
$creadList :: ReadS [FocusType]
readsPrec :: Int -> ReadS FocusType
$creadsPrec :: Int -> ReadS FocusType
Read)

instance PrintDot FocusType where
  unqtDot :: FocusType -> DotCode
unqtDot (XY Point
p)         = forall a. PrintDot a => a -> DotCode
unqtDot Point
p
  unqtDot (NodeFocus Text
nm) = forall a. PrintDot a => a -> DotCode
unqtDot Text
nm

  toDot :: FocusType -> DotCode
toDot (XY Point
p)         = forall a. PrintDot a => a -> DotCode
toDot Point
p
  toDot (NodeFocus Text
nm) = forall a. PrintDot a => a -> DotCode
toDot Text
nm

instance ParseDot FocusType where
  parseUnqt :: Parser GraphvizState FocusType
parseUnqt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> FocusType
XY forall a. ParseDot a => Parse a
parseUnqt
              forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FocusType
NodeFocus forall a. ParseDot a => Parse a
parseUnqt

  parse :: Parser GraphvizState FocusType
parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> FocusType
XY forall a. ParseDot a => Parse a
parse
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FocusType
NodeFocus forall a. ParseDot a => Parse a
parse

-- -----------------------------------------------------------------------------

data VerticalPlacement = VTop
                       | VCenter -- ^ Only valid for Nodes.
                       | VBottom
                       deriving (VerticalPlacement -> VerticalPlacement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerticalPlacement -> VerticalPlacement -> Bool
$c/= :: VerticalPlacement -> VerticalPlacement -> Bool
== :: VerticalPlacement -> VerticalPlacement -> Bool
$c== :: VerticalPlacement -> VerticalPlacement -> Bool
Eq, Eq VerticalPlacement
VerticalPlacement -> VerticalPlacement -> Bool
VerticalPlacement -> VerticalPlacement -> Ordering
VerticalPlacement -> VerticalPlacement -> VerticalPlacement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VerticalPlacement -> VerticalPlacement -> VerticalPlacement
$cmin :: VerticalPlacement -> VerticalPlacement -> VerticalPlacement
max :: VerticalPlacement -> VerticalPlacement -> VerticalPlacement
$cmax :: VerticalPlacement -> VerticalPlacement -> VerticalPlacement
>= :: VerticalPlacement -> VerticalPlacement -> Bool
$c>= :: VerticalPlacement -> VerticalPlacement -> Bool
> :: VerticalPlacement -> VerticalPlacement -> Bool
$c> :: VerticalPlacement -> VerticalPlacement -> Bool
<= :: VerticalPlacement -> VerticalPlacement -> Bool
$c<= :: VerticalPlacement -> VerticalPlacement -> Bool
< :: VerticalPlacement -> VerticalPlacement -> Bool
$c< :: VerticalPlacement -> VerticalPlacement -> Bool
compare :: VerticalPlacement -> VerticalPlacement -> Ordering
$ccompare :: VerticalPlacement -> VerticalPlacement -> Ordering
Ord, VerticalPlacement
forall a. a -> a -> Bounded a
maxBound :: VerticalPlacement
$cmaxBound :: VerticalPlacement
minBound :: VerticalPlacement
$cminBound :: VerticalPlacement
Bounded, Int -> VerticalPlacement
VerticalPlacement -> Int
VerticalPlacement -> [VerticalPlacement]
VerticalPlacement -> VerticalPlacement
VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
VerticalPlacement
-> VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VerticalPlacement
-> VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
$cenumFromThenTo :: VerticalPlacement
-> VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
enumFromTo :: VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
$cenumFromTo :: VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
enumFromThen :: VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
$cenumFromThen :: VerticalPlacement -> VerticalPlacement -> [VerticalPlacement]
enumFrom :: VerticalPlacement -> [VerticalPlacement]
$cenumFrom :: VerticalPlacement -> [VerticalPlacement]
fromEnum :: VerticalPlacement -> Int
$cfromEnum :: VerticalPlacement -> Int
toEnum :: Int -> VerticalPlacement
$ctoEnum :: Int -> VerticalPlacement
pred :: VerticalPlacement -> VerticalPlacement
$cpred :: VerticalPlacement -> VerticalPlacement
succ :: VerticalPlacement -> VerticalPlacement
$csucc :: VerticalPlacement -> VerticalPlacement
Enum, Int -> VerticalPlacement -> ShowS
[VerticalPlacement] -> ShowS
VerticalPlacement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerticalPlacement] -> ShowS
$cshowList :: [VerticalPlacement] -> ShowS
show :: VerticalPlacement -> String
$cshow :: VerticalPlacement -> String
showsPrec :: Int -> VerticalPlacement -> ShowS
$cshowsPrec :: Int -> VerticalPlacement -> ShowS
Show, ReadPrec [VerticalPlacement]
ReadPrec VerticalPlacement
Int -> ReadS VerticalPlacement
ReadS [VerticalPlacement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VerticalPlacement]
$creadListPrec :: ReadPrec [VerticalPlacement]
readPrec :: ReadPrec VerticalPlacement
$creadPrec :: ReadPrec VerticalPlacement
readList :: ReadS [VerticalPlacement]
$creadList :: ReadS [VerticalPlacement]
readsPrec :: Int -> ReadS VerticalPlacement
$creadsPrec :: Int -> ReadS VerticalPlacement
Read)

instance PrintDot VerticalPlacement where
  unqtDot :: VerticalPlacement -> DotCode
unqtDot VerticalPlacement
VTop    = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
't'
  unqtDot VerticalPlacement
VCenter = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'c'
  unqtDot VerticalPlacement
VBottom = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'b'

instance ParseDot VerticalPlacement where
  parseUnqt :: Parse VerticalPlacement
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> [String] -> Parse a
stringReps VerticalPlacement
VTop    [String
"top", String
"t"]
                    , forall a. a -> [String] -> Parse a
stringReps VerticalPlacement
VCenter [String
"centre", String
"center", String
"c"]
                    , forall a. a -> [String] -> Parse a
stringReps VerticalPlacement
VBottom [String
"bottom", String
"b"]
                    ]

-- -----------------------------------------------------------------------------

-- | A list of search paths.
newtype Paths = Paths { Paths -> [String]
paths :: [FilePath] }
    deriving (Paths -> Paths -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paths -> Paths -> Bool
$c/= :: Paths -> Paths -> Bool
== :: Paths -> Paths -> Bool
$c== :: Paths -> Paths -> Bool
Eq, Eq Paths
Paths -> Paths -> Bool
Paths -> Paths -> Ordering
Paths -> Paths -> Paths
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Paths -> Paths -> Paths
$cmin :: Paths -> Paths -> Paths
max :: Paths -> Paths -> Paths
$cmax :: Paths -> Paths -> Paths
>= :: Paths -> Paths -> Bool
$c>= :: Paths -> Paths -> Bool
> :: Paths -> Paths -> Bool
$c> :: Paths -> Paths -> Bool
<= :: Paths -> Paths -> Bool
$c<= :: Paths -> Paths -> Bool
< :: Paths -> Paths -> Bool
$c< :: Paths -> Paths -> Bool
compare :: Paths -> Paths -> Ordering
$ccompare :: Paths -> Paths -> Ordering
Ord, Int -> Paths -> ShowS
[Paths] -> ShowS
Paths -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Paths] -> ShowS
$cshowList :: [Paths] -> ShowS
show :: Paths -> String
$cshow :: Paths -> String
showsPrec :: Int -> Paths -> ShowS
$cshowsPrec :: Int -> Paths -> ShowS
Show, ReadPrec [Paths]
ReadPrec Paths
Int -> ReadS Paths
ReadS [Paths]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Paths]
$creadListPrec :: ReadPrec [Paths]
readPrec :: ReadPrec Paths
$creadPrec :: ReadPrec Paths
readList :: ReadS [Paths]
$creadList :: ReadS [Paths]
readsPrec :: Int -> ReadS Paths
$creadsPrec :: Int -> ReadS Paths
Read)

instance PrintDot Paths where
    unqtDot :: Paths -> DotCode
unqtDot = forall a. PrintDot a => a -> DotCode
unqtDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paths -> [String]
paths

    toDot :: Paths -> DotCode
toDot (Paths [String
p]) = forall a. PrintDot a => a -> DotCode
toDot String
p
    toDot Paths
ps          = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot Paths
ps

instance ParseDot Paths where
    parseUnqt :: Parse Paths
parseUnqt = [String] -> Paths
Paths forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitSearchPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt

    parse :: Parse Paths
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
            forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> Paths
Paths forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Parse Text
quotelessString

-- -----------------------------------------------------------------------------

data ScaleType = UniformScale
               | NoScale
               | FillWidth
               | FillHeight
               | FillBoth
               deriving (ScaleType -> ScaleType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScaleType -> ScaleType -> Bool
$c/= :: ScaleType -> ScaleType -> Bool
== :: ScaleType -> ScaleType -> Bool
$c== :: ScaleType -> ScaleType -> Bool
Eq, Eq ScaleType
ScaleType -> ScaleType -> Bool
ScaleType -> ScaleType -> Ordering
ScaleType -> ScaleType -> ScaleType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScaleType -> ScaleType -> ScaleType
$cmin :: ScaleType -> ScaleType -> ScaleType
max :: ScaleType -> ScaleType -> ScaleType
$cmax :: ScaleType -> ScaleType -> ScaleType
>= :: ScaleType -> ScaleType -> Bool
$c>= :: ScaleType -> ScaleType -> Bool
> :: ScaleType -> ScaleType -> Bool
$c> :: ScaleType -> ScaleType -> Bool
<= :: ScaleType -> ScaleType -> Bool
$c<= :: ScaleType -> ScaleType -> Bool
< :: ScaleType -> ScaleType -> Bool
$c< :: ScaleType -> ScaleType -> Bool
compare :: ScaleType -> ScaleType -> Ordering
$ccompare :: ScaleType -> ScaleType -> Ordering
Ord, ScaleType
forall a. a -> a -> Bounded a
maxBound :: ScaleType
$cmaxBound :: ScaleType
minBound :: ScaleType
$cminBound :: ScaleType
Bounded, Int -> ScaleType
ScaleType -> Int
ScaleType -> [ScaleType]
ScaleType -> ScaleType
ScaleType -> ScaleType -> [ScaleType]
ScaleType -> ScaleType -> ScaleType -> [ScaleType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ScaleType -> ScaleType -> ScaleType -> [ScaleType]
$cenumFromThenTo :: ScaleType -> ScaleType -> ScaleType -> [ScaleType]
enumFromTo :: ScaleType -> ScaleType -> [ScaleType]
$cenumFromTo :: ScaleType -> ScaleType -> [ScaleType]
enumFromThen :: ScaleType -> ScaleType -> [ScaleType]
$cenumFromThen :: ScaleType -> ScaleType -> [ScaleType]
enumFrom :: ScaleType -> [ScaleType]
$cenumFrom :: ScaleType -> [ScaleType]
fromEnum :: ScaleType -> Int
$cfromEnum :: ScaleType -> Int
toEnum :: Int -> ScaleType
$ctoEnum :: Int -> ScaleType
pred :: ScaleType -> ScaleType
$cpred :: ScaleType -> ScaleType
succ :: ScaleType -> ScaleType
$csucc :: ScaleType -> ScaleType
Enum, Int -> ScaleType -> ShowS
[ScaleType] -> ShowS
ScaleType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScaleType] -> ShowS
$cshowList :: [ScaleType] -> ShowS
show :: ScaleType -> String
$cshow :: ScaleType -> String
showsPrec :: Int -> ScaleType -> ShowS
$cshowsPrec :: Int -> ScaleType -> ShowS
Show, ReadPrec [ScaleType]
ReadPrec ScaleType
Int -> ReadS ScaleType
ReadS [ScaleType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScaleType]
$creadListPrec :: ReadPrec [ScaleType]
readPrec :: ReadPrec ScaleType
$creadPrec :: ReadPrec ScaleType
readList :: ReadS [ScaleType]
$creadList :: ReadS [ScaleType]
readsPrec :: Int -> ReadS ScaleType
$creadsPrec :: Int -> ReadS ScaleType
Read)

instance PrintDot ScaleType where
  unqtDot :: ScaleType -> DotCode
unqtDot ScaleType
UniformScale = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot ScaleType
NoScale      = forall a. PrintDot a => a -> DotCode
unqtDot Bool
False
  unqtDot ScaleType
FillWidth    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"width"
  unqtDot ScaleType
FillHeight   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"height"
  unqtDot ScaleType
FillBoth     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"both"

instance ParseDot ScaleType where
  parseUnqt :: Parse ScaleType
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep ScaleType
UniformScale String
"true"
                    , forall a. a -> String -> Parse a
stringRep ScaleType
NoScale String
"false"
                    , forall a. a -> String -> Parse a
stringRep ScaleType
FillWidth String
"width"
                    , forall a. a -> String -> Parse a
stringRep ScaleType
FillHeight String
"height"
                    , forall a. a -> String -> Parse a
stringRep ScaleType
FillBoth String
"both"
                    ]

-- -----------------------------------------------------------------------------

data Justification = JLeft
                   | JRight
                   | JCenter
                   deriving (Justification -> Justification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Justification -> Justification -> Bool
$c/= :: Justification -> Justification -> Bool
== :: Justification -> Justification -> Bool
$c== :: Justification -> Justification -> Bool
Eq, Eq Justification
Justification -> Justification -> Bool
Justification -> Justification -> Ordering
Justification -> Justification -> Justification
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Justification -> Justification -> Justification
$cmin :: Justification -> Justification -> Justification
max :: Justification -> Justification -> Justification
$cmax :: Justification -> Justification -> Justification
>= :: Justification -> Justification -> Bool
$c>= :: Justification -> Justification -> Bool
> :: Justification -> Justification -> Bool
$c> :: Justification -> Justification -> Bool
<= :: Justification -> Justification -> Bool
$c<= :: Justification -> Justification -> Bool
< :: Justification -> Justification -> Bool
$c< :: Justification -> Justification -> Bool
compare :: Justification -> Justification -> Ordering
$ccompare :: Justification -> Justification -> Ordering
Ord, Justification
forall a. a -> a -> Bounded a
maxBound :: Justification
$cmaxBound :: Justification
minBound :: Justification
$cminBound :: Justification
Bounded, Int -> Justification
Justification -> Int
Justification -> [Justification]
Justification -> Justification
Justification -> Justification -> [Justification]
Justification -> Justification -> Justification -> [Justification]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Justification -> Justification -> Justification -> [Justification]
$cenumFromThenTo :: Justification -> Justification -> Justification -> [Justification]
enumFromTo :: Justification -> Justification -> [Justification]
$cenumFromTo :: Justification -> Justification -> [Justification]
enumFromThen :: Justification -> Justification -> [Justification]
$cenumFromThen :: Justification -> Justification -> [Justification]
enumFrom :: Justification -> [Justification]
$cenumFrom :: Justification -> [Justification]
fromEnum :: Justification -> Int
$cfromEnum :: Justification -> Int
toEnum :: Int -> Justification
$ctoEnum :: Int -> Justification
pred :: Justification -> Justification
$cpred :: Justification -> Justification
succ :: Justification -> Justification
$csucc :: Justification -> Justification
Enum, Int -> Justification -> ShowS
[Justification] -> ShowS
Justification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Justification] -> ShowS
$cshowList :: [Justification] -> ShowS
show :: Justification -> String
$cshow :: Justification -> String
showsPrec :: Int -> Justification -> ShowS
$cshowsPrec :: Int -> Justification -> ShowS
Show, ReadPrec [Justification]
ReadPrec Justification
Int -> ReadS Justification
ReadS [Justification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Justification]
$creadListPrec :: ReadPrec [Justification]
readPrec :: ReadPrec Justification
$creadPrec :: ReadPrec Justification
readList :: ReadS [Justification]
$creadList :: ReadS [Justification]
readsPrec :: Int -> ReadS Justification
$creadsPrec :: Int -> ReadS Justification
Read)

instance PrintDot Justification where
  unqtDot :: Justification -> DotCode
unqtDot Justification
JLeft   = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'l'
  unqtDot Justification
JRight  = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'r'
  unqtDot Justification
JCenter = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'c'

instance ParseDot Justification where
  parseUnqt :: Parse Justification
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> [String] -> Parse a
stringReps Justification
JLeft [String
"left", String
"l"]
                    , forall a. a -> [String] -> Parse a
stringReps Justification
JRight [String
"right", String
"r"]
                    , forall a. a -> [String] -> Parse a
stringReps Justification
JCenter [String
"center", String
"centre", String
"c"]
                    ]

-- -----------------------------------------------------------------------------

data Ratios = AspectRatio Double
            | FillRatio
            | CompressRatio
            | ExpandRatio
            | AutoRatio
            deriving (Ratios -> Ratios -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ratios -> Ratios -> Bool
$c/= :: Ratios -> Ratios -> Bool
== :: Ratios -> Ratios -> Bool
$c== :: Ratios -> Ratios -> Bool
Eq, Eq Ratios
Ratios -> Ratios -> Bool
Ratios -> Ratios -> Ordering
Ratios -> Ratios -> Ratios
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ratios -> Ratios -> Ratios
$cmin :: Ratios -> Ratios -> Ratios
max :: Ratios -> Ratios -> Ratios
$cmax :: Ratios -> Ratios -> Ratios
>= :: Ratios -> Ratios -> Bool
$c>= :: Ratios -> Ratios -> Bool
> :: Ratios -> Ratios -> Bool
$c> :: Ratios -> Ratios -> Bool
<= :: Ratios -> Ratios -> Bool
$c<= :: Ratios -> Ratios -> Bool
< :: Ratios -> Ratios -> Bool
$c< :: Ratios -> Ratios -> Bool
compare :: Ratios -> Ratios -> Ordering
$ccompare :: Ratios -> Ratios -> Ordering
Ord, Int -> Ratios -> ShowS
[Ratios] -> ShowS
Ratios -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ratios] -> ShowS
$cshowList :: [Ratios] -> ShowS
show :: Ratios -> String
$cshow :: Ratios -> String
showsPrec :: Int -> Ratios -> ShowS
$cshowsPrec :: Int -> Ratios -> ShowS
Show, ReadPrec [Ratios]
ReadPrec Ratios
Int -> ReadS Ratios
ReadS [Ratios]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ratios]
$creadListPrec :: ReadPrec [Ratios]
readPrec :: ReadPrec Ratios
$creadPrec :: ReadPrec Ratios
readList :: ReadS [Ratios]
$creadList :: ReadS [Ratios]
readsPrec :: Int -> ReadS Ratios
$creadsPrec :: Int -> ReadS Ratios
Read)

instance PrintDot Ratios where
  unqtDot :: Ratios -> DotCode
unqtDot (AspectRatio Double
r) = forall a. PrintDot a => a -> DotCode
unqtDot Double
r
  unqtDot Ratios
FillRatio       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"fill"
  unqtDot Ratios
CompressRatio   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"compress"
  unqtDot Ratios
ExpandRatio     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"expand"
  unqtDot Ratios
AutoRatio       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"auto"

  toDot :: Ratios -> DotCode
toDot (AspectRatio Double
r) = forall a. PrintDot a => a -> DotCode
toDot Double
r
  toDot Ratios
r               = forall a. PrintDot a => a -> DotCode
unqtDot Ratios
r

instance ParseDot Ratios where
  parseUnqt :: Parse Ratios
parseUnqt = Bool -> Parse Ratios
parseRatio Bool
True

  parse :: Parse Ratios
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parse Ratios
parseRatio Bool
False

parseRatio   :: Bool -> Parse Ratios
parseRatio :: Bool -> Parse Ratios
parseRatio Bool
q = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Double -> Ratios
AspectRatio forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parse Double
parseSignedFloat Bool
q
                     , forall a. a -> String -> Parse a
stringRep Ratios
FillRatio String
"fill"
                     , forall a. a -> String -> Parse a
stringRep Ratios
CompressRatio String
"compress"
                     , forall a. a -> String -> Parse a
stringRep Ratios
ExpandRatio String
"expand"
                     , forall a. a -> String -> Parse a
stringRep Ratios
AutoRatio String
"auto"
                     ]

-- -----------------------------------------------------------------------------

-- | A numeric type with an explicit separation between integers and
--   floating-point values.
data Number = Int Int
            | Dbl Double
            deriving (Number -> Number -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c== :: Number -> Number -> Bool
Eq, Eq Number
Number -> Number -> Bool
Number -> Number -> Ordering
Number -> Number -> Number
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Number -> Number -> Number
$cmin :: Number -> Number -> Number
max :: Number -> Number -> Number
$cmax :: Number -> Number -> Number
>= :: Number -> Number -> Bool
$c>= :: Number -> Number -> Bool
> :: Number -> Number -> Bool
$c> :: Number -> Number -> Bool
<= :: Number -> Number -> Bool
$c<= :: Number -> Number -> Bool
< :: Number -> Number -> Bool
$c< :: Number -> Number -> Bool
compare :: Number -> Number -> Ordering
$ccompare :: Number -> Number -> Ordering
Ord, Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Number] -> ShowS
$cshowList :: [Number] -> ShowS
show :: Number -> String
$cshow :: Number -> String
showsPrec :: Int -> Number -> ShowS
$cshowsPrec :: Int -> Number -> ShowS
Show, ReadPrec [Number]
ReadPrec Number
Int -> ReadS Number
ReadS [Number]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Number]
$creadListPrec :: ReadPrec [Number]
readPrec :: ReadPrec Number
$creadPrec :: ReadPrec Number
readList :: ReadS [Number]
$creadList :: ReadS [Number]
readsPrec :: Int -> ReadS Number
$creadsPrec :: Int -> ReadS Number
Read)

instance PrintDot Number where
  unqtDot :: Number -> DotCode
unqtDot (Int Int
i) = forall a. PrintDot a => a -> DotCode
unqtDot Int
i
  unqtDot (Dbl Double
d) = forall a. PrintDot a => a -> DotCode
unqtDot Double
d

  toDot :: Number -> DotCode
toDot (Int Int
i) = forall a. PrintDot a => a -> DotCode
toDot Int
i
  toDot (Dbl Double
d) = forall a. PrintDot a => a -> DotCode
toDot Double
d

instance ParseDot Number where
  parseUnqt :: Parse Number
parseUnqt = Bool -> Parse Number
parseNumber Bool
True

  parse :: Parse Number
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          Bool -> Parse Number
parseNumber Bool
False

parseNumber   :: Bool -> Parse Number
parseNumber :: Bool -> Parse Number
parseNumber Bool
q = Double -> Number
Dbl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parse Double
parseStrictFloat Bool
q
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                Int -> Number
Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt

-- -----------------------------------------------------------------------------

-- | If set, normalizes coordinates such that the first point is at
--   the origin and the first edge is at the angle if specified.
data Normalized = IsNormalized -- ^ Equivalent to @'NormalizedAngle' 0@.
                | NotNormalized
                | NormalizedAngle Double -- ^ Angle of first edge when
                                         --   normalized.  Requires
                                         --   Graphviz >= 2.32.0.
                deriving (Normalized -> Normalized -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Normalized -> Normalized -> Bool
$c/= :: Normalized -> Normalized -> Bool
== :: Normalized -> Normalized -> Bool
$c== :: Normalized -> Normalized -> Bool
Eq, Eq Normalized
Normalized -> Normalized -> Bool
Normalized -> Normalized -> Ordering
Normalized -> Normalized -> Normalized
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Normalized -> Normalized -> Normalized
$cmin :: Normalized -> Normalized -> Normalized
max :: Normalized -> Normalized -> Normalized
$cmax :: Normalized -> Normalized -> Normalized
>= :: Normalized -> Normalized -> Bool
$c>= :: Normalized -> Normalized -> Bool
> :: Normalized -> Normalized -> Bool
$c> :: Normalized -> Normalized -> Bool
<= :: Normalized -> Normalized -> Bool
$c<= :: Normalized -> Normalized -> Bool
< :: Normalized -> Normalized -> Bool
$c< :: Normalized -> Normalized -> Bool
compare :: Normalized -> Normalized -> Ordering
$ccompare :: Normalized -> Normalized -> Ordering
Ord, Int -> Normalized -> ShowS
[Normalized] -> ShowS
Normalized -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Normalized] -> ShowS
$cshowList :: [Normalized] -> ShowS
show :: Normalized -> String
$cshow :: Normalized -> String
showsPrec :: Int -> Normalized -> ShowS
$cshowsPrec :: Int -> Normalized -> ShowS
Show, ReadPrec [Normalized]
ReadPrec Normalized
Int -> ReadS Normalized
ReadS [Normalized]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Normalized]
$creadListPrec :: ReadPrec [Normalized]
readPrec :: ReadPrec Normalized
$creadPrec :: ReadPrec Normalized
readList :: ReadS [Normalized]
$creadList :: ReadS [Normalized]
readsPrec :: Int -> ReadS Normalized
$creadsPrec :: Int -> ReadS Normalized
Read)

instance PrintDot Normalized where
  unqtDot :: Normalized -> DotCode
unqtDot Normalized
IsNormalized        = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot Normalized
NotNormalized       = forall a. PrintDot a => a -> DotCode
unqtDot Bool
False
  unqtDot (NormalizedAngle Double
a) = forall a. PrintDot a => a -> DotCode
unqtDot Double
a

  toDot :: Normalized -> DotCode
toDot (NormalizedAngle Double
a) = forall a. PrintDot a => a -> DotCode
toDot Double
a
  toDot Normalized
norm                = forall a. PrintDot a => a -> DotCode
unqtDot Normalized
norm

instance ParseDot Normalized where
  parseUnqt :: Parse Normalized
parseUnqt = Bool -> Parse Normalized
parseNormalized Bool
True

  parse :: Parse Normalized
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parse Normalized
parseNormalized Bool
False

parseNormalized :: Bool -> Parse Normalized
parseNormalized :: Bool -> Parse Normalized
parseNormalized Bool
q = Double -> Normalized
NormalizedAngle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parse Double
parseSignedFloat Bool
q
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    forall a. a -> a -> Bool -> a
bool Normalized
NotNormalized Normalized
IsNormalized forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState Bool
onlyBool

-- -----------------------------------------------------------------------------

-- | Determine how the 'Width' and 'Height' attributes specify the
--   size of nodes.
data NodeSize = GrowAsNeeded
                -- ^ Nodes will be the smallest width and height
                --   needed to contain the label and any possible
                --   image.  'Width' and 'Height' are the minimum
                --   allowed sizes.
              | SetNodeSize
                -- ^ 'Width' and 'Height' dictate the size of the node
                --   with a warning if the label cannot fit in this.
              | SetShapeSize
                -- ^ 'Width' and 'Height' dictate the size of the
                --   shape only and the label can expand out of the
                --   shape (with a warning).  Requires Graphviz >=
                --   2.38.0.
              deriving (NodeSize -> NodeSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeSize -> NodeSize -> Bool
$c/= :: NodeSize -> NodeSize -> Bool
== :: NodeSize -> NodeSize -> Bool
$c== :: NodeSize -> NodeSize -> Bool
Eq, Eq NodeSize
NodeSize -> NodeSize -> Bool
NodeSize -> NodeSize -> Ordering
NodeSize -> NodeSize -> NodeSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeSize -> NodeSize -> NodeSize
$cmin :: NodeSize -> NodeSize -> NodeSize
max :: NodeSize -> NodeSize -> NodeSize
$cmax :: NodeSize -> NodeSize -> NodeSize
>= :: NodeSize -> NodeSize -> Bool
$c>= :: NodeSize -> NodeSize -> Bool
> :: NodeSize -> NodeSize -> Bool
$c> :: NodeSize -> NodeSize -> Bool
<= :: NodeSize -> NodeSize -> Bool
$c<= :: NodeSize -> NodeSize -> Bool
< :: NodeSize -> NodeSize -> Bool
$c< :: NodeSize -> NodeSize -> Bool
compare :: NodeSize -> NodeSize -> Ordering
$ccompare :: NodeSize -> NodeSize -> Ordering
Ord, NodeSize
forall a. a -> a -> Bounded a
maxBound :: NodeSize
$cmaxBound :: NodeSize
minBound :: NodeSize
$cminBound :: NodeSize
Bounded, Int -> NodeSize
NodeSize -> Int
NodeSize -> [NodeSize]
NodeSize -> NodeSize
NodeSize -> NodeSize -> [NodeSize]
NodeSize -> NodeSize -> NodeSize -> [NodeSize]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NodeSize -> NodeSize -> NodeSize -> [NodeSize]
$cenumFromThenTo :: NodeSize -> NodeSize -> NodeSize -> [NodeSize]
enumFromTo :: NodeSize -> NodeSize -> [NodeSize]
$cenumFromTo :: NodeSize -> NodeSize -> [NodeSize]
enumFromThen :: NodeSize -> NodeSize -> [NodeSize]
$cenumFromThen :: NodeSize -> NodeSize -> [NodeSize]
enumFrom :: NodeSize -> [NodeSize]
$cenumFrom :: NodeSize -> [NodeSize]
fromEnum :: NodeSize -> Int
$cfromEnum :: NodeSize -> Int
toEnum :: Int -> NodeSize
$ctoEnum :: Int -> NodeSize
pred :: NodeSize -> NodeSize
$cpred :: NodeSize -> NodeSize
succ :: NodeSize -> NodeSize
$csucc :: NodeSize -> NodeSize
Enum, Int -> NodeSize -> ShowS
[NodeSize] -> ShowS
NodeSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeSize] -> ShowS
$cshowList :: [NodeSize] -> ShowS
show :: NodeSize -> String
$cshow :: NodeSize -> String
showsPrec :: Int -> NodeSize -> ShowS
$cshowsPrec :: Int -> NodeSize -> ShowS
Show, ReadPrec [NodeSize]
ReadPrec NodeSize
Int -> ReadS NodeSize
ReadS [NodeSize]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeSize]
$creadListPrec :: ReadPrec [NodeSize]
readPrec :: ReadPrec NodeSize
$creadPrec :: ReadPrec NodeSize
readList :: ReadS [NodeSize]
$creadList :: ReadS [NodeSize]
readsPrec :: Int -> ReadS NodeSize
$creadsPrec :: Int -> ReadS NodeSize
Read)

instance PrintDot NodeSize where
  unqtDot :: NodeSize -> DotCode
unqtDot NodeSize
GrowAsNeeded = forall a. PrintDot a => a -> DotCode
unqtDot Bool
False
  unqtDot NodeSize
SetNodeSize  = forall a. PrintDot a => a -> DotCode
unqtDot Bool
True
  unqtDot NodeSize
SetShapeSize = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"shape"

instance ParseDot NodeSize where
  parseUnqt :: Parse NodeSize
parseUnqt = forall a. a -> a -> Bool -> a
bool NodeSize
GrowAsNeeded NodeSize
SetNodeSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              forall a. a -> String -> Parse a
stringRep NodeSize
SetShapeSize String
"shape"

-- -----------------------------------------------------------------------------

{-

As of Graphviz 2.36.0 this was commented out; as such it might come
back, so leave this here in case we need it again.

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

instance PrintDot AspectType where
  unqtDot (RatioOnly r)        = unqtDot r
  unqtDot (RatioPassCount r p) = commaDel r p

  toDot at@RatioOnly{}      = unqtDot at
  toDot at@RatioPassCount{} = dquotes $ unqtDot at

instance ParseDot AspectType where
  parseUnqt = fmap (uncurry RatioPassCount) commaSepUnqt
              `onFail`
              fmap RatioOnly parseUnqt


  parse = quotedParse (uncurry RatioPassCount <$> commaSepUnqt)
          `onFail`
          fmap RatioOnly parse

-}