{-# LANGUAGE OverloadedStrings, PatternSynonyms, ViewPatterns #-}
module Graphics.Rendering.Rect.CSS.Colour(ColourPallet(..), parseColour) where

import Data.Colour (Colour, AlphaColour, withOpacity, opaque, transparent)
import Data.Colour.SRGB (sRGB, sRGB24)
import Data.Colour.Names
import Data.Colour.RGBSpace.HSL (hsl)
import Data.Colour.RGBSpace (uncurryRGB)
import Data.Colour.SRGB.Linear (rgb)

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Scientific (toRealFloat)
import qualified Data.Text as Txt

import Data.Word (Word8)
import Data.Char (isHexDigit, toLower)
import Data.List (elemIndex)
import Debug.Trace (trace) -- For warning messages.

import Stylist (PropertyParser(..))

hsl' :: RealFrac a => a -> a -> a -> Colour a
hsl' :: a -> a -> a -> Colour a
hsl' hue :: a
hue s :: a
s l :: a
l = (a -> a -> a -> Colour a) -> RGB a -> Colour a
forall a b. (a -> a -> a -> b) -> RGB a -> b
uncurryRGB a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
rgb (RGB a -> Colour a) -> RGB a -> Colour a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> RGB a
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsl a
hue a
s a
l

data ColourPallet = ColourPallet {
    ColourPallet -> AlphaColour Float
foreground :: AlphaColour Float,
    ColourPallet -> AlphaColour Float
accent :: AlphaColour Float
} deriving (ReadPrec [ColourPallet]
ReadPrec ColourPallet
Int -> ReadS ColourPallet
ReadS [ColourPallet]
(Int -> ReadS ColourPallet)
-> ReadS [ColourPallet]
-> ReadPrec ColourPallet
-> ReadPrec [ColourPallet]
-> Read ColourPallet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColourPallet]
$creadListPrec :: ReadPrec [ColourPallet]
readPrec :: ReadPrec ColourPallet
$creadPrec :: ReadPrec ColourPallet
readList :: ReadS [ColourPallet]
$creadList :: ReadS [ColourPallet]
readsPrec :: Int -> ReadS ColourPallet
$creadsPrec :: Int -> ReadS ColourPallet
Read, Int -> ColourPallet -> ShowS
[ColourPallet] -> ShowS
ColourPallet -> String
(Int -> ColourPallet -> ShowS)
-> (ColourPallet -> String)
-> ([ColourPallet] -> ShowS)
-> Show ColourPallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColourPallet] -> ShowS
$cshowList :: [ColourPallet] -> ShowS
show :: ColourPallet -> String
$cshow :: ColourPallet -> String
showsPrec :: Int -> ColourPallet -> ShowS
$cshowsPrec :: Int -> ColourPallet -> ShowS
Show, ColourPallet -> ColourPallet -> Bool
(ColourPallet -> ColourPallet -> Bool)
-> (ColourPallet -> ColourPallet -> Bool) -> Eq ColourPallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColourPallet -> ColourPallet -> Bool
$c/= :: ColourPallet -> ColourPallet -> Bool
== :: ColourPallet -> ColourPallet -> Bool
$c== :: ColourPallet -> ColourPallet -> Bool
Eq)

instance PropertyParser ColourPallet where
    temp :: ColourPallet
temp = ColourPallet :: AlphaColour Float -> AlphaColour Float -> ColourPallet
ColourPallet { foreground :: AlphaColour Float
foreground = Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Float
forall a. Num a => Colour a
black, accent :: AlphaColour Float
accent = Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Float
forall a. (Ord a, Floating a) => Colour a
blue }
    inherit :: ColourPallet -> ColourPallet
inherit = ColourPallet -> ColourPallet
forall a. a -> a
id
    priority :: ColourPallet -> [Text]
priority _ = ["color", "accent"]

    longhand :: ColourPallet
-> ColourPallet -> Text -> [Token] -> Maybe ColourPallet
longhand _ self :: ColourPallet
self "color" [Ident "initial"]=ColourPallet -> Maybe ColourPallet
forall a. a -> Maybe a
Just ColourPallet
self {foreground :: AlphaColour Float
foreground=Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Float
forall a. Num a => Colour a
black}
    longhand _ self :: ColourPallet
self "color" toks :: [Token]
toks | Just ([], val :: AlphaColour Float
val) <- ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour ColourPallet
self [Token]
toks =
        ColourPallet -> Maybe ColourPallet
