    {-# LANGUAGE CPP, OverloadedStrings #-}

    {- |
       Module      : Data.GraphViz.Attributes.Colors
       Description : Specification of Color-related types and functions.
       Copyright   : (c) Ivan Lazar Miljenovic
       License     : 3-Clause BSD-style
       Maintainer  : Ivan.Miljenovic@gmail.com

       This module defines the various colors, etc. for Graphviz.  For
       information on colors in general, see:
         <http://graphviz.org/doc/info/attrs.html#k:color>
       For named colors, see:
         <http://graphviz.org/doc/info/colors.html>

       Note that the ColorBrewer Color Schemes (shortened to just
       \"Brewer\" for the rest of this module) are covered by the
       following license (also available in the LICENSE file of this
       library):
         <http://graphviz.org/doc/info/colors.html#brewer_license>
    -}
    module Data.GraphViz.Attributes.Colors
           ( -- * Color schemes.
             ColorScheme(..)
             -- * Colors
           , Color(..)
           , ColorList
           , WeightedColor(..)
           , toWC
           , toColorList
           , NamedColor(toColor)
           , toWColor
             -- * Conversion to\/from @Colour@.
           , toColour
           , fromColour
           , fromAColour
           ) where

    import Data.GraphViz.Attributes.Colors.Brewer (BrewerColor(..))
    import Data.GraphViz.Attributes.Colors.SVG    (SVGColor, svgColour)
    import Data.GraphViz.Attributes.Colors.X11    (X11Color(Transparent), x11Colour)
    import Data.GraphViz.Attributes.ColorScheme   (ColorScheme(..))
    import Data.GraphViz.Exception
    import Data.GraphViz.Internal.State
    import Data.GraphViz.Internal.Util            (bool)
    import Data.GraphViz.Parsing
    import Data.GraphViz.Printing

    import Data.Colour              (AlphaColour, alphaChannel, black, darken,
                                     opaque, over, withOpacity)
    import Data.Colour.RGBSpace     (uncurryRGB)
    import Data.Colour.RGBSpace.HSV (hsv)
    import Data.Colour.SRGB         (Colour, sRGB, sRGB24, toSRGB24)

    import           Data.Char      (isHexDigit)
    import           Data.Maybe     (isJust)
    import qualified Data.Text.Lazy as T
    import           Data.Word      (Word8)
    import           Numeric        (readHex, showHex)

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

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

    -- | Defining a color for use with Graphviz.  Note that named colors
    --   have been split up into 'X11Color's and those based upon the
    --   Brewer color schemes.
    data Color = RGB { Color -> Word8
    red   :: Word8
                     , Color -> Word8
    green :: Word8
                     , Color -> Word8
    blue  :: Word8
                     }
               | RGBA { red   :: Word8
                      , green :: Word8
                      , blue  :: Word8
                      , Color -> Word8
    alpha :: Word8
                      }
                 -- | The 'hue', 'saturation' and 'value' values must all
                 --   be @0 <= x <=1@.
               | HSV { Color -> Double
    hue        :: Double
                     , Color -> Double
    saturation :: Double
                     , Color -> Double
    value      :: Double
                     }
               | X11Color X11Color
               | SVGColor SVGColor
               | BrewerColor BrewerColor
               deriving (Color -> Color -> Bool
    (Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Color -> Color -> Bool
    == :: Color -> Color -> Bool
    $c/= :: Color -> Color -> Bool
    /= :: Color -> Color -> Bool
    Eq, Eq Color
    Eq Color =>
    (Color -> Color -> Ordering)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Bool)
    -> (Color -> Color -> Color)
    -> (Color -> Color -> Color)
    -> Ord Color
    Color -> Color -> Bool
    Color -> Color -> Ordering
    Color -> Color -> Color
    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
    $ccompare :: Color -> Color -> Ordering
    compare :: Color -> Color -> Ordering
    $c< :: Color -> Color -> Bool
    < :: Color -> Color -> Bool
    $c<= :: Color -> Color -> Bool
    <= :: Color -> Color -> Bool
    $c> :: Color -> Color -> Bool
    > :: Color -> Color -> Bool
    $c>= :: Color -> Color -> Bool
    >= :: Color -> Color -> Bool
    $cmax :: Color -> Color -> Color
    max :: Color -> Color -> Color
    $cmin :: Color -> Color -> Color
    min :: Color -> Color -> Color
    Ord, Int -> Color -> ShowS
    [Color] -> ShowS
    Color -> String
    (Int -> Color -> ShowS)
    -> (Color -> String) -> ([Color] -> ShowS) -> Show Color
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Color -> ShowS
    showsPrec :: Int -> Color -> ShowS
    $cshow :: Color -> String
    show :: Color -> String
    $cshowList :: [Color] -> ShowS
    showList :: [Color] -> ShowS
    Show, ReadPrec [Color]
    ReadPrec Color
    Int -> ReadS Color
    ReadS [Color]
    (Int -> ReadS Color)
    -> ReadS [Color]
    -> ReadPrec Color
    -> ReadPrec [Color]
    -> Read Color
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Color
    readsPrec :: Int -> ReadS Color
    $creadList :: ReadS [Color]
    readList :: ReadS [Color]
    $creadPrec :: ReadPrec Color
    readPrec :: ReadPrec Color
    $creadListPrec :: ReadPrec [Color]
    readListPrec :: ReadPrec [Color]
    Read)

    instance PrintDot Color where
      unqtDot :: Color -> DotCode
    unqtDot (RGB  Word8
    r Word8
    g Word8
    b)     = [Word8] -> DotCode
    hexColor [Word8
    r,Word8
    g,Word8
    b]
      unqtDot (RGBA Word8
    r Word8
    g Word8
    b Word8
    a)   = [Word8] -> DotCode
    hexColor [Word8
    r,Word8
    g,Word8
    b,Word8
    a]
      unqtDot (HSV  Double
    h Double
    s Double
    v)     = DotCodeM [Doc] -> DotCode
    forall (m :: * -> *). Functor m => m [Doc] -> m Doc
    hcat (DotCodeM [Doc] -> DotCode)
    -> (DotCodeM [Doc] -> DotCodeM [Doc]) -> DotCodeM [Doc] -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCode -> DotCodeM [Doc] -> DotCodeM [Doc]
    forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
    punctuate DotCode
    forall (m :: * -> *). Applicative m => m Doc
    comma (DotCodeM [Doc] -> DotCode) -> DotCodeM [Doc] -> DotCode
    forall a b. (a -> b) -> a -> b
    $ (Double -> DotCode) -> [Double] -> DotCodeM [Doc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Double -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot [Double
    h,Double
    s,Double
    v]
      unqtDot (SVGColor SVGColor
    name)  = Bool -> SVGColor -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    False SVGColor
    name
      unqtDot (X11Color X11Color
    name)  = Bool -> X11Color -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    False X11Color
    name
      unqtDot (BrewerColor BrewerColor
    bc) = Bool -> BrewerColor -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    False BrewerColor
    bc

      -- Some cases might not need quotes.
      toDot :: Color -> DotCode
    toDot (X11Color X11Color
    name)  = Bool -> X11Color -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    True X11Color
    name
      toDot (SVGColor SVGColor
    name)  = Bool -> SVGColor -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    True SVGColor
    name
      toDot (BrewerColor BrewerColor
    bc) = Bool -> BrewerColor -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    True BrewerColor
    bc
      toDot Color
    c                = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ Color -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot Color
    c

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

      -- These three might not need to be quoted if they're on their own.
      listToDot :: [Color] -> DotCode
    listToDot [X11Color X11Color
    name]  = Bool -> X11Color -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    True X11Color
    name
      listToDot [SVGColor SVGColor
    name]  = Bool -> SVGColor -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    True SVGColor
    name
      listToDot [BrewerColor BrewerColor
    bc] = Bool -> BrewerColor -> DotCode
    forall nc. NamedColor nc => Bool -> nc -> DotCode
    printNC Bool
    True BrewerColor
    bc
      listToDot [Color]
    cs               = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ [Color] -> DotCode
    forall a. PrintDot a => [a] -> DotCode
    unqtListToDot [Color]
    cs

    hexColor :: [Word8] -> DotCode
    hexColor :: [Word8] -> DotCode
    hexColor = DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    (<>) (Char -> DotCode
    forall (m :: * -> *). Applicative m => Char -> m Doc
    char Char
    '#') (DotCode -> DotCode) -> ([Word8] -> DotCode) -> [Word8] -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCodeM [Doc] -> DotCode
    forall (m :: * -> *). Functor m => m [Doc] -> m Doc
    hcat (DotCodeM [Doc] -> DotCode)
    -> ([Word8] -> DotCodeM [Doc]) -> [Word8] -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8 -> DotCode) -> [Word8] -> DotCodeM [Doc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Word8 -> DotCode
    word8Doc

    word8Doc   :: Word8 -> DotCode
    word8Doc :: Word8 -> DotCode
    word8Doc Word8
    w = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text (Text -> DotCode) -> Text -> DotCode
    forall a b. (a -> b) -> a -> b
    $ Text
    padding Text -> Text -> Text
    `T.append` Text
    simple
      where
        simple :: Text
    simple = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Word8 -> ShowS
    forall a. Integral a => a -> ShowS
    showHex Word8
    w String
    ""
        padding :: Text
    padding = Int64 -> Text -> Text
    T.replicate Int64
    count (Char -> Text
    T.singleton Char
    '0')
        count :: Int64
    count = Int64
    2 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Int64 -> Word8 -> Int64
    forall {t} {t}. (Num t, Integral t) => t -> t -> t
    findCols Int64
    1 Word8
    w
        findCols :: t -> t -> t
    findCols t
    c t
    n
          | t
    n t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    < t
    16 = t
    c
          | Bool
    otherwise = t -> t -> t
    findCols (t
    ct -> t -> t
    forall a. Num a => a -> a -> a
    +t
    1) (t
    n t -> t -> t
    forall a. Integral a => a -> a -> a
    `div` t
    16)

    instance ParseDot Color where
      parseUnqt :: Parse Color
    parseUnqt = [Parse Color] -> Parse Color
    forall (p :: * -> *) a. PolyParse p => [p a] -> p a
    oneOf [ Parse Color
    parseHexBased
                        , Parse Color
    parseHSV
                          -- Have to parse BrewerColor first, as some of them may appear to be X11 colors
                        , BrewerColor -> Bool -> Parse Color
    forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC (BrewerColor
    forall a. HasCallStack => a
    undefined :: BrewerColor) Bool
    False
                        , SVGColor -> Bool -> Parse Color
    forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC (SVGColor
    forall a. HasCallStack => a
    undefined :: SVGColor) Bool
    False
                        , Bool -> Parse Color
    parseX11Color Bool
    False
                        ]
                  Parse Color -> Parse Color -> Parse Color
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                  String -> Parse Color
    forall a. String -> Parser GraphvizState a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Could not parse Color"
        where
          parseHexBased :: Parse Color
    parseHexBased
              = Char -> Parse Char
    character Char
    '#' Parse Char -> Parse Color -> Parse Color
    forall a b.
    Parser GraphvizState a
    -> Parser GraphvizState b -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *>
                do cs <- Parser GraphvizState Word8 -> Parser GraphvizState [Word8]
    forall (p :: * -> *) a. PolyParse p => p a -> p [a]
    many1 Parser GraphvizState Word8
    forall {s}. Parser s Word8
    parse2Hex
                   return $ case cs of
                              [Word8
    r,Word8
    g,Word8
    b] -> Word8 -> Word8 -> Word8 -> Color
    RGB Word8
    r Word8
    g Word8
    b
                              [Word8
    r,Word8
    g,Word8
    b,Word8
    a] -> Word8 -> Word8 -> Word8 -> Word8 -> Color
    RGBA Word8
    r Word8
    g Word8
    b Word8
    a
                              [Word8]
    _ -> GraphvizException -> Color
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (GraphvizException -> Color)
    -> (String -> GraphvizException) -> String -> Color
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> GraphvizException
    NotDotCode
                                   (String -> Color) -> String -> Color
    forall a b. (a -> b) -> a -> b
    $ String
    "Not a valid hex Color specification: "
                                      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Word8] -> String
    forall a. Show a => a -> String
    show [Word8]
    cs
          parseHSV :: Parse Color
    parseHSV = Double -> Double -> Double -> Color
    HSV (Double -> Double -> Double -> Color)
    -> Parser GraphvizState Double
    -> Parser GraphvizState (Double -> Double -> Color)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser GraphvizState Double
    forall a. ParseDot a => Parse a
    parseUnqt
                         Parser GraphvizState (Double -> Double -> Color)
    -> Parser GraphvizState ()
    -> Parser GraphvizState (Double -> Double -> Color)
    forall a b.
    Parser GraphvizState a
    -> Parser GraphvizState b -> Parser GraphvizState a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*  Parser GraphvizState ()
    parseSep
                         Parser GraphvizState (Double -> Double -> Color)
    -> Parser GraphvizState Double
    -> Parser GraphvizState (Double -> Color)
    forall a b.
    Parser GraphvizState (a -> b)
    -> Parser GraphvizState a -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser GraphvizState Double
    forall a. ParseDot a => Parse a
    parseUnqt
                         Parser GraphvizState (Double -> Color)
    -> Parser GraphvizState ()
    -> Parser GraphvizState (Double -> Color)
    forall a b.
    Parser GraphvizState a
    -> Parser GraphvizState b -> Parser GraphvizState a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*  Parser GraphvizState ()
    parseSep
                         Parser GraphvizState (Double -> Color)
    -> Parser GraphvizState Double -> Parse Color
    forall a b.
    Parser GraphvizState (a -> b)
    -> Parser GraphvizState a -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser GraphvizState Double
    forall a. ParseDot a => Parse a
    parseUnqt
          parseSep :: Parser GraphvizState ()
    parseSep = Char -> Parse Char
    character Char
    ',' Parse Char -> Parser GraphvizState () -> Parser GraphvizState ()
    forall a b.
    Parser GraphvizState a
    -> Parser GraphvizState b -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser GraphvizState ()
    whitespace Parser GraphvizState ()
    -> Parser GraphvizState () -> Parser GraphvizState ()
    forall a.
    Parser GraphvizState a
    -> Parser GraphvizState a -> Parser GraphvizState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser GraphvizState ()
    whitespace1

          parse2Hex :: Parser s Word8
    parse2Hex = do c1 <- (Char -> Bool) -> Parser s Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfy Char -> Bool
    isHexDigit
                         c2 <- satisfy isHexDigit
                         let [(n, [])] = readHex [c1, c2]
                         return n

      parse :: Parse Color
    parse = Parse Color -> Parse Color
    forall a. Parse a -> Parse a
    quotedParse Parse Color
    forall a. ParseDot a => Parse a
    parseUnqt
              Parse Color -> Parse Color -> Parse Color
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail` -- These three might not need to be quoted
              [Parse Color] -> Parse Color
    forall (p :: * -> *) a. PolyParse p => [p a] -> p a
    oneOf [ BrewerColor -> Bool -> Parse Color
    forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC (BrewerColor
    forall a. HasCallStack => a
    undefined :: BrewerColor) Bool
    True
                    , SVGColor -> Bool -> Parse Color
    forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC (SVGColor
    forall a. HasCallStack => a
    undefined :: SVGColor) Bool
    True
                    , Bool -> Parse Color
    parseX11Color Bool
    True
                    ]
              Parse Color -> Parse Color -> Parse Color
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
              String -> Parse Color
    forall a. String -> Parser GraphvizState a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Could not parse Color"

      parseUnqtList :: Parse [Color]
    parseUnqtList = Parse Color -> Parse Char -> Parse [Color]
    forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
    sepBy1 Parse Color
    forall a. ParseDot a => Parse a
    parseUnqt (Char -> Parse Char
    character Char
    ':')
                      Parse [Color] -> Parse [Color] -> Parse [Color]
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                      do cs <- Parser GraphvizState ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
                         failBad $ "Error parsing list of Colors with color scheme of "
                                   ++ show cs

      parseList :: Parse [Color]
    parseList = (Color -> [Color]) -> Parse Color -> Parse [Color]
    forall a b.
    (a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Color -> [Color] -> [Color]
    forall a. a -> [a] -> [a]
    :[])
                  -- Potentially unquoted single color
                  ([Parse Color] -> Parse Color
    forall (p :: * -> *) a. PolyParse p => [p a] -> p a
    oneOf [ BrewerColor -> Bool -> Parse Color
    forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC (BrewerColor
    forall a. HasCallStack => a
    undefined :: BrewerColor) Bool
    True
                         , SVGColor -> Bool -> Parse Color
    forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC (SVGColor
    forall a. HasCallStack => a
    undefined :: SVGColor) Bool
    True
                         , Bool -> Parse Color
    parseX11Color Bool
    True
                         ]
                  )
                  Parse [Color] -> Parse [Color] -> Parse [Color]
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                  Parse [Color] -> Parse [Color]
    forall a. Parse a -> Parse a
    quotedParse Parse [Color]
    forall a. ParseDot a => Parse [a]
    parseUnqtList
                  Parse [Color] -> Parse [Color] -> Parse [Color]
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                  do cs <- Parser GraphvizState ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
                     failBad $ "Error parsing list of Colors with color scheme of "
                               ++ show cs

    -- | The sum of the optional weightings /must/ sum to at most @1@.
    type ColorList = [WeightedColor]

    -- | A 'Color' tagged with an optional weighting.
    data WeightedColor = WC { WeightedColor -> Color
    wColor    :: Color
                              -- | Must be in range @0 <= W <= 1@.
                            , WeightedColor -> Maybe Double
    weighting :: Maybe Double
                            }
                       deriving (WeightedColor -> WeightedColor -> Bool
    (WeightedColor -> WeightedColor -> Bool)
    -> (WeightedColor -> WeightedColor -> Bool) -> Eq WeightedColor
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: WeightedColor -> WeightedColor -> Bool
    == :: WeightedColor -> WeightedColor -> Bool
    $c/= :: WeightedColor -> WeightedColor -> Bool
    /= :: WeightedColor -> WeightedColor -> Bool
    Eq, Eq WeightedColor
    Eq WeightedColor =>
    (WeightedColor -> WeightedColor -> Ordering)
    -> (WeightedColor -> WeightedColor -> Bool)
    -> (WeightedColor -> WeightedColor -> Bool)
    -> (WeightedColor -> WeightedColor -> Bool)
    -> (WeightedColor -> WeightedColor -> Bool)
    -> (WeightedColor -> WeightedColor -> WeightedColor)
    -> (WeightedColor -> WeightedColor -> WeightedColor)
    -> Ord WeightedColor
    WeightedColor -> WeightedColor -> Bool
    WeightedColor -> WeightedColor -> Ordering
    WeightedColor -> WeightedColor -> WeightedColor
    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
    $ccompare :: WeightedColor -> WeightedColor -> Ordering
    compare :: WeightedColor -> WeightedColor -> Ordering
    $c< :: WeightedColor -> WeightedColor -> Bool
    < :: WeightedColor -> WeightedColor -> Bool
    $c<= :: WeightedColor -> WeightedColor -> Bool
    <= :: WeightedColor -> WeightedColor -> Bool
    $c> :: WeightedColor -> WeightedColor -> Bool
    > :: WeightedColor -> WeightedColor -> Bool
    $c>= :: WeightedColor -> WeightedColor -> Bool
    >= :: WeightedColor -> WeightedColor -> Bool
    $cmax :: WeightedColor -> WeightedColor -> WeightedColor
    max :: WeightedColor -> WeightedColor -> WeightedColor
    $cmin :: WeightedColor -> WeightedColor -> WeightedColor
    min :: WeightedColor -> WeightedColor -> WeightedColor
    Ord, Int -> WeightedColor -> ShowS
    [WeightedColor] -> ShowS
    WeightedColor -> String
    (Int -> WeightedColor -> ShowS)
    -> (WeightedColor -> String)
    -> ([WeightedColor] -> ShowS)
    -> Show WeightedColor
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> WeightedColor -> ShowS
    showsPrec :: Int -> WeightedColor -> ShowS
    $cshow :: WeightedColor -> String
    show :: WeightedColor -> String
    $cshowList :: [WeightedColor] -> ShowS
    showList :: [WeightedColor] -> ShowS
    Show, ReadPrec [WeightedColor]
    ReadPrec WeightedColor
    Int -> ReadS WeightedColor
    ReadS [WeightedColor]
    (Int -> ReadS WeightedColor)
    -> ReadS [WeightedColor]
    -> ReadPrec WeightedColor
    -> ReadPrec [WeightedColor]
    -> Read WeightedColor
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS WeightedColor
    readsPrec :: Int -> ReadS WeightedColor
    $creadList :: ReadS [WeightedColor]
    readList :: ReadS [WeightedColor]
    $creadPrec :: ReadPrec WeightedColor
    readPrec :: ReadPrec WeightedColor
    $creadListPrec :: ReadPrec [WeightedColor]
    readListPrec :: ReadPrec [WeightedColor]
    Read)

    -- | For colors without weightings.
    toWC :: Color -> WeightedColor
    toWC :: Color -> WeightedColor
    toWC = (Color -> Maybe Double -> WeightedColor
    `WC` Maybe Double
    forall a. Maybe a
    Nothing)

    -- | For a list of colors without weightings.
    toColorList :: [Color] -> ColorList
    toColorList :: [Color] -> [WeightedColor]
    toColorList = (Color -> WeightedColor) -> [Color] -> [WeightedColor]
    forall a b. (a -> b) -> [a] -> [b]
    map Color -> WeightedColor
    toWC

    instance PrintDot WeightedColor where
      unqtDot :: WeightedColor -> DotCode
    unqtDot (WC Color
    c Maybe Double
    mw) = Color -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot Color
    c
                          DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> DotCode -> (Double -> DotCode) -> Maybe Double -> DotCode
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DotCode
    forall (m :: * -> *). Applicative m => m Doc
    empty ((DotCode
    forall (m :: * -> *). Applicative m => m Doc
    semiDotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <>) (DotCode -> DotCode) -> (Double -> DotCode) -> Double -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot) Maybe Double
    mw

      toDot :: WeightedColor -> DotCode
    toDot (WC Color
    c Maybe Double
    Nothing) = Color -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot Color
    c
      toDot WeightedColor
    wc             = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ WeightedColor -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot WeightedColor
    wc

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

      -- Might not need quoting
      listToDot :: [WeightedColor] -> DotCode
    listToDot [WeightedColor
    wc] = WeightedColor -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot WeightedColor
    wc
      listToDot [WeightedColor]
    wcs  = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ [WeightedColor] -> DotCode
    forall a. PrintDot a => [a] -> DotCode
    unqtListToDot [WeightedColor]
    wcs

    instance ParseDot WeightedColor where
      parseUnqt :: Parse WeightedColor
    parseUnqt = Color -> Maybe Double -> WeightedColor
    WC (Color -> Maybe Double -> WeightedColor)
    -> Parse Color
    -> Parser GraphvizState (Maybe Double -> WeightedColor)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parse Color
    forall a. ParseDot a => Parse a
    parseUnqt Parser GraphvizState (Maybe Double -> WeightedColor)
    -> Parser GraphvizState (Maybe Double) -> Parse WeightedColor
    forall a b.
    Parser GraphvizState (a -> b)
    -> Parser GraphvizState a -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser GraphvizState Double -> Parser GraphvizState (Maybe Double)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Char -> Parse Char
    character Char
    ';' Parse Char
    -> Parser GraphvizState Double -> Parser GraphvizState Double
    forall a b.
    Parser GraphvizState a
    -> Parser GraphvizState b -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser GraphvizState Double
    forall a. ParseDot a => Parse a
    parseUnqt)

      parse :: Parse WeightedColor
    parse = Parse WeightedColor -> Parse WeightedColor
    forall a. Parse a -> Parse a
    quotedParse Parse WeightedColor
    forall a. ParseDot a => Parse a
    parseUnqt
              Parse WeightedColor -> Parse WeightedColor -> Parse WeightedColor
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
              -- Using parse rather than parseUnqt as there shouldn't be
              -- any quotes, but to avoid copy-pasting the oneOf block.
              (Color -> WeightedColor
    toWC (Color -> WeightedColor) -> Parse Color -> Parse WeightedColor
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parse Color
    forall a. ParseDot a => Parse a
    parse)

      parseUnqtList :: Parse [WeightedColor]
    parseUnqtList = Parse WeightedColor -> Parse Char -> Parse [WeightedColor]
    forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
    sepBy1 Parse WeightedColor
    forall a. ParseDot a => Parse a
    parseUnqt (Char -> Parse Char
    character Char
    ':')
                      Parse [WeightedColor]
    -> Parse [WeightedColor] -> Parse [WeightedColor]
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                      do cs <- Parser GraphvizState ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
                         failBad $ "Error parsing a ColorList with color scheme of "
                                   ++ show cs

      parseList :: Parse [WeightedColor]
    parseList = Parse [WeightedColor] -> Parse [WeightedColor]
    forall a. Parse a -> Parse a
    quotedParse Parse [WeightedColor]
    forall a. ParseDot a => Parse [a]
    parseUnqtList
                  Parse [WeightedColor]
    -> Parse [WeightedColor] -> Parse [WeightedColor]
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                  ((WeightedColor -> [WeightedColor] -> [WeightedColor]
    forall a. a -> [a] -> [a]
    :[]) (WeightedColor -> [WeightedColor])
    -> (Color -> WeightedColor) -> Color -> [WeightedColor]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> WeightedColor
    toWC (Color -> [WeightedColor]) -> Parse Color -> Parse [WeightedColor]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parse Color
    forall a. ParseDot a => Parse a
    parse)
                  -- Potentially unquoted un-weighted single color
                  Parse [WeightedColor]
    -> Parse [WeightedColor] -> Parse [WeightedColor]
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                  do cs <- Parser GraphvizState ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
                     failBad $ "Error parsing ColorList with color scheme of "
                               ++ show cs

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

    -- | More easily convert named colors to an overall 'Color' value.
    class NamedColor nc where
        colorScheme :: nc -> ColorScheme

        toColor :: nc -> Color

        printNC :: Bool -> nc -> DotCode

        -- | Bool is for whether quoting is needed.
        parseNC' :: Bool -> Parse nc

    toWColor :: (NamedColor nc) => nc -> WeightedColor
    toWColor :: forall nc. NamedColor nc => nc -> WeightedColor
    toWColor = Color -> WeightedColor
    toWC (Color -> WeightedColor) -> (nc -> Color) -> nc -> WeightedColor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . nc -> Color
    forall nc. NamedColor nc => nc -> Color
    toColor

    -- First value just used for type
    parseNC :: (NamedColor nc) => nc -> Bool -> Parse Color
    parseNC :: forall nc. NamedColor nc => nc -> Bool -> Parse Color
    parseNC nc
    nc Bool
    q = (nc -> Color) -> Parser GraphvizState nc -> Parse Color
    forall a b.
    (a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (nc -> Color
    forall nc. NamedColor nc => nc -> Color
    toColor (nc -> Color) -> (nc -> nc) -> nc -> Color
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (nc -> nc -> nc
    forall a. a -> a -> a
    `asTypeOf` nc
    nc))
                   (Parser GraphvizState nc -> Parse Color)
    -> Parser GraphvizState nc -> Parse Color
    forall a b. (a -> b) -> a -> b
    $ Bool -> Parser GraphvizState nc
    forall nc. NamedColor nc => Bool -> Parse nc
    parseNC' Bool
    q

    instance NamedColor BrewerColor where
        colorScheme :: BrewerColor -> ColorScheme
    colorScheme (BC BrewerScheme
    bs Word8
    _) = BrewerScheme -> ColorScheme
    Brewer BrewerScheme
    bs

        toColor :: BrewerColor -> Color
    toColor = BrewerColor -> Color
    BrewerColor

        printNC :: Bool -> BrewerColor -> DotCode
    printNC = (BrewerColor -> Word8) -> Bool -> BrewerColor -> DotCode
    forall nc lv.
    (NamedColor nc, PrintDot lv) =>
    (nc -> lv) -> Bool -> nc -> DotCode
    printNamedColor (\ (BC BrewerScheme
    _ Word8
    l) -> Word8
    l)

        parseNC' :: Bool -> Parse BrewerColor
    parseNC' = (ColorScheme -> Maybe BrewerScheme)
    -> Parse BrewerScheme
    -> (BrewerScheme -> Bool)
    -> (BrewerScheme -> Word8 -> BrewerColor)
    -> Bool
    -> Parse BrewerColor
    forall lv cs nc.
    ParseDot lv =>
    (ColorScheme -> Maybe cs)
    -> Parse cs -> (cs -> Bool) -> (cs -> lv -> nc) -> Bool -> Parse nc
    parseNamedColor ColorScheme -> Maybe BrewerScheme
    mBCS Parse BrewerScheme
    forall a. ParseDot a => Parse a
    parseUnqt (Bool -> BrewerScheme -> Bool
    forall a b. a -> b -> a
    const Bool
    True) BrewerScheme -> Word8 -> BrewerColor
    BC
            where
              mBCS :: ColorScheme -> Maybe BrewerScheme
    mBCS (Brewer BrewerScheme
    bs) = BrewerScheme -> Maybe BrewerScheme
    forall a. a -> Maybe a
    Just BrewerScheme
    bs
              mBCS ColorScheme
    _           = Maybe BrewerScheme
    forall a. Maybe a
    Nothing

    instance NamedColor X11Color where
        colorScheme :: X11Color -> ColorScheme
    colorScheme = ColorScheme -> X11Color -> ColorScheme
    forall a b. a -> b -> a
    const ColorScheme
    X11

        toColor :: X11Color -> Color
    toColor = X11Color -> Color
    X11Color

        printNC :: Bool -> X11Color -> DotCode
    printNC = (X11Color -> X11Color) -> Bool -> X11Color -> DotCode
    forall nc lv.
    (NamedColor nc, PrintDot lv) =>
    (nc -> lv) -> Bool -> nc -> DotCode
    printNamedColor X11Color -> X11Color
    forall a. a -> a
    id

        parseNC' :: Bool -> Parse X11Color
    parseNC' = (ColorScheme -> Maybe ColorScheme)
    -> Parser GraphvizState ColorScheme
    -> (ColorScheme -> Bool)
    -> (ColorScheme -> X11Color -> X11Color)
    -> Bool
    -> Parse X11Color
    forall lv cs nc.
    ParseDot lv =>
    (ColorScheme -> Maybe cs)
    -> Parse cs -> (cs -> Bool) -> (cs -> lv -> nc) -> Bool -> Parse nc
    parseNamedColor ColorScheme -> Maybe ColorScheme
    mX11 (Bool -> Parser GraphvizState ColorScheme
    parseColorScheme Bool
    False) (Maybe ColorScheme -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ColorScheme -> Bool)
    -> (ColorScheme -> Maybe ColorScheme) -> ColorScheme -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ColorScheme -> Maybe ColorScheme
    mX11) ((X11Color -> X11Color) -> ColorScheme -> X11Color -> X11Color
    forall a b. a -> b -> a
    const X11Color -> X11Color
    forall a. a -> a
    id)
            where
              mX11 :: ColorScheme -> Maybe ColorScheme
    mX11 ColorScheme
    X11 = ColorScheme -> Maybe ColorScheme
    forall a. a -> Maybe a
    Just ColorScheme
    X11
              mX11 ColorScheme
    _   = Maybe ColorScheme
    forall a. Maybe a
    Nothing

    instance NamedColor SVGColor where
        colorScheme :: SVGColor -> ColorScheme
    colorScheme = ColorScheme -> SVGColor -> ColorScheme
    forall a b. a -> b -> a
    const ColorScheme
    SVG

        toColor :: SVGColor -> Color
    toColor = SVGColor -> Color
    SVGColor

        printNC :: Bool -> SVGColor -> DotCode
    printNC = (SVGColor -> SVGColor) -> Bool -> SVGColor -> DotCode
    forall nc lv.
    (NamedColor nc, PrintDot lv) =>
    (nc -> lv) -> Bool -> nc -> DotCode
    printNamedColor SVGColor -> SVGColor
    forall a. a -> a
    id

        parseNC' :: Bool -> Parse SVGColor
    parseNC' = (ColorScheme -> Maybe ColorScheme)
    -> Parser GraphvizState ColorScheme
    -> (ColorScheme -> Bool)
    -> (ColorScheme -> SVGColor -> SVGColor)
    -> Bool
    -> Parse SVGColor
    forall lv cs nc.
    ParseDot lv =>
    (ColorScheme -> Maybe cs)
    -> Parse cs -> (cs -> Bool) -> (cs -> lv -> nc) -> Bool -> Parse nc
    parseNamedColor ColorScheme -> Maybe ColorScheme
    mSVG (Bool -> Parser GraphvizState ColorScheme
    parseColorScheme Bool
    False) (Maybe ColorScheme -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ColorScheme -> Bool)
    -> (ColorScheme -> Maybe ColorScheme) -> ColorScheme -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ColorScheme -> Maybe ColorScheme
    mSVG) ((SVGColor -> SVGColor) -> ColorScheme -> SVGColor -> SVGColor
    forall a b. a -> b -> a
    const SVGColor -> SVGColor
    forall a. a -> a
    id)
            where
              mSVG :: ColorScheme -> Maybe ColorScheme
    mSVG ColorScheme
    SVG = ColorScheme -> Maybe ColorScheme
    forall a. a -> Maybe a
    Just ColorScheme
    SVG
              mSVG ColorScheme
    _   = Maybe ColorScheme
    forall a. Maybe a
    Nothing

    printNamedColor :: (NamedColor nc, PrintDot lv) => (nc -> lv)
                       -> Bool -> nc -> DotCode
    printNamedColor :: forall nc lv.
    (NamedColor nc, PrintDot lv) =>
    (nc -> lv) -> Bool -> nc -> DotCode
    printNamedColor nc -> lv
    fl Bool
    q nc
    c = do currentCS <- DotCodeM ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
                                if cs == currentCS
                                   then (bool unqtDot toDot q) lv
                                   else bool id dquotes q
                                        $ fslash <> printColorScheme False cs
                                          <> fslash <> unqtDot lv
        where
          cs :: ColorScheme
    cs = nc -> ColorScheme
    forall nc. NamedColor nc => nc -> ColorScheme
    colorScheme nc
    c
          lv :: lv
    lv = nc -> lv
    fl nc
    c

    parseNamedColor :: (ParseDot lv)
                       => (ColorScheme -> Maybe cs) -> Parse cs -> (cs -> Bool)
                       -> (cs -> lv -> nc) -> Bool -> Parse nc
    parseNamedColor :: forall lv cs nc.
    ParseDot lv =>
    (ColorScheme -> Maybe cs)
    -> Parse cs -> (cs -> Bool) -> (cs -> lv -> nc) -> Bool -> Parse nc
    parseNamedColor ColorScheme -> Maybe cs
    gcs Parse cs
    parseCS cs -> Bool
    vcs cs -> lv -> nc
    mkC Bool
    q
        = do Just cs <- ColorScheme -> Maybe cs
    gcs (ColorScheme -> Maybe cs)
    -> Parser GraphvizState ColorScheme
    -> Parser GraphvizState (Maybe cs)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser GraphvizState ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
             lv <- bool parseUnqt parse q
                   `onFail`
                   mQts (string "//" *> parseUnqt)
             return $ mkC cs lv
          Parser GraphvizState nc
    -> Parser GraphvizState nc -> Parser GraphvizState nc
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
          Parser GraphvizState nc -> Parser GraphvizState nc
    forall a. Parse a -> Parse a
    mQts ( do Char -> Parse Char
    character Char
    '/'
                    cs <- Parse cs
    parseCS
                    character '/'
                    if vcs cs
                       then mkC cs <$>  parseUnqt
                       else fail "Explicit colorscheme not as expected."
               )
        where
          mQts :: Parse a -> Parse a
    mQts = (Parse a -> Parse a)
    -> (Parse a -> Parse a) -> Bool -> Parse a -> Parse a
    forall a. a -> a -> Bool -> a
    bool Parse a -> Parse a
    forall a. a -> a
    id Parse a -> Parse a
    forall a. Parse a -> Parse a
    quotedParse Bool
    q

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

    -- X11 has a special case when parsing: '/yyyy'

    parseX11Color   :: Bool -> Parse Color
    parseX11Color :: Bool -> Parse Color
    parseX11Color Bool
    q = X11Color -> Color
    X11Color
                      (X11Color -> Color) -> Parse X11Color -> Parse Color
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Parse X11Color
    forall nc. NamedColor nc => Bool -> Parse nc
    parseNC' Bool
    q
                          Parse X11Color -> Parse X11Color -> Parse X11Color
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                          (Parse X11Color -> Parse X11Color)
    -> (Parse X11Color -> Parse X11Color)
    -> Bool
    -> Parse X11Color
    -> Parse X11Color
    forall a. a -> a -> Bool -> a
    bool Parse X11Color -> Parse X11Color
    forall a. a -> a
    id Parse X11Color -> Parse X11Color
    forall a. Parse a -> Parse a
    quotedParse Bool
    q (Char -> Parse Char
    character Char
    '/' Parse Char -> Parse X11Color -> Parse X11Color
    forall a b.
    Parser GraphvizState a
    -> Parser GraphvizState b -> Parser GraphvizState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parse X11Color
    forall a. ParseDot a => Parse a
    parseUnqt)
                          Parse X11Color -> Parse X11Color -> Parse X11Color
    forall s a. Parser s a -> Parser s a -> Parser s a
    `onFail`
                          -- Can use X11 colors within brewer colorscheme.
                          do cs <- Parser GraphvizState ColorScheme
    forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme
                             case cs of
                               Brewer{} -> Parse X11Color -> Parse X11Color -> Bool -> Parse X11Color
    forall a. a -> a -> Bool -> a
    bool Parse X11Color
    forall a. ParseDot a => Parse a
    parseUnqt Parse X11Color
    forall a. ParseDot a => Parse a
    parse Bool
    q
                               ColorScheme
    _        -> String -> Parse X11Color
    forall a. String -> Parser GraphvizState a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unable to parse an X11 color within Brewer"

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

    -- | Attempt to convert a 'Color' into a 'Colour' value with an alpha
    --   channel.  The use of 'Maybe' is because the RGB values of the
    --   'BrewerColor's haven't been stored here (primarily for licensing
    --   reasons).
    toColour                :: Color -> Maybe (AlphaColour Double)
    toColour :: Color -> Maybe (AlphaColour Double)
    toColour (RGB Word8
    r Word8
    g Word8
    b)    = AlphaColour Double -> Maybe (AlphaColour Double)
    forall a. a -> Maybe a
    Just (AlphaColour Double -> Maybe (AlphaColour Double))
    -> (Colour Double -> AlphaColour Double)
    -> Colour Double
    -> Maybe (AlphaColour Double)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque (Colour Double -> Maybe (AlphaColour Double))
    -> Colour Double -> Maybe (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Word8 -> Word8 -> Colour Double
    forall b.
    (Ord b, Floating b) =>
    Word8 -> Word8 -> Word8 -> Colour b
    sRGB24 Word8
    r Word8
    g Word8
    b
    toColour (RGBA Word8
    r Word8
    g Word8
    b Word8
    a) = AlphaColour Double -> Maybe (AlphaColour Double)
    forall a. a -> Maybe a
    Just (AlphaColour Double -> Maybe (AlphaColour Double))
    -> (Double -> AlphaColour Double)
    -> Double
    -> Maybe (AlphaColour Double)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Colour Double -> Double -> AlphaColour Double
    forall a. Num a => Colour a -> a -> AlphaColour a
    withOpacity (Word8 -> Word8 -> Word8 -> Colour Double
    forall b.
    (Ord b, Floating b) =>
    Word8 -> Word8 -> Word8 -> Colour b
    sRGB24 Word8
    r Word8
    g Word8
    b) (Double -> Maybe (AlphaColour Double))
    -> Double -> Maybe (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Double
    toOpacity Word8
    a
    -- Colour expects the hue to be an angle, so multiply by 360
    toColour (HSV Double
    h Double
    s Double
    v)    = AlphaColour Double -> Maybe (AlphaColour Double)
    forall a. a -> Maybe a
    Just (AlphaColour Double -> Maybe (AlphaColour Double))
    -> (RGB Double -> AlphaColour Double)
    -> RGB Double
    -> Maybe (AlphaColour Double)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque (Colour Double -> AlphaColour Double)
    -> (RGB Double -> Colour Double)
    -> RGB Double
    -> AlphaColour Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Double -> Double -> Double -> Colour Double)
    -> RGB Double -> Colour Double
    forall a b. (a -> a -> a -> b) -> RGB a -> b
    uncurryRGB Double -> Double -> Double -> Colour Double
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB (RGB Double -> Maybe (AlphaColour Double))
    -> RGB Double -> Maybe (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Double -> RGB Double
    forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
    hsv (Double
    hDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    360) Double
    s Double
    v
    toColour (X11Color X11Color
    c)   = AlphaColour Double -> Maybe (AlphaColour Double)
    forall a. a -> Maybe a
    Just (AlphaColour Double -> Maybe (AlphaColour Double))
    -> AlphaColour Double -> Maybe (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ X11Color -> AlphaColour Double
    x11Colour X11Color
    c
    toColour (SVGColor SVGColor
    c)   = AlphaColour Double -> Maybe (AlphaColour Double)
    forall a. a -> Maybe a
    Just (AlphaColour Double -> Maybe (AlphaColour Double))
    -> (Colour Double -> AlphaColour Double)
    -> Colour Double
    -> Maybe (AlphaColour Double)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque (Colour Double -> Maybe (AlphaColour Double))
    -> Colour Double -> Maybe (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ SVGColor -> Colour Double
    svgColour SVGColor
    c
    toColour BrewerColor{}  = Maybe (AlphaColour Double)
    forall a. Maybe a
    Nothing

    toOpacity   :: Word8 -> Double
    toOpacity :: Word8 -> Double
    toOpacity Word8
    a = Word8 -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    a Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    maxWord

    -- | Convert a 'Colour' value to an 'RGB' 'Color'.
    fromColour :: Colour Double -> Color
    fromColour :: Colour Double -> Color
    fromColour = (Word8 -> Word8 -> Word8 -> Color) -> RGB Word8 -> Color
    forall a b. (a -> a -> a -> b) -> RGB a -> b
    uncurryRGB Word8 -> Word8 -> Word8 -> Color
    RGB (RGB Word8 -> Color)
    -> (Colour Double -> RGB Word8) -> Colour Double -> Color
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Colour Double -> RGB Word8
    forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
    toSRGB24

    -- | Convert an 'AlphaColour' to an 'RGBA' 'Color'.  The exception to
    --   this is for any 'AlphaColour' which has @alphaChannel ac == 0@;
    --   these are converted to @X11Color 'Transparent'@ (note that the
    --   'Show' instance for such an 'AlphaColour' is @\"transparent\"@).
    fromAColour :: AlphaColour Double -> Color
    fromAColour :: AlphaColour Double -> Color
    fromAColour AlphaColour Double
    ac
      | Double
    a Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    == Double
    0    = X11Color -> Color
    X11Color X11Color
    Transparent
      | Bool
    otherwise = Word8 -> Color
    rgb (Word8 -> Color) -> Word8 -> Color
    forall a b. (a -> b) -> a -> b
    $ Double -> Word8
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    a'
      where
        a :: Double
    a = AlphaColour Double -> Double
    forall a. AlphaColour a -> a
    alphaChannel AlphaColour Double
    ac
        a' :: Double
    a' = Double
    a Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    maxWord
        rgb :: Word8 -> Color
    rgb = (Word8 -> Word8 -> Word8 -> Word8 -> Color)
    -> RGB Word8 -> Word8 -> Color
    forall a b. (a -> a -> a -> b) -> RGB a -> b
    uncurryRGB Word8 -> Word8 -> Word8 -> Word8 -> Color
    RGBA (RGB Word8 -> Word8 -> Color) -> RGB Word8 -> Word8 -> Color
    forall a b. (a -> b) -> a -> b
    $ Colour Double -> RGB Word8
    forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
    toSRGB24 Colour Double
    colour
        colour :: Colour Double
    colour = Double -> Colour Double -> Colour Double
    forall a. Num a => a -> Colour a -> Colour a
    forall (f :: * -> *) a. (ColourOps f, Num a) => a -> f a -> f a
    darken (Double -> Double
    forall a. Fractional a => a -> a
    recip Double
    a) (AlphaColour Double
    ac AlphaColour Double -> Colour Double -> Colour Double
    forall a. Num a => AlphaColour a -> Colour a -> Colour a
    forall (f :: * -> *) a.
    (ColourOps f, Num a) =>
    AlphaColour a -> f a -> f a
    `over` Colour Double
    forall a. Num a => Colour a
    black)

    -- | The 'maxBound' of a 'Word8' value.
    maxWord :: Double
    maxWord :: Double
    maxWord = Word8 -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    forall a. Bounded a => a
    maxBound :: Word8)