{-# OPTIONS_HADDOCK hide #-}

{- |
   Module      : Data.GraphViz.Attributes.ColorScheme
   Description : Specification of color schemes.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This is an internal module designed so that the state can record
   the current color scheme.
-}
module Data.GraphViz.Attributes.ColorScheme where

import Data.Word(Word8)

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

-- | This represents the color schemes that Graphviz accepts.
data ColorScheme = X11
                 | SVG
                 | Brewer BrewerScheme
                 deriving (ColorScheme -> ColorScheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorScheme -> ColorScheme -> Bool
$c/= :: ColorScheme -> ColorScheme -> Bool
== :: ColorScheme -> ColorScheme -> Bool
$c== :: ColorScheme -> ColorScheme -> Bool
Eq, Eq ColorScheme
ColorScheme -> ColorScheme -> Bool
ColorScheme -> ColorScheme -> Ordering
ColorScheme -> ColorScheme -> ColorScheme
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 :: ColorScheme -> ColorScheme -> ColorScheme
$cmin :: ColorScheme -> ColorScheme -> ColorScheme
max :: ColorScheme -> ColorScheme -> ColorScheme
$cmax :: ColorScheme -> ColorScheme -> ColorScheme
>= :: ColorScheme -> ColorScheme -> Bool
$c>= :: ColorScheme -> ColorScheme -> Bool
> :: ColorScheme -> ColorScheme -> Bool
$c> :: ColorScheme -> ColorScheme -> Bool
<= :: ColorScheme -> ColorScheme -> Bool
$c<= :: ColorScheme -> ColorScheme -> Bool
< :: ColorScheme -> ColorScheme -> Bool
$c< :: ColorScheme -> ColorScheme -> Bool
compare :: ColorScheme -> ColorScheme -> Ordering
$ccompare :: ColorScheme -> ColorScheme -> Ordering
Ord, Int -> ColorScheme -> ShowS
[ColorScheme] -> ShowS
ColorScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorScheme] -> ShowS
$cshowList :: [ColorScheme] -> ShowS
show :: ColorScheme -> String
$cshow :: ColorScheme -> String
showsPrec :: Int -> ColorScheme -> ShowS
$cshowsPrec :: Int -> ColorScheme -> ShowS
Show, ReadPrec [ColorScheme]
ReadPrec ColorScheme
Int -> ReadS ColorScheme
ReadS [ColorScheme]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColorScheme]
$creadListPrec :: ReadPrec [ColorScheme]
readPrec :: ReadPrec ColorScheme
$creadPrec :: ReadPrec ColorScheme
readList :: ReadS [ColorScheme]
$creadList :: ReadS [ColorScheme]
readsPrec :: Int -> ReadS ColorScheme
$creadsPrec :: Int -> ReadS ColorScheme
Read)

-- | Specify which colour palette and how many colours it has.  Note
--   the allowed values for the different 'BrewerName's.
data BrewerScheme = BScheme BrewerName Word8
                  deriving (BrewerScheme -> BrewerScheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrewerScheme -> BrewerScheme -> Bool
$c/= :: BrewerScheme -> BrewerScheme -> Bool
== :: BrewerScheme -> BrewerScheme -> Bool
$c== :: BrewerScheme -> BrewerScheme -> Bool
Eq, Eq BrewerScheme
BrewerScheme -> BrewerScheme -> Bool
BrewerScheme -> BrewerScheme -> Ordering
BrewerScheme -> BrewerScheme -> BrewerScheme
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 :: BrewerScheme -> BrewerScheme -> BrewerScheme
$cmin :: BrewerScheme -> BrewerScheme -> BrewerScheme
max :: BrewerScheme -> BrewerScheme -> BrewerScheme
$cmax :: BrewerScheme -> BrewerScheme -> BrewerScheme
>= :: BrewerScheme -> BrewerScheme -> Bool
$c>= :: BrewerScheme -> BrewerScheme -> Bool
> :: BrewerScheme -> BrewerScheme -> Bool
$c> :: BrewerScheme -> BrewerScheme -> Bool
<= :: BrewerScheme -> BrewerScheme -> Bool
$c<= :: BrewerScheme -> BrewerScheme -> Bool
< :: BrewerScheme -> BrewerScheme -> Bool
$c< :: BrewerScheme -> BrewerScheme -> Bool
compare :: BrewerScheme -> BrewerScheme -> Ordering
$ccompare :: BrewerScheme -> BrewerScheme -> Ordering
Ord, Int -> BrewerScheme -> ShowS
[BrewerScheme] -> ShowS
BrewerScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrewerScheme] -> ShowS
$cshowList :: [BrewerScheme] -> ShowS
show :: BrewerScheme -> String
$cshow :: BrewerScheme -> String
showsPrec :: Int -> BrewerScheme -> ShowS
$cshowsPrec :: Int -> BrewerScheme -> ShowS
Show, ReadPrec [BrewerScheme]
ReadPrec BrewerScheme
Int -> ReadS BrewerScheme
ReadS [BrewerScheme]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrewerScheme]
$creadListPrec :: ReadPrec [BrewerScheme]
readPrec :: ReadPrec BrewerScheme
$creadPrec :: ReadPrec BrewerScheme
readList :: ReadS [BrewerScheme]
$creadList :: ReadS [BrewerScheme]
readsPrec :: Int -> ReadS BrewerScheme
$creadsPrec :: Int -> ReadS BrewerScheme
Read)