forall a. a -> Maybe a
Just ColourPallet
self { foreground :: AlphaColour Float
foreground = AlphaColour Float
val }
    longhand _ self :: ColourPallet
self "accent-color" [Ident kw :: Text
kw]
        | Text
kw Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["initial", "auto"] = ColourPallet -> Maybe ColourPallet
forall a. a -> Maybe a
Just ColourPallet
self {accent :: AlphaColour Float
accent = Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Float
forall a. (Ord a, Floating a) => Colour a
blue}
    longhand _ self :: ColourPallet
self "accent-color" t :: [Token]
t | Just ([], val :: AlphaColour Float
val) <- ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour ColourPallet
self [Token]
t =
        ColourPallet -> Maybe ColourPallet
forall a. a -> Maybe a
Just ColourPallet
self { accent :: AlphaColour Float
accent = AlphaColour Float
val }
    longhand _ _ _ _ = Maybe ColourPallet
forall a. Maybe a
Nothing
    shorthand :: ColourPallet -> Text -> [Token] -> Props
shorthand self :: ColourPallet
self key :: Text
key val :: [Token]
val | Just _ <- ColourPallet
-> ColourPallet -> Text -> [Token] -> Maybe ColourPallet
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand ColourPallet
self ColourPallet
self Text
key [Token]
val = [(Text
key, [Token]
val)]
        | Bool
otherwise = []

parseColour :: ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour :: ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour _ (Function "rgb":Percentage _ r :: NumericValue
r:Comma:
        Percentage _ g :: NumericValue
g:Comma:Percentage _ b :: NumericValue
b:RightParen:toks :: [Token]
toks) =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Colour Float
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (NumericValue -> Float
pc NumericValue
r) (NumericValue -> Float
pc NumericValue
g) (NumericValue -> Float
pc NumericValue
b))
parseColour _ (Function "rgba":Percentage _ r :: NumericValue
r:Comma:
        Percentage _ g :: NumericValue
g:Comma:Percentage _ b :: NumericValue
b:Comma:a' :: Token
a':RightParen:toks :: [Token]
toks)
    | Token
a' Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Token
Ident "none", Just a :: Float
a <- Token -> Maybe Float
f' Token
a' =
        ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Float -> Float -> Float -> Colour Float
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (NumericValue -> Float
pc NumericValue
r) (NumericValue -> Float
pc NumericValue
g) (NumericValue -> Float
pc NumericValue
b) Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Float
a)
parseColour _ (Function "rgb":Number _ (NVInteger r :: Integer
r):Comma:
        Number _ (NVInteger g :: Integer
g):Comma:Number _ (NVInteger b :: Integer
b):RightParen:toks :: [Token]
toks) =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Colour Float
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Integer -> Word8
w Integer
r) (Integer -> Word8
w Integer
g) (Integer -> Word8
w Integer
b))
parseColour _ (Function "rgba":Number _ (NVInteger r :: Integer
r):Comma:
        Number _ (NVInteger g :: Integer
g):Comma:Number _ (NVInteger b :: Integer
b):Comma:
        a' :: Token
a':RightParen:toks :: [Token]
toks) | Token
a' Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Token
Ident "none", Just a :: Float
a <- Token -> Maybe Float
f' Token
a' =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Word8 -> Word8 -> Word8 -> Colour Float
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Integer -> Word8
w Integer
r) (Integer -> Word8
w Integer
g) (Integer -> Word8
w Integer
b) Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Float
a)

parseColour _ (Function "rgb":r' :: Token
r':g' :: Token
g':b' :: Token
b':RightParen:toks :: [Token]
toks)
    | Just r :: Word8
r <- Token -> Maybe Word8
w' Token
r', Just g :: Word8
g <- Token -> Maybe Word8
w' Token
g', Just b :: Word8
b <- Token -> Maybe Word8
w' Token
b' =
        ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Colour Float
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
r Word8
g Word8
b)
parseColour _ (Function "rgb":r' :: Token
r':g' :: Token
g':b' :: Token
b':Delim '/':a' :: Token
a':RightParen:toks :: [Token]
toks)
    | Just r :: Word8
r <- Token -> Maybe Word8
w' Token
r', Just g :: Word8
g <- Token -> Maybe Word8
w' Token
g', Just b :: Word8
b <- Token -> Maybe Word8
w' Token
b', Just a :: Float
a <- Token -> Maybe Float
f' Token
a' =
        ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Word8 -> Word8 -> Word8 -> Colour Float
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 Word8
r Word8
g Word8
b Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Float
a)
parseColour _ (Hash _ v :: Text
v@(r0 :: Char
r0 :. r1 :: Char
r1 :. g0 :: Char
g0 :. g1 :: Char
g1 :. b0 :: Char
b0 :. b1 :: Char
b1 :. ""):toks :: [Token]
toks)
    | (Char -> Bool) -> Text -> Bool
Txt.all Char -> Bool
isHexDigit Text
v = ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Char -> Char -> Char -> Char -> Colour Float
sRGBhex Char
r0 Char
r1 Char
g0 Char
g1 Char
b0 Char
b1)
parseColour _ (Hash _ v :: Text
v@(r0 :: Char
r0 :. r1 :: Char
r1 :. g0 :: Char
g0 :. g1 :: Char
g1 :. b0 :: Char
b0 :. b1 :: Char
b1 :. a0 :: Char
a0 :. a1 :: Char
a1 :. ""):toks :: [Token]
toks)
    | (Char -> Bool) -> Text -> Bool
Txt.all Char -> Bool
isHexDigit Text
v =
        ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Char -> Char -> Char -> Char -> Char -> Char -> Colour Float
sRGBhex Char
r0 Char
r1 Char
g0 Char
g1 Char
b0 Char
b1 Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Char -> Char -> Float
h' Char
a0 Char
a1)
parseColour _ (Hash _ v :: Text
v@(r :: Char
r:.g :: Char
g:.b :: Char
b:.""):toks :: [Token]
toks) | (Char -> Bool) -> Text -> Bool
Txt.all Char -> Bool
isHexDigit Text
v =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Char -> Char -> Char -> Char -> Colour Float
sRGBhex Char
r Char
r Char
g Char
g Char
b Char
b)
parseColour _ (Hash _ v :: Text
v@(r :: Char
r:.g :: Char
g:.b :: Char
b:.a :: Char
a:.""):toks :: [Token]
toks) | (Char -> Bool) -> Text -> Bool
Txt.all Char -> Bool
isHexDigit Text
v =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Char -> Char -> Char -> Char -> Char -> Char -> Colour Float
sRGBhex Char
r Char
r Char
g Char
g Char
b Char
b Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Char -> Char -> Float
h' Char
a Char
a)

parseColour _ (Ident x :: Text
x:toks :: [Token]
toks) | Just x' :: Colour Float
x' <- Text -> Maybe (Colour Float)
forall a a.
(IsString a, Ord a, Floating a, Eq a) =>
a -> Maybe (Colour a)
inner (Text -> Maybe (Colour Float)) -> Text -> Maybe (Colour Float)
forall a b. (a -> b) -> a -> b
$ Text -> Text
Txt.toLower Text
x =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Float
x')
  where
    -- NOTE: Some of these colour names are inconsistant or even offensive.
    -- There are historical reasons for this labelling.
    -- https://www.youtube.com/watch?v=HmStJQzclHc
    inner :: a -> Maybe (Colour a)
inner "aliceblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
aliceblue
    inner "antiquewhite" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
antiquewhite
    inner "aqua" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
aqua
    inner "aquamarine" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
aquamarine
    inner "azure" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
azure
    inner "beige" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
beige
    inner "bisque" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
bisque
    inner "black" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. Num a => Colour a
black
    inner "blanchedalmond" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
blanchedalmond
    inner "blue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
blue
    inner "blueviolet" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
blueviolet
    inner "brown" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
brown
    inner "burlywood" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
burlywood
    inner "cadetblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
cadetblue
    inner "chartreuse" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
chartreuse
    inner "chocolate" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
chocolate
    inner "coral" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
coral
    inner "cornflowerblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
cornflowerblue
    inner "cornsilk" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
cornsilk
    inner "crimson" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
crimson
    inner "cyan" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
cyan
    inner "darkblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkblue
    inner "darkcyan" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkcyan
    inner "darkgoldenrod" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkgoldenrod
    inner "darkgray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkgray
    inner "darkgrey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkgrey
    inner "darkgreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkgreen
    inner "darkkhaki" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkkhaki
    inner "darkmagenta" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkmagenta
    inner "darkolivegreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkolivegreen
    inner "darkorange" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkorange
    inner "darkorchid" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkorchid
    inner "darkred" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkred
    inner "darksalmon" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darksalmon
    inner "darkseagreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkseagreen
    inner "darkslateblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkslateblue
    inner "darkslategray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkslategray
    inner "darkslategrey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkslategrey
    inner "darkturquoise" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkturquoise
    inner "darkviolet" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