-- | All of these have a minimum level value of @3@, with a maximum
--   of @9@ unless otherwise specified.
data BrewerName = Accent   -- ^ Maximum of @8@.
                | Blues
                | Brbg     -- ^ Maximum of @11@.
                | Bugn
                | Bupu
                | Dark2    -- ^ Maximum of @8@.
                | Gnbu
                | Greens
                | Greys
                | Oranges
                | Orrd
                | Paired   -- ^ Maximum of @12@.
                | Pastel1
                | Pastel2  -- ^ Maximum of @8@.
                | Piyg     -- ^ Maximum of @11@.
                | Prgn     -- ^ Maximum of @11@.
                | Pubu
                | Pubugn
                | Puor     -- ^ Maximum of @11@; note that the last two are listed
                           --   after the @'Purd'@ values in the
                           --   documentation.
                | Purd
                | Purples
                | Rdbu     -- ^ Maximum of @11@; note that the last two are listed
                           --   first.
                | Rdgy     -- ^ Maximum of @11@; note that the last two are listed
                           --   after the @'Rdpu'@ values in the
                           --   documentation.
                | Rdpu
                | Rdylbu   -- ^ Maximum of @11@.
                | Rdylgn   -- ^ Maximum of @11@.
                | Reds
                | Set1
                | Set2     -- ^ Maximum of @8@.
                | Set3     -- ^ Maximum of @12@.
                | Spectral -- ^ Maximum of @11@.
                | Ylgn
                | Ylgnbu
                | Ylorbr
                | Ylorrd
                deriving (BrewerName -> BrewerName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrewerName -> BrewerName -> Bool
$c/= :: BrewerName -> BrewerName -> Bool
== :: BrewerName -> BrewerName -> Bool
$c== :: BrewerName -> BrewerName -> Bool
Eq, Eq BrewerName
BrewerName -> BrewerName -> Bool
BrewerName -> BrewerName -> Ordering
BrewerName -> BrewerName -> BrewerName
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 :: BrewerName -> BrewerName -> BrewerName
$cmin :: BrewerName -> BrewerName -> BrewerName
max :: BrewerName -> BrewerName -> BrewerName
$cmax :: BrewerName -> BrewerName -> BrewerName
>= :: BrewerName -> BrewerName -> Bool
$c>= :: BrewerName -> BrewerName -> Bool
> :: BrewerName -> BrewerName -> Bool
$c> :: BrewerName -> BrewerName -> Bool
<= :: BrewerName -> BrewerName -> Bool
$c<= :: BrewerName -> BrewerName -> Bool
< :: BrewerName -> BrewerName -> Bool
$c< :: BrewerName -> BrewerName -> Bool
compare :: BrewerName -> BrewerName -> Ordering
$ccompare :: BrewerName -> BrewerName -> Ordering
Ord, BrewerName
forall a. a -> a -> Bounded a
maxBound :: BrewerName
$cmaxBound :: BrewerName
minBound :: BrewerName
$cminBound :: BrewerName
Bounded, Int -> BrewerName
BrewerName -> Int
BrewerName -> [BrewerName]
BrewerName -> BrewerName
BrewerName -> BrewerName -> [BrewerName]
BrewerName -> BrewerName -> BrewerName -> [BrewerName]
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 :: BrewerName -> BrewerName -> BrewerName -> [BrewerName]
$cenumFromThenTo :: BrewerName -> BrewerName -> BrewerName -> [BrewerName]
enumFromTo :: BrewerName -> BrewerName -> [BrewerName]
$cenumFromTo :: BrewerName -> BrewerName -> [BrewerName]
enumFromThen :: BrewerName -> BrewerName -> [BrewerName]
$cenumFromThen :: BrewerName -> BrewerName -> [BrewerName]
enumFrom :: BrewerName -> [BrewerName]
$cenumFrom :: BrewerName -> [BrewerName]
fromEnum :: BrewerName -> Int
$cfromEnum :: BrewerName -> Int
toEnum :: Int -> BrewerName
$ctoEnum :: Int -> BrewerName
pred :: BrewerName -> BrewerName
$cpred :: BrewerName -> BrewerName
succ :: BrewerName -> BrewerName
$csucc :: BrewerName -> BrewerName
Enum, Int -> BrewerName -> ShowS
[BrewerName] -> ShowS
BrewerName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrewerName] -> ShowS
$cshowList :: [BrewerName] -> ShowS
show :: BrewerName -> String
$cshow :: BrewerName -> String
showsPrec :: Int -> BrewerName -> ShowS
$cshowsPrec :: Int -> BrewerName -> ShowS
Show, ReadPrec [BrewerName]
ReadPrec BrewerName
Int -> ReadS BrewerName
ReadS [BrewerName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrewerName]
$creadListPrec :: ReadPrec [BrewerName]
readPrec :: ReadPrec BrewerName
$creadPrec :: ReadPrec BrewerName
readList :: ReadS [BrewerName]
$creadList :: ReadS [BrewerName]
readsPrec :: Int -> ReadS BrewerName
$creadsPrec :: Int -> ReadS BrewerName
Read)