darkviolet
    inner "deeppink" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
deeppink
    inner "deepskyblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
deepskyblue
    inner "dimgray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
dimgray
    inner "dimgrey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
dimgrey
    inner "dodgerblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
dodgerblue
    inner "firebrick" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
firebrick
    inner "floralwhite" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
floralwhite
    inner "forestgreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
forestgreen
    inner "fuchsia" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
fuchsia
    inner "gainsboro" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
gainsboro
    inner "ghostwhite" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
ghostwhite
    inner "gold" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
gold
    inner "goldenrod" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
goldenrod
    inner "gray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
gray
    inner "grey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
grey
    inner "green" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
green
    inner "greenyellow" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
greenyellow
    inner "honeydew" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
honeydew
    inner "hotpink" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
hotpink
    inner "indianred" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
indianred
    inner "indigo" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
indigo
    inner "ivory" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
ivory
    inner "khaki" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
khaki
    inner "lavender" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lavender
    inner "lavenderblush" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lavenderblush
    inner "lawngreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lawngreen
    inner "lemonchiffon" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lemonchiffon
    inner "lightblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightblue
    inner "lightcoral" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightcoral
    inner "lightcyan" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightcyan
    inner "lightgoldenrodyellow" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightgoldenrodyellow
    inner "lightgray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightgray
    inner "lightgrey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightgrey
    inner "lightgreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightgreen
    inner "lightpink" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightpink
    inner "lightsalmon" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightsalmon
    inner "lightseagreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightseagreen
    inner "lightskyblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightskyblue
    inner "lightslategray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightslategray
    inner "lightslategrey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightslategrey
    inner "lightsteelblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightsteelblue
    inner "lightyellow" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lightyellow
    inner "lime" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
lime
    inner "limegreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
limegreen
    inner "linen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
linen
    inner "magenta" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
magenta
    inner "maroon" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
maroon
    inner "mediumaquamarine" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumaquamarine
    inner "mediumblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumblue
    inner "mediumorchid" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumorchid
    inner "mediumpurple" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumpurple
    inner "mediumseagreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumseagreen
    inner "mediumslateblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumslateblue
    inner "mediumspringgreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumspringgreen
    inner "mediumturquoise" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumturquoise
    inner "mediumvioletred" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mediumvioletred
    inner "midnightblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
midnightblue
    inner "mintcream" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mintcream
    inner "mistyrose" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
mistyrose
    inner "moccasin" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
moccasin
    inner "navajowhite" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
navajowhite
    inner "navy" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
navy
    inner "oldlace" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
oldlace
    inner "olive" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
olive
    inner "olivedrab" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
olivedrab
    inner "orange" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
orange
    inner "orangered" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
orangered
    inner "orchid" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
orchid
    inner "palegoldenrod" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
palegoldenrod
    inner "palegreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
palegreen
    inner "paleturquoise" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
paleturquoise
    inner "palevioletred" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
palevioletred
    inner "papayawhip" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
papayawhip
    inner "peachpuff" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
peachpuff
    inner "peru" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
peru
    inner "pink" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
pink
    inner "plum" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
plum
    inner "powderblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
powderblue
    inner "purple" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
purple
    -- Named after CSS pioneer Eric Meyer's late daughter
    inner "rebeccapurple" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just (Colour a -> Maybe (Colour a)) -> Colour a -> Maybe (Colour a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Colour a
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB 102 51 153
    inner "red" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
red
    inner "rosybrown" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
rosybrown
    inner "royalblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
royalblue
    inner "saddlebrown" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
saddlebrown
    inner "salmon" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
salmon
    inner "sandybrown" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
sandybrown
    inner "seagreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
seagreen
    inner "seashell" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
seashell
    inner "sienna" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
sienna
    inner "silver" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
silver
    inner "skyblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
skyblue
    inner "slateblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
slateblue
    inner "slategray" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
slategray
    inner "slategrey" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
slategrey
    inner "snow" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
snow
    inner "springgreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
springgreen
    inner "steelblue" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
steelblue
    inner "tan" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
Data.Colour.Names.tan
    inner "teal" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
teal
    inner "thistle" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
thistle
    inner "tomato" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
tomato
    inner "turquoise" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
turquoise
    inner "violet" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
violet
    inner "wheat" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
wheat
    inner "white" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
white
    inner "whitesmoke" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
whitesmoke
    inner "yellow" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
yellow
    inner "yellowgreen" = Colour a -> Maybe (Colour a)
forall a. a -> Maybe a
Just Colour a
forall a. (Ord a, Floating a) => Colour a
yellowgreen
    inner _ = Maybe (Colour a)
forall a. Maybe a
Nothing
parseColour _ (Ident x :: Text
x:toks :: [Token]
toks) | Text -> Text
Txt.toLower Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "transparent" =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, AlphaColour Float
forall a. Num a => AlphaColour a
transparent)
-- FIXME: Add infrastructure to prioritize resolving `color`
parseColour self :: ColourPallet
self@ColourPallet { foreground :: ColourPallet -> AlphaColour Float
foreground = AlphaColour Float
colour} (Ident x :: Text
x:toks :: [Token]
toks)
    | Text -> Text
Txt.toLower Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["currentcolor", "initial"] = ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, AlphaColour Float
colour)
    | Text -> Text
Txt.toLower Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "accentcolor" = ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, ColourPallet -> AlphaColour Float
accent ColourPallet
self)

parseColour _ (Function "hsl":hue' :: Token
hue':Comma:Percentage _ s :: NumericValue
s:Comma:Percentage _ l :: NumericValue
l:
        RightParen:toks :: [Token]
toks)
    | Just hue :: Float
hue <- Token -> Maybe Float
d Token
hue' = ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Colour Float
forall a. RealFrac a => a -> a -> a -> Colour a
hsl' Float
hue (NumericValue -> Float
pc NumericValue
s) (NumericValue -> Float
pc NumericValue
l))
parseColour _ (Function "hsl":hue' :: Token
hue':Comma:Percentage _ s :: NumericValue
s:Comma:Percentage _ l :: NumericValue
l:
        Comma:a' :: Token
a':RightParen:toks :: [Token]
toks) | Just hue :: Float
hue <- Token -> Maybe Float
d Token
hue', Just a :: Float
a <- Token -> Maybe Float
f' Token
a' =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Float -> Float -> Float -> Colour Float
forall a. RealFrac a => a -> a -> a -> Colour a
hsl' Float
hue (NumericValue -> Float
pc NumericValue
s) (NumericValue -> Float
pc NumericValue
l) Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Float
a)
parseColour _ (Function "hsla":hue' :: Token
hue':Comma:Percentage _ s :: NumericValue
s:Comma:Percentage _ l :: NumericValue
l:
        Comma:a' :: Token
a':RightParen:toks :: [Token]
toks) | Just hue :: Float
hue <- Token -> Maybe Float
d Token
hue', Just a :: Float
a <- Token -> Maybe Float
f' Token
a' =
    ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Float -> Float -> Float -> Colour Float
forall a. RealFrac a => a -> a -> a -> Colour a
hsl' Float
hue (NumericValue -> Float
pc NumericValue
s) (NumericValue -> Float
pc NumericValue
l) Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Float
a)
parseColour _ (Function "hsl":hue' :: Token
hue':s' :: Token
s':l' :: Token
l':RightParen:toks :: [Token]
toks)
    | Just hue :: Float
hue <- Token -> Maybe Float
d' Token
hue', Just s :: Float
s <- Token -> Maybe Float
pc' Token
s', Just l :: Float
l <- Token -> Maybe Float
pc' Token
l' =
        ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Colour Float -> AlphaColour Float
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Float -> AlphaColour Float)
-> Colour Float -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Colour Float
forall a. RealFrac a => a -> a -> a -> Colour a
hsl' Float
hue Float
s Float
l)
parseColour _ (Function "hsl":hue' :: Token
hue':s' :: Token
s':l' :: Token
l':Delim '/':a' :: Token
a':RightParen:toks :: [Token]
toks)
    | Just hue :: Float
hue <- Token -> Maybe Float
d' Token
hue', Just s :: Float
s <- Token -> Maybe Float
pc' Token
s', Just l :: Float
l <- Token -> Maybe Float
pc' Token
l', Just a :: Float
a <- Token -> Maybe Float
f' Token
a' =
        ([Token], AlphaColour Float) -> Maybe ([Token], AlphaColour Float)
forall a. a -> Maybe a
Just ([Token]
toks, Float -> Float -> Float -> Colour Float
forall a. RealFrac a => a -> a -> a -> Colour a
hsl' Float
hue Float
s Float
l Colour Float -> Float -> AlphaColour Float
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` Float
a)

parseColour _ _ = Maybe ([Token], AlphaColour Float)
forall a. Maybe a
Nothing

sRGBhex :: Char -> Char -> Char -> Char -> Char -> Char -> Colour Float
sRGBhex :: Char -> Char -> Char -> Char -> Char -> Char -> Colour Float
sRGBhex r0 :: Char
r0 r1 :: Char
r1 g0 :: Char
g0 g1 :: Char
g1 b0 :: Char
b0 b1 :: Char
b1 = Word8 -> Word8 -> Word8 -> Colour Float
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Char -> Char -> Word8
h Char
r0 Char
r1) (Char -> Char -> Word8
h Char
g0 Char
g1) (Char -> Char -> Word8
h Char
b0 Char
b1)

h :: Char -> Char -> Word8
h :: Char -> Char -> Word8
h a :: Char
a b :: Char
b
    | Just a' :: Int
a' <- Char -> Char
toLower Char
a Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` String
digits,
        Just b' :: Int
b' <- Char -> Char
toLower Char
b Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` String
digits = Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
a'Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a. Enum a => Int -> a
toEnum Int
b'
    | Bool
otherwise = String -> Word8 -> Word8
forall a. String -> a -> a
trace (Char
aChar -> ShowS
forall a. a -> [a] -> [a]
:Char
bChar -> ShowS
forall a. a -> [a] -> [a]
:" Invalid hexcode!") 0 -- Should already be checked!
  where
    digits :: String
digits = "0123456789abcdef"
h' :: Char -> Char -> Float
h' :: Char -> Char -> Float
h' a :: Char
a b :: Char
b = Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Char -> Word8
h Char
a Char
b) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 255

pc :: NumericValue -> Float
pc :: NumericValue -> Float
pc x :: NumericValue
x = NumericValue -> Float
f NumericValue
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 100
pc' :: Token -> Maybe Float
pc' :: Token -> Maybe Float
pc' (Ident "none") = Float -> Maybe Float
forall a. a -> Maybe a
Just 0
pc' (Percentage _ x :: NumericValue
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
pc NumericValue
x
pc' _ = Maybe Float
forall a. Maybe a
Nothing

f :: NumericValue -> Float
f :: NumericValue -> Float
f (NVInteger x :: Integer
x) = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
f (NVNumber x :: Scientific
x) = Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x
f' :: Token -> Maybe Float
f' :: Token -> Maybe Float
f' (Ident "none") = Float -> Maybe Float
forall a. a -> Maybe a
Just 0
f' (Percentage _ x :: NumericValue
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
pc NumericValue
x
f' (Number _ x :: NumericValue
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x
f' _ = Maybe Float
forall a. Maybe a
Nothing

w :: Integer -> Word8
w :: Integer -> Word8
w = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger
w' :: Token -> Maybe Word8
w' :: Token -> Maybe Word8
w' (Ident "none") = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 0
w' (Number _ (NVInteger x :: Integer
x)) | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= 255 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
w Integer
x
w' (Percentage _ x :: NumericValue
x) = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall a. Enum a => a -> Int
fromEnum (NumericValue -> Float
pc NumericValue
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* 255)
w' _ = Maybe Word8
forall a. Maybe a
Nothing

d', d :: Token -> Maybe Float
d :: Token -> Maybe Float
d (Dimension _ x :: NumericValue
x "deg") = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x
d (Dimension _ x :: NumericValue
x "grad") = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 400 Float -> Float -> Float
forall a. Num a => a -> a -> a
* 360
d (Dimension _ x :: NumericValue
x "rad") = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Num a => a -> a -> a
* 180
d (Dimension _ x :: NumericValue
x "turn") = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* 360
d (Number _ x :: NumericValue
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x
d _ = Maybe Float
forall a. Maybe a
Nothing
d' :: Token -> Maybe Float
d' (Ident "none") = Float -> Maybe Float
forall a. a -> Maybe a
Just 0
d' x :: Token
x = Token -> Maybe Float
d Token
x

-- Copied from css-syntax.
pattern (:.) :: Char -> Txt.Text -> Txt.Text
pattern x $m:. :: forall r. Text -> (Char -> Text -> r) -> (Void# -> r) -> r
:. xs <- (Txt.uncons -> Just (x, xs))

infixr 5 :.