{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}
module Graphics.Rendering.Rect.CSS.Backgrounds (Backgrounds(..),
    Pattern(..), RadialShape(..), Extent(..),
    Resize(..), Length(..), resolveSize) where

import Stylist (PropertyParser(..), parseUnorderedShorthand, parseOperands)
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Maybe (isJust, catMaybes)
import Data.Text (Text)
import Data.Scientific (scientific, toRealFloat)

import Graphics.Rendering.Rect.CSS.Colour (ColourPallet, parseColour)
import Data.Colour (AlphaColour, transparent)
import Graphics.Rendering.Rect.Types (Rects(..), Rect(..))

data Backgrounds img = Backgrounds {
    Backgrounds img -> ColourPallet
pallet :: ColourPallet,
    Backgrounds img -> C
background :: C,
    Backgrounds img -> [Rects -> Rect]
clip :: [Rects -> Rect],
    Backgrounds img -> [Rects -> Rect]
origin :: [Rects -> Rect],
    Backgrounds img -> [Pattern img]
image :: [Pattern img],
    Backgrounds img -> [(Length, Length)]
bgPos :: [(Length, Length)],
    Backgrounds img -> [Resize]
bgSize :: [Resize],
    Backgrounds img -> [(Bool, Bool)]
bgRepeat :: [(Bool, Bool)]
} deriving (Backgrounds img -> Backgrounds img -> Bool
(Backgrounds img -> Backgrounds img -> Bool)
-> (Backgrounds img -> Backgrounds img -> Bool)
-> Eq (Backgrounds img)
forall img. Eq img => Backgrounds img -> Backgrounds img -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backgrounds img -> Backgrounds img -> Bool
$c/= :: forall img. Eq img => Backgrounds img -> Backgrounds img -> Bool
== :: Backgrounds img -> Backgrounds img -> Bool
$c== :: forall img. Eq img => Backgrounds img -> Backgrounds img -> Bool
Eq, Int -> Backgrounds img -> ShowS
[Backgrounds img] -> ShowS
Backgrounds img -> String
(Int -> Backgrounds img -> ShowS)
-> (Backgrounds img -> String)
-> ([Backgrounds img] -> ShowS)
-> Show (Backgrounds img)
forall img. Show img => Int -> Backgrounds img -> ShowS
forall img. Show img => [Backgrounds img] -> ShowS
forall img. Show img => Backgrounds img -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backgrounds img] -> ShowS
$cshowList :: forall img. Show img => [Backgrounds img] -> ShowS
show :: Backgrounds img -> String
$cshow :: forall img. Show img => Backgrounds img -> String
showsPrec :: Int -> Backgrounds img -> ShowS
$cshowsPrec :: forall img. Show img => Int -> Backgrounds img -> ShowS
Show, ReadPrec [Backgrounds img]
ReadPrec (Backgrounds img)
Int -> ReadS (Backgrounds img)
ReadS [Backgrounds img]
(Int -> ReadS (Backgrounds img))
-> ReadS [Backgrounds img]
-> ReadPrec (Backgrounds img)
-> ReadPrec [Backgrounds img]
-> Read (Backgrounds img)
forall img. Read img => ReadPrec [Backgrounds img]
forall img. Read img => ReadPrec (Backgrounds img)
forall img. Read img => Int -> ReadS (Backgrounds img)
forall img. Read img => ReadS [Backgrounds img]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Backgrounds img]
$creadListPrec :: forall img. Read img => ReadPrec [Backgrounds img]
readPrec :: ReadPrec (Backgrounds img)
$creadPrec :: forall img. Read img => ReadPrec (Backgrounds img)
readList :: ReadS [Backgrounds img]
$creadList :: forall img. Read img => ReadS [Backgrounds img]
readsPrec :: Int -> ReadS (Backgrounds img)
$creadsPrec :: forall img. Read img => Int -> ReadS (Backgrounds img)
Read)

type C = AlphaColour Float

data Pattern img = None | Img img | Linear Float [(C, Length)]
    | Radial RadialShape Extent (Length, Length) [(C, Length)]
    | Conical Float (Length, Length) [(C, Length)]
    deriving (Pattern img -> Pattern img -> Bool
(Pattern img -> Pattern img -> Bool)
-> (Pattern img -> Pattern img -> Bool) -> Eq (Pattern img)
forall img. Eq img => Pattern img -> Pattern img -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern img -> Pattern img -> Bool
$c/= :: forall img. Eq img => Pattern img -> Pattern img -> Bool
== :: Pattern img -> Pattern img -> Bool
$c== :: forall img. Eq img => Pattern img -> Pattern img -> Bool
Eq, Int -> Pattern img -> ShowS
[Pattern img] -> ShowS
Pattern img -> String
(Int -> Pattern img -> ShowS)
-> (Pattern img -> String)
-> ([Pattern img] -> ShowS)
-> Show (Pattern img)
forall img. Show img => Int -> Pattern img -> ShowS
forall img. Show img => [Pattern img] -> ShowS
forall img. Show img => Pattern img -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern img] -> ShowS
$cshowList :: forall img. Show img => [Pattern img] -> ShowS
show :: Pattern img -> String
$cshow :: forall img. Show img => Pattern img -> String
showsPrec :: Int -> Pattern img -> ShowS
$cshowsPrec :: forall img. Show img => Int -> Pattern img -> ShowS
Show, ReadPrec [Pattern img]
ReadPrec (Pattern img)
Int -> ReadS (Pattern img)
ReadS [Pattern img]
(Int -> ReadS (Pattern img))
-> ReadS [Pattern img]
-> ReadPrec (Pattern img)
-> ReadPrec [Pattern img]
-> Read (Pattern img)
forall img. Read img => ReadPrec [Pattern img]
forall img. Read img => ReadPrec (Pattern img)
forall img. Read img => Int -> ReadS (Pattern img)
forall img. Read img => ReadS [Pattern img]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern img]
$creadListPrec :: forall img. Read img => ReadPrec [Pattern img]
readPrec :: ReadPrec (Pattern img)
$creadPrec :: forall img. Read img => ReadPrec (Pattern img)
readList :: ReadS [Pattern img]
$creadList :: forall img. Read img => ReadS [Pattern img]
readsPrec :: Int -> ReadS (Pattern img)
$creadsPrec :: forall img. Read img => Int -> ReadS (Pattern img)
Read)
data RadialShape = Circle | Ellipse deriving (RadialShape -> RadialShape -> Bool
(RadialShape -> RadialShape -> Bool)
-> (RadialShape -> RadialShape -> Bool) -> Eq RadialShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RadialShape -> RadialShape -> Bool
$c/= :: RadialShape -> RadialShape -> Bool
== :: RadialShape -> RadialShape -> Bool
$c== :: RadialShape -> RadialShape -> Bool
Eq, Int -> RadialShape -> ShowS
[RadialShape] -> ShowS
RadialShape -> String
(Int -> RadialShape -> ShowS)
-> (RadialShape -> String)
-> ([RadialShape] -> ShowS)
-> Show RadialShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RadialShape] -> ShowS
$cshowList :: [RadialShape] -> ShowS
show :: RadialShape -> String
$cshow :: RadialShape -> String
showsPrec :: Int -> RadialShape -> ShowS
$cshowsPrec :: Int -> RadialShape -> ShowS
Show, ReadPrec [RadialShape]
ReadPrec RadialShape
Int -> ReadS RadialShape
ReadS [RadialShape]
(Int -> ReadS RadialShape)
-> ReadS [RadialShape]
-> ReadPrec RadialShape
-> ReadPrec [RadialShape]
-> Read RadialShape
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RadialShape]
$creadListPrec :: ReadPrec [RadialShape]
readPrec :: ReadPrec RadialShape
$creadPrec :: ReadPrec RadialShape
readList :: ReadS [RadialShape]
$creadList :: ReadS [RadialShape]
readsPrec :: Int -> ReadS RadialShape
$creadsPrec :: Int -> ReadS RadialShape
Read)
data Extent = Extent Length Length | ClosestCorner
    | ClosestSide | FarthestCorner | FarthestSide deriving (Extent -> Extent -> Bool
(Extent -> Extent -> Bool)
-> (Extent -> Extent -> Bool) -> Eq Extent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extent -> Extent -> Bool
$c/= :: Extent -> Extent -> Bool
== :: Extent -> Extent -> Bool
$c== :: Extent -> Extent -> Bool
Eq, Int -> Extent -> ShowS
[Extent] -> ShowS
Extent -> String
(Int -> Extent -> ShowS)
-> (Extent -> String) -> ([Extent] -> ShowS) -> Show Extent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extent] -> ShowS
$cshowList :: [Extent] -> ShowS
show :: Extent -> String
$cshow :: Extent -> String
showsPrec :: Int -> Extent -> ShowS
$cshowsPrec :: Int -> Extent -> ShowS
Show, ReadPrec [Extent]
ReadPrec Extent
Int -> ReadS Extent
ReadS [Extent]
(Int -> ReadS Extent)
-> ReadS [Extent]
-> ReadPrec Extent
-> ReadPrec [Extent]
-> Read Extent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Extent]
$creadListPrec :: ReadPrec [Extent]
readPrec :: ReadPrec Extent
$creadPrec :: ReadPrec Extent
readList :: ReadS [Extent]
$creadList :: ReadS [Extent]
readsPrec :: Int -> ReadS Extent
$creadsPrec :: Int -> ReadS Extent
Read)

-- We need to resolve images before we can compute the actual lengths!
data Resize = Cover | Contain | Size Length Length deriving (Resize -> Resize -> Bool
(Resize -> Resize -> Bool)
-> (Resize -> Resize -> Bool) -> Eq Resize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resize -> Resize -> Bool
$c/= :: Resize -> Resize -> Bool
== :: Resize -> Resize -> Bool
$c== :: Resize -> Resize -> Bool
Eq, Int -> Resize -> ShowS
[Resize] -> ShowS
Resize -> String
(Int -> Resize -> ShowS)
-> (Resize -> String) -> ([Resize] -> ShowS) -> Show Resize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resize] -> ShowS
$cshowList :: [Resize] -> ShowS
show :: Resize -> String
$cshow :: Resize -> String
showsPrec :: Int -> Resize -> ShowS
$cshowsPrec :: Int -> Resize -> ShowS
Show, ReadPrec [Resize]
ReadPrec Resize
Int -> ReadS Resize
ReadS [Resize]
(Int -> ReadS Resize)
-> ReadS [Resize]
-> ReadPrec Resize
-> ReadPrec [Resize]
-> Read Resize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Resize]
$creadListPrec :: ReadPrec [Resize]
readPrec :: ReadPrec Resize
$creadPrec :: ReadPrec Resize
readList :: ReadS [Resize]
$creadList :: ReadS [Resize]
readsPrec :: Int -> ReadS Resize
$creadsPrec :: Int -> ReadS Resize
Read)
data Length = Absolute Float | Scale Float | Auto deriving (Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq, Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
(Int -> Length -> ShowS)
-> (Length -> String) -> ([Length] -> ShowS) -> Show Length
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> String
$cshow :: Length -> String
showsPrec :: Int -> Length -> ShowS
$cshowsPrec :: Int -> Length -> ShowS
Show, ReadPrec [Length]
ReadPrec Length
Int -> ReadS Length
ReadS [Length]
(Int -> ReadS Length)
-> ReadS [Length]
-> ReadPrec Length
-> ReadPrec [Length]
-> Read Length
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Length]
$creadListPrec :: ReadPrec [Length]
readPrec :: ReadPrec Length
$creadPrec :: ReadPrec Length
readList :: ReadS [Length]
$creadList :: ReadS [Length]
readsPrec :: Int -> ReadS Length
$creadsPrec :: Int -> ReadS Length
Read)

instance PropertyParser (Backgrounds Text) where
    temp :: Backgrounds Text
temp = Backgrounds :: forall img.
ColourPallet
-> C
-> [Rects -> Rect]
-> [Rects -> Rect]
-> [Pattern img]
-> [(Length, Length)]
-> [Resize]
-> [(Bool, Bool)]
-> Backgrounds img
Backgrounds {
        pallet :: ColourPallet
pallet = ColourPallet
forall a. PropertyParser a => a
temp, background :: C
background = C
forall a. Num a => AlphaColour a
transparent, clip :: [Rects -> Rect]
clip = [Rects -> Rect
borderBox],
        image :: [Pattern Text]
image = [Pattern Text
forall img. Pattern img
None], bgSize :: [Resize]
bgSize = [Length -> Length -> Resize
Size Length
Auto Length
Auto], origin :: [Rects -> Rect]
origin = [Rects -> Rect
paddingBox],
        bgPos :: [(Length, Length)]
bgPos = [(Float -> Length
Absolute 0, Float -> Length
Absolute 0)], bgRepeat :: [(Bool, Bool)]
bgRepeat = [(Bool
True, Bool
True)]
      }
    inherit :: Backgrounds Text -> Backgrounds Text
inherit _ = Backgrounds Text
forall a. PropertyParser a => a
temp
    priority :: Backgrounds Text -> [Text]
priority _ = []

    longhand :: Backgrounds Text
-> Backgrounds Text -> Text -> [Token] -> Maybe (Backgrounds Text)
longhand _ self :: Backgrounds Text
self@Backgrounds{ pallet :: forall img. Backgrounds img -> ColourPallet
pallet = ColourPallet
c } "background-color" toks :: [Token]
toks
        | Just ([], val :: C
val) <- ColourPallet -> [Token] -> Maybe ([Token], C)
parseColour ColourPallet
c [Token]
toks = Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { background :: C
background = C
val }
    longhand _ self :: Backgrounds Text
self "background-clip" t :: [Token]
t | val :: [Rects -> Rect]
val@(_:_) <- ([Token] -> Maybe (Rects -> Rect)) -> [Token] -> [Rects -> Rect]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe (Rects -> Rect)
box [Token]
t =
        Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { clip :: [Rects -> Rect]
clip = [Rects -> Rect] -> [Rects -> Rect]
forall a. [a] -> [a]
reverse [Rects -> Rect]
val }
    longhand _ self :: Backgrounds Text
self@Backgrounds { pallet :: forall img. Backgrounds img -> ColourPallet
pallet = ColourPallet
pp } "background-image" t :: [Token]
t
        | val :: [Pattern Text]
val@(_:_) <- ([Token] -> Maybe (Pattern Text)) -> [Token] -> [Pattern Text]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe (Pattern Text)
inner [Token]
t = Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { image :: [Pattern Text]
image = [Pattern Text] -> [Pattern Text]
forall a. [a] -> [a]
reverse [Pattern Text]
val }
      where
        inner :: [Token] -> Maybe (Pattern Text)
inner [Ident "none"] = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just Pattern Text
forall img. Pattern img
None
        inner [Ident "initial"] = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just Pattern Text
forall img. Pattern img
None
        inner [Url ret :: Text
ret] = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Text -> Pattern Text
forall img. img -> Pattern img
Img Text
ret
        inner [Function "url", String ret :: Text
ret, RightParen] = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Text -> Pattern Text
forall img. img -> Pattern img
Img Text
ret
        inner (Function "linear-gradient":toks :: [Token]
toks)
            | Just cs :: [(C, Length)]
cs@(_:_:_)<-ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp (Token
CommaToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks) = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> [(C, Length)] -> Pattern Text
forall img. Float -> [(C, Length)] -> Pattern img
Linear Float
forall a. Floating a => a
pi [(C, Length)]
cs
        inner (Function "linear-gradient":Dimension _ x :: NumericValue
x unit :: Text
unit:toks :: [Token]
toks)
            | Just s :: Float
s <- Text -> [(Text, Float)] -> Maybe Float
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
unit [(Text, Float)]
angularUnits,
                Just cs :: [(C, Length)]
cs@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
toks = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> [(C, Length)] -> Pattern Text
forall img. Float -> [(C, Length)] -> Pattern img
Linear (NumericValue -> Float
f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
s) [(C, Length)]
cs
        inner (Function "linear-gradient":Ident "to":Ident a :: Text
a:Ident b :: Text
b:toks :: [Token]
toks)
            | Just angle :: Float
angle<-Text -> Text -> Maybe Float
forall a a a.
(Eq a, Eq a, IsString a, IsString a, Floating a) =>
a -> a -> Maybe a
corner Text
a Text
b, Just stops :: [(C, Length)]
stops@(_:_:_)<-ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
toks =
                Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> [(C, Length)] -> Pattern Text
forall img. Float -> [(C, Length)] -> Pattern img
Linear Float
angle [(C, Length)]
stops
            | Just angle :: Float
angle<-Text -> Text -> Maybe Float
forall a a a.
(Eq a, Eq a, IsString a, IsString a, Floating a) =>
a -> a -> Maybe a
corner Text
b Text
a, Just stops :: [(C, Length)]
stops@(_:_:_)<-ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
toks =
                Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> [(C, Length)] -> Pattern Text
forall img. Float -> [(C, Length)] -> Pattern img
Linear Float
angle [(C, Length)]
stops
          where
            corner :: a -> a -> Maybe a
corner "top" "right" = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ 0.25a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi
            corner "bottom" "right" = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ 0.75a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi
            corner "bottom" "left" = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ 1.25a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi
            corner "top" "left" = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ 1.75a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi
            corner _ _ = Maybe a
forall a. Maybe a
Nothing
        inner (Function "linear-gradient":Ident "to":Ident side :: Text
side:toks :: [Token]
toks)
            | Just angle :: Float
angle <- Text -> [(Text, Float)] -> Maybe Float
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
side [
                ("top", 0), ("right", Float
forall a. Floating a => a
piFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/2), ("bottom", Float
forall a. Floating a => a
pi), ("left", Float
forall a. Floating a => a
piFloat -> Float -> Float
forall a. Num a => a -> a -> a
*1.5)],
                Just cs :: [(C, Length)]
cs@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
toks = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> [(C, Length)] -> Pattern Text
forall img. Float -> [(C, Length)] -> Pattern img
Linear Float
angle [(C, Length)]
cs
        inner (Function "radial-gradient":toks :: [Token]
toks)
            | Just cs :: [(C, Length)]
cs@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp (Token
CommaToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks) =
                Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ RadialShape
-> Extent -> (Length, Length) -> [(C, Length)] -> Pattern Text
forall img.
RadialShape
-> Extent -> (Length, Length) -> [(C, Length)] -> Pattern img
Radial RadialShape
Ellipse Extent
FarthestCorner (Length, Length)
center [(C, Length)]
cs
            | (shp :: RadialShape
shp, org :: (Length, Length)
org, ext :: Extent
ext, ts :: [Token]
ts) <- [Token] -> (RadialShape, (Length, Length), Extent, [Token])
radArgs [Token]
toks,
                Just cs :: [(C, Length)]
cs@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
ts = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ RadialShape
-> Extent -> (Length, Length) -> [(C, Length)] -> Pattern Text
forall img.
RadialShape
-> Extent -> (Length, Length) -> [(C, Length)] -> Pattern img
Radial RadialShape
shp Extent
ext (Length, Length)
org [(C, Length)]
cs
          where
            radArgs :: [Token] -> (RadialShape, (Length, Length), Extent, [Token])
radArgs (Ident s :: Text
s:Ident "at":ts :: [Token]
ts) | Just shape :: RadialShape
shape <- Text -> Maybe RadialShape
forall a. (Eq a, IsString a) => a -> Maybe RadialShape
radShape Text
s,
                    Just (org :: (Length, Length)
org, ts' :: [Token]
ts') <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts =
                (RadialShape
shape, (Length, Length)
org, Extent
FarthestCorner, [Token]
ts')
            radArgs (Ident "at":ts :: [Token]
ts) | Just (org :: (Length, Length)
org, ts' :: [Token]
ts') <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts =
                (RadialShape
Ellipse, (Length, Length)
org, Extent
FarthestCorner, [Token]
ts')
            radArgs (Ident "circle":Ident "at":ts :: [Token]
ts)
                | Just (org :: (Length, Length)
org, ts' :: [Token]
ts') <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts = (RadialShape
Circle,(Length, Length)
org,Extent
FarthestCorner,[Token]
ts')
            radArgs (Ident "circle":ts :: [Token]
ts)
                | Just (_, Ident "at":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
circleExt [Token]
ts,
                        Just (org :: (Length, Length)
org, stops :: [Token]
stops) <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts' =
                    (RadialShape
Circle, (Length, Length)
org, Extent
FarthestCorner, [Token]
stops)
                | Just (_,ts' :: [Token]
ts')<-[Token] -> Maybe (Extent, [Token])
circleExt [Token]
ts=(RadialShape
Circle,(Length, Length)
center,Extent
FarthestCorner,[Token]
ts')
                | Bool
otherwise = (RadialShape
Circle, (Length, Length)
center, Extent
FarthestCorner, [Token]
ts)
            radArgs (Ident "ellipse":Ident "at":ts :: [Token]
ts)
                | Just (org :: (Length, Length)
org,ts' :: [Token]
ts')<-[Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts=(RadialShape
Ellipse,(Length, Length)
org,Extent
FarthestCorner,[Token]
ts')
            radArgs (Ident "ellipse":ts :: [Token]
ts)
                | Just (_, Ident "at":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
ellipseExt [Token]
ts,
                        Just (org :: (Length, Length)
org, stops :: [Token]
stops) <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts' =
                    (RadialShape
Ellipse, (Length, Length)
org, Extent
FarthestCorner, [Token]
stops)
                | Just (_,ts' :: [Token]
ts')<-[Token] -> Maybe (Extent, [Token])
ellipseExt [Token]
ts=(RadialShape
Ellipse,(Length, Length)
center,Extent
FarthestCorner,[Token]
ts')
                | Bool
otherwise = (RadialShape
Ellipse, (Length, Length)
center, Extent
FarthestCorner, [Token]
ts)
            radArgs ts :: [Token]
ts | Just (_, Ident "at":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
ellipseExt [Token]
ts,
                        Just (org :: (Length, Length)
org, stops :: [Token]
stops) <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts' =
                    (RadialShape
Ellipse, (Length, Length)
org, Extent
FarthestCorner, [Token]
stops)
                | Just (_, Ident "ellipse":Ident "at":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
ellipseExt [Token]
ts,
                        Just (org :: (Length, Length)
org, stops :: [Token]
stops) <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts' =
                    (RadialShape
Ellipse, (Length, Length)
org, Extent
FarthestCorner, [Token]
stops)
                | Just (_, Ident "ellipse":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
ellipseExt [Token]
ts =
                    (RadialShape
Ellipse, (Length, Length)
center, Extent
FarthestCorner, [Token]
ts')
                | Just (_, Ident "circle":Ident "at":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
circleExt [Token]
ts,
                        Just (org :: (Length, Length)
org, stops :: [Token]
stops) <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts' =
                    (RadialShape
Circle, (Length, Length)
org, Extent
FarthestCorner, [Token]
stops)
                | Just (_, Ident "circle":ts' :: [Token]
ts') <- [Token] -> Maybe (Extent, [Token])
circleExt [Token]
ts =
                    (RadialShape
Circle, (Length, Length)
center, Extent
FarthestCorner, [Token]
ts')
                | Bool
otherwise = (RadialShape
Ellipse, (Length, Length)
center, Extent
FarthestCorner, [Token]
ts)
            radShape :: a -> Maybe RadialShape
radShape "circle" = RadialShape -> Maybe RadialShape
forall a. a -> Maybe a
Just RadialShape
Circle
            radShape "ellipse" = RadialShape -> Maybe RadialShape
forall a. a -> Maybe a
Just RadialShape
Ellipse
            radShape _ = Maybe RadialShape
forall a. Maybe a
Nothing
            radExt :: [Token] -> Maybe (Extent, [Token])
radExt (Ident "closest-corner":ts :: [Token]
ts) = (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (Extent
ClosestCorner, [Token]
ts)
            radExt (Ident "closest-side":ts :: [Token]
ts) = (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (Extent
ClosestSide, [Token]
ts)
            radExt (Ident "farthest-corner":ts :: [Token]
ts) = (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (Extent
FarthestCorner, [Token]
ts)
            radExt (Ident "farthest-side":ts :: [Token]
ts) = (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (Extent
FarthestSide, [Token]
ts)
            radExt _ = Maybe (Extent, [Token])
forall a. Maybe a
Nothing
            ellipseExt :: [Token] -> Maybe (Extent, [Token])
ellipseExt ts :: [Token]
ts | Just ret :: (Extent, [Token])
ret <- [Token] -> Maybe (Extent, [Token])
radExt [Token]
ts = (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (Extent, [Token])
ret
            ellipseExt (Percentage _ x :: NumericValue
x:Percentage _ y :: NumericValue
y:ts :: [Token]
ts) =
                (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (NumericValue -> Length
p' NumericValue
x Length -> Length -> Extent
`Extent` NumericValue -> Length
p' NumericValue
y, [Token]
ts)
            ellipseExt (Percentage _ x :: NumericValue
x:Dimension _ y :: NumericValue
y "px":ts :: [Token]
ts) =
                (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (NumericValue -> Length
p' NumericValue
x Length -> Length -> Extent
`Extent` NumericValue -> Length
f' NumericValue
y, [Token]
ts)
            ellipseExt (Dimension _ x :: NumericValue
x "px":Percentage _ y :: NumericValue
y:ts :: [Token]
ts) =
                (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (NumericValue -> Length
f' NumericValue
x Length -> Length -> Extent
`Extent` NumericValue -> Length
p' NumericValue
y, [Token]
ts)
            ellipseExt (Dimension _ x :: NumericValue
x "px":Dimension _ y :: NumericValue
y "px":ts :: [Token]
ts) =
                (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (NumericValue -> Length
f' NumericValue
x Length -> Length -> Extent
`Extent` NumericValue -> Length
p' NumericValue
y, [Token]
ts)
            ellipseExt _ = Maybe (Extent, [Token])
forall a. Maybe a
Nothing
            circleExt :: [Token] -> Maybe (Extent, [Token])
circleExt (Dimension _ x :: NumericValue
x "px":ts :: [Token]
ts) = (Extent, [Token]) -> Maybe (Extent, [Token])
forall a. a -> Maybe a
Just (NumericValue -> Length
f' NumericValue
x Length -> Length -> Extent
`Extent` NumericValue -> Length
f' NumericValue
x, [Token]
ts)
            circleExt ts :: [Token]
ts = [Token] -> Maybe (Extent, [Token])
radExt [Token]
ts
        -- NOTE: Not implementing colourspaces yet...
        inner (Function "conic-gradient":Ident "from":Dimension _ x :: NumericValue
x unit :: Text
unit:
                    Ident "at":ts :: [Token]
ts)
            | Just (org :: (Length, Length)
org, ts' :: [Token]
ts') <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts, Just s :: Float
s <- Text -> [(Text, Float)] -> Maybe Float
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
unit [(Text, Float)]
angularUnits,
              Just stops :: [(C, Length)]
stops@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
ts' =
                Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> (Length, Length) -> [(C, Length)] -> Pattern Text
forall img.
Float -> (Length, Length) -> [(C, Length)] -> Pattern img
Conical (NumericValue -> Float
f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
s) (Length, Length)
org [(C, Length)]
stops
        inner (Function "conic-gradient":Ident "from":Dimension _ x :: NumericValue
x unit :: Text
unit:ts :: [Token]
ts)
            | Just s :: Float
s <- Text -> [(Text, Float)] -> Maybe Float
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
unit [(Text, Float)]
angularUnits,
              Just stops :: [(C, Length)]
stops@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
ts =
                Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> (Length, Length) -> [(C, Length)] -> Pattern Text
forall img.
Float -> (Length, Length) -> [(C, Length)] -> Pattern img
Conical (NumericValue -> Float
f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
s) (Length, Length)
center [(C, Length)]
stops
        inner (Function "conic-gradient":Ident "at":ts :: [Token]
ts)
            | Just (org :: (Length, Length)
org, ts' :: [Token]
ts') <- [Token] -> Maybe ((Length, Length), [Token])
position [Token]
ts,
                Just cs :: [(C, Length)]
cs@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp [Token]
ts' = Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> (Length, Length) -> [(C, Length)] -> Pattern Text
forall img.
Float -> (Length, Length) -> [(C, Length)] -> Pattern img
Conical 0 (Length, Length)
org [(C, Length)]
cs
        inner (Function "conic-gradient":ts :: [Token]
ts)
            | Just stops :: [(C, Length)]
stops@(_:_:_) <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
pp (Token
CommaToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
ts) =
                Pattern Text -> Maybe (Pattern Text)
forall a. a -> Maybe a
Just (Pattern Text -> Maybe (Pattern Text))
-> Pattern Text -> Maybe (Pattern Text)
forall a b. (a -> b) -> a -> b
$ Float -> (Length, Length) -> [(C, Length)] -> Pattern Text
forall img.
Float -> (Length, Length) -> [(C, Length)] -> Pattern img
Conical 0 (Length, Length)
center [(C, Length)]
stops
        inner _ = Maybe (Pattern Text)
forall a. Maybe a
Nothing

        angularUnits :: [(Text, Float)]
angularUnits = [("deg",Float
forall a. Floating a => a
piFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/180),("grad",Float
forall a. Floating a => a
piFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/200),("rad",1),("turn",2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
forall a. Floating a => a
pi)]
        center :: (Length, Length)
center = (Float -> Length
Scale 0.5, Float -> Length
Scale 0.5)
    longhand _ self :: Backgrounds Text
self "background-origin" t :: [Token]
t | val :: [Rects -> Rect]
val@(_:_) <- ([Token] -> Maybe (Rects -> Rect)) -> [Token] -> [Rects -> Rect]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe (Rects -> Rect)
box [Token]
t =
        Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { origin :: [Rects -> Rect]
origin = [Rects -> Rect] -> [Rects -> Rect]
forall a. [a] -> [a]
reverse [Rects -> Rect]
val }
    longhand _ self :: Backgrounds Text
self "background-position" t :: [Token]
t | val :: [((Length, Length), [Token])]
val@(_:_) <- ([Token] -> Maybe ((Length, Length), [Token]))
-> [Token] -> [((Length, Length), [Token])]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe ((Length, Length), [Token])
position [Token]
t,
        (((Length, Length), [Token]) -> Bool)
-> [((Length, Length), [Token])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Token] -> Bool)
-> (((Length, Length), [Token]) -> [Token])
-> ((Length, Length), [Token])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Length, Length), [Token]) -> [Token]
forall a b. (a, b) -> b
snd) [((Length, Length), [Token])]
val = Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { bgPos :: [(Length, Length)]
bgPos = [(Length, Length)] -> [(Length, Length)]
forall a. [a] -> [a]
reverse ([(Length, Length)] -> [(Length, Length)])
-> [(Length, Length)] -> [(Length, Length)]
forall a b. (a -> b) -> a -> b
$ (((Length, Length), [Token]) -> (Length, Length))
-> [((Length, Length), [Token])] -> [(Length, Length)]
forall a b. (a -> b) -> [a] -> [b]
map ((Length, Length), [Token]) -> (Length, Length)
forall a b. (a, b) -> a
fst [((Length, Length), [Token])]
val }
    longhand _ self :: Backgrounds Text
self "background-repeat" t :: [Token]
t | val :: [(Bool, Bool)]
val@(_:_) <- ([Token] -> Maybe (Bool, Bool)) -> [Token] -> [(Bool, Bool)]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe (Bool, Bool)
inner [Token]
t =
        Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { bgRepeat :: [(Bool, Bool)]
bgRepeat = [(Bool, Bool)] -> [(Bool, Bool)]
forall a. [a] -> [a]
reverse [(Bool, Bool)]
val }
      where
        inner :: [Token] -> Maybe (Bool, Bool)
inner [Ident "initial"] = (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
True, Bool
True)
        inner [Ident "repeat-x"] = (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
True, Bool
False)
        inner [Ident "repeat-y"] = (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
True)
        inner [x :: Token
x] | Just y :: Bool
y <- Token -> Maybe Bool
inner' Token
x = (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
y, Bool
y)
        inner [x :: Token
x, y :: Token
y] | Just x' :: Bool
x' <- Token -> Maybe Bool
inner' Token
x, Just y' :: Bool
y' <- Token -> Maybe Bool
inner' Token
y = (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
x', Bool
y')
        inner _ = Maybe (Bool, Bool)
forall a. Maybe a
Nothing
        inner' :: Token -> Maybe Bool
inner' (Ident "repeat") = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        inner' (Ident "no-repeat") = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
        inner' _ = Maybe Bool
forall a. Maybe a
Nothing
    longhand _ self :: Backgrounds Text
self "background-size" t :: [Token]
t | val :: [Resize]
val@(_:_) <- ([Token] -> Maybe Resize) -> [Token] -> [Resize]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe Resize
inner [Token]
t =
        Backgrounds Text -> Maybe (Backgrounds Text)
forall a. a -> Maybe a
Just Backgrounds Text
self { bgSize :: [Resize]
bgSize = [Resize] -> [Resize]
forall a. [a] -> [a]
reverse [Resize]
val }
      where -- TODO: Add shorthand support, after background-position.
        inner :: [Token] -> Maybe Resize
inner [x :: Token
x, y :: Token
y] | Just a :: Length
a <- Token -> Maybe Length
l Token
x, Just b :: Length
b <- Token -> Maybe Length
l Token
y = Resize -> Maybe Resize
forall a. a -> Maybe a
Just (Resize -> Maybe Resize) -> Resize -> Maybe Resize
forall a b. (a -> b) -> a -> b
$ Length -> Length -> Resize
Size Length
a Length
b
        inner [Ident "contain"] = Resize -> Maybe Resize
forall a. a -> Maybe a
Just Resize
Contain
        inner [Ident "cover"] = Resize -> Maybe Resize
forall a. a -> Maybe a
Just Resize
Cover
        inner [Ident "auto"] = Resize -> Maybe Resize
forall a. a -> Maybe a
Just (Resize -> Maybe Resize) -> Resize -> Maybe Resize
forall a b. (a -> b) -> a -> b
$ Length -> Length -> Resize
Size Length
Auto Length
Auto
        inner [Ident "initial"] = Resize -> Maybe Resize
forall a. a -> Maybe a
Just (Resize -> Maybe Resize) -> Resize -> Maybe Resize
forall a b. (a -> b) -> a -> b
$ Length -> Length -> Resize
Size Length
Auto Length
Auto
        inner _ = Maybe Resize
forall a. Maybe a
Nothing
        -- NOTE: Leave lowering other units to CatTrap.
        l :: Token -> Maybe Length
l (Ident "auto") = Length -> Maybe Length
forall a. a -> Maybe a
Just Length
Auto
        l (Dimension _ x :: NumericValue
x "px") = Length -> Maybe Length
forall a. a -> Maybe a
Just (Length -> Maybe Length) -> Length -> Maybe Length
forall a b. (a -> b) -> a -> b
$ Float -> Length
Absolute (Float -> Length) -> Float -> Length
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x
        l (Percentage _ x :: NumericValue
x) = Length -> Maybe Length
forall a. a -> Maybe a
Just (Length -> Maybe Length) -> Length -> Maybe Length
forall a b. (a -> b) -> a -> b
$ Float -> Length
Scale (Float -> Length) -> Float -> Length
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
p NumericValue
x
        l _ = Maybe Length
forall a. Maybe a
Nothing
    longhand _ _ _ _ = Maybe (Backgrounds Text)
forall a. Maybe a
Nothing

    -- The multi-layered shorthand is one source of parsing complexity.
    shorthand :: Backgrounds Text -> Text -> [Token] -> Props
shorthand self :: Backgrounds Text
self "background" t :: [Token]
t = [Props] -> Props
forall a. (Eq a, IsString a) => [[(a, [Token])]] -> [(a, [Token])]
catProps ([Props] -> Props) -> [Props] -> Props
forall a b. (a -> b) -> a -> b
$ [Props] -> [Props]
forall a. [a] -> [a]
reverse ([Props] -> [Props]) -> [Props] -> [Props]
forall a b. (a -> b) -> a -> b
$ ([Token] -> Maybe Props) -> [Token] -> [Props]
forall a. ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList [Token] -> Maybe Props
inner [Token]
t
      where
        catProps :: [[(a, [Token])]] -> [(a, [Token])]
catProps [] = []
        catProps (props :: [(a, [Token])]
props:pss :: [[(a, [Token])]]
pss)
            | Just [Ident "initial"] <- "background-color" a -> [(a, [Token])] -> Maybe [Token]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [[(a, [Token])]] -> [(a, [Token])]
catProps [[(a, [Token])]]
pss =
                ((a, [Token]) -> (a, [Token])) -> [(a, [Token])] -> [(a, [Token])]
forall a b. (a -> b) -> [a] -> [b]
map ([(a, [Token])] -> (a, [Token]) -> (a, [Token])
forall a.
(Eq a, IsString a) =>
[(a, [Token])] -> (a, [Token]) -> (a, [Token])
catProp ([(a, [Token])] -> (a, [Token]) -> (a, [Token]))
-> [(a, [Token])] -> (a, [Token]) -> (a, [Token])
forall a b. (a -> b) -> a -> b
$ [[(a, [Token])]] -> [(a, [Token])]
catProps [[(a, [Token])]]
pss) [(a, [Token])]
props
            | Bool
otherwise = [] -- Only allow background-color in bottommost layer.
        catProp :: [(a, [Token])] -> (a, [Token]) -> (a, [Token])
catProp _ ret :: (a, [Token])
ret@("background-color", _) = (a, [Token])
ret
        catProp bases :: [(a, [Token])]
bases (key :: a
key, val :: [Token]
val)
            | Just base :: [Token]
base <- a
key a -> [(a, [Token])] -> Maybe [Token]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(a, [Token])]
bases = (a
key, [Token]
base [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Token
CommaToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
val)
            -- Shouldn't happen, `inner` expands all props at least to "initial"!
            | Bool
otherwise = (a
key, [Token]
val)
        inner :: [Token] -> Maybe Props
inner toks :: [Token]
toks | ret :: Props
ret@(_:_) <- Backgrounds Text -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Backgrounds Text
self [
                "background-color", "background-clip", "background-image",
                "background-origin", "background-position"
              ] [Token]
toks = Props -> Maybe Props
forall a. a -> Maybe a
Just Props
ret
          | Bool
otherwise = Maybe Props
forall a. Maybe a
Nothing
    shorthand self :: Backgrounds Text
self key :: Text
key val :: [Token]
val | Just _ <- Backgrounds Text
-> Backgrounds Text -> Text -> [Token] -> Maybe (Backgrounds Text)
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand Backgrounds Text
self Backgrounds Text
self Text
key [Token]
val = [(Text
key, [Token]
val)]
        | Bool
otherwise = []

box :: [Token] -> Maybe (Rects -> Rect)
box :: [Token] -> Maybe (Rects -> Rect)
box [Ident "content-box"] = (Rects -> Rect) -> Maybe (Rects -> Rect)
forall a. a -> Maybe a
Just Rects -> Rect
contentBox
box [Ident "padding-box"] = (Rects -> Rect) -> Maybe (Rects -> Rect)
forall a. a -> Maybe a
Just Rects -> Rect
paddingBox
box [Ident "border-box"] = (Rects -> Rect) -> Maybe (Rects -> Rect)
forall a. a -> Maybe a
Just Rects -> Rect
borderBox
box [Ident "initial"] = (Rects -> Rect) -> Maybe (Rects -> Rect)
forall a. a -> Maybe a
Just Rects -> Rect
borderBox -- To aid shorthand implementation.
box _ = Maybe (Rects -> Rect)
forall a. Maybe a
Nothing

position :: [Token] -> Maybe ((Length, Length), [Token])
position :: [Token] -> Maybe ((Length, Length), [Token])
position (x :: Token
x:y :: Token
y:ts :: [Token]
ts) = Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
position' Token
x Token
y [Token]
ts Maybe ((Length, Length), [Token])
-> Maybe ((Length, Length), [Token])
-> Maybe ((Length, Length), [Token])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
position' Token
y Token
x [Token]
ts Maybe ((Length, Length), [Token])
-> Maybe ((Length, Length), [Token])
-> Maybe ((Length, Length), [Token])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
position' Token
x Token
x (Token
yToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
ts)
position [x :: Token
x] = Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
position' Token
x Token
x []
position _ = Maybe ((Length, Length), [Token])
forall a. Maybe a
Nothing
position' :: Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
position' :: Token -> Token -> [Token] -> Maybe ((Length, Length), [Token])
position' x :: Token
x y :: Token
y ts :: [Token]
ts = case ((case Token
x of
        Ident "left" -> Float -> Length
Scale 0
        Ident "center" -> Float -> Length
Scale 0.5
        Ident "right" -> Float -> Length
Scale 1
        Percentage _ a :: NumericValue
a -> NumericValue -> Length
p' NumericValue
a
        Dimension _ a :: NumericValue
a "px" -> NumericValue -> Length
f' NumericValue
a
        _ -> Length
Auto,
    case Token
y of
        Ident "top" -> Float -> Length
Scale 0
        Ident "center" -> Float -> Length
Scale 0.5
        Ident "bottom" -> Float -> Length
Scale 1
        Percentage _ a :: NumericValue
a -> NumericValue -> Length
p' NumericValue
a
        Dimension _ a :: NumericValue
a "px" -> NumericValue -> Length
f' NumericValue
a
        _ -> Length
Auto),
    [Token]
ts) of
        ((Auto, _), _) -> Maybe ((Length, Length), [Token])
forall a. Maybe a
Nothing
        ((_, Auto), _) -> Maybe ((Length, Length), [Token])
forall a. Maybe a
Nothing
        ret :: ((Length, Length), [Token])
ret -> ((Length, Length), [Token]) -> Maybe ((Length, Length), [Token])
forall a. a -> Maybe a
Just ((Length, Length), [Token])
ret

colourStops :: ColourPallet
        -> [Token] -> Maybe [(AlphaColour Float, Length)]
colourStops :: ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops _ [RightParen] = [(C, Length)] -> Maybe [(C, Length)]
forall a. a -> Maybe a
Just []
colourStops cs :: ColourPallet
cs (Comma:toks :: [Token]
toks)
    | Just (Percentage _ x :: NumericValue
x:toks' :: [Token]
toks', c :: C
c) <- ColourPallet -> [Token] -> Maybe ([Token], C)
parseColour ColourPallet
cs [Token]
toks,
        Just ret :: [(C, Length)]
ret <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
cs [Token]
toks' = [(C, Length)] -> Maybe [(C, Length)]
forall a. a -> Maybe a
Just ([(C, Length)] -> Maybe [(C, Length)])
-> [(C, Length)] -> Maybe [(C, Length)]
forall a b. (a -> b) -> a -> b
$ (C
c, Float -> Length
Scale (Float -> Length) -> Float -> Length
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
p NumericValue
x)(C, Length) -> [(C, Length)] -> [(C, Length)]
forall a. a -> [a] -> [a]
:[(C, Length)]
ret
    | Just (Dimension _ x :: NumericValue
x "px":toks' :: [Token]
toks', c :: C
c) <- ColourPallet -> [Token] -> Maybe ([Token], C)
parseColour ColourPallet
cs [Token]
toks,
        Just ret :: [(C, Length)]
ret <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
cs [Token]
toks' = [(C, Length)] -> Maybe [(C, Length)]
forall a. a -> Maybe a
Just ([(C, Length)] -> Maybe [(C, Length)])
-> [(C, Length)] -> Maybe [(C, Length)]
forall a b. (a -> b) -> a -> b
$ (C
c, Float -> Length
Absolute (Float -> Length) -> Float -> Length
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x)(C, Length) -> [(C, Length)] -> [(C, Length)]
forall a. a -> [a] -> [a]
:[(C, Length)]
ret
    | Just (toks' :: [Token]
toks', c :: C
c) <- ColourPallet -> [Token] -> Maybe ([Token], C)
parseColour ColourPallet
cs [Token]
toks,
        Just ret :: [(C, Length)]
ret <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
cs [Token]
toks' = [(C, Length)] -> Maybe [(C, Length)]
forall a. a -> Maybe a
Just ([(C, Length)] -> Maybe [(C, Length)])
-> [(C, Length)] -> Maybe [(C, Length)]
forall a b. (a -> b) -> a -> b
$ (C
c, Length
Auto)(C, Length) -> [(C, Length)] -> [(C, Length)]
forall a. a -> [a] -> [a]
:[(C, Length)]
ret
colourStops cs :: ColourPallet
cs (Comma:Percentage _ x :: NumericValue
x:toks :: [Token]
toks)
    | Just (toks' :: [Token]
toks', c :: C
c) <- ColourPallet -> [Token] -> Maybe ([Token], C)
parseColour ColourPallet
cs [Token]
toks,
        Just ret :: [(C, Length)]
ret <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
cs [Token]
toks' = [(C, Length)] -> Maybe [(C, Length)]
forall a. a -> Maybe a
Just ([(C, Length)] -> Maybe [(C, Length)])
-> [(C, Length)] -> Maybe [(C, Length)]
forall a b. (a -> b) -> a -> b
$ (C
c, Float -> Length
Scale (Float -> Length) -> Float -> Length
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
p NumericValue
x)(C, Length) -> [(C, Length)] -> [(C, Length)]
forall a. a -> [a] -> [a]
:[(C, Length)]
ret
colourStops cs :: ColourPallet
cs (Comma:Dimension _ x :: NumericValue
x "px":toks :: [Token]
toks)
    | Just (toks' :: [Token]
toks', c :: C
c) <- ColourPallet -> [Token] -> Maybe ([Token], C)
parseColour ColourPallet
cs [Token]
toks,
        Just ret :: [(C, Length)]
ret <- ColourPallet -> [Token] -> Maybe [(C, Length)]
colourStops ColourPallet
cs [Token]
toks' = [(C, Length)] -> Maybe [(C, Length)]
forall a. a -> Maybe a
Just ([(C, Length)] -> Maybe [(C, Length)])
-> [(C, Length)] -> Maybe [(C, Length)]
forall a b. (a -> b) -> a -> b
$ (C
c, Float -> Length
Absolute (Float -> Length) -> Float -> Length
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
f NumericValue
x)(C, Length) -> [(C, Length)] -> [(C, Length)]
forall a. a -> [a] -> [a]
:[(C, Length)]
ret
colourStops _ _ = Maybe [(C, Length)]
forall a. Maybe a
Nothing

parseCSSList :: ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList :: ([Token] -> Maybe a) -> [Token] -> [a]
parseCSSList cb :: [Token] -> Maybe a
cb toks :: [Token]
toks | (Maybe a -> Bool) -> [Maybe a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe a -> Bool
forall a. Maybe a -> Bool
isJust [Maybe a]
ret = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
ret
    | Bool
otherwise = []
  where ret :: [Maybe a]
ret = ([Token] -> Maybe a) -> [[Token]] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map [Token] -> Maybe a
cb ([[Token]] -> [Maybe a]) -> [[Token]] -> [Maybe a]
forall a b. (a -> b) -> a -> b
$ ([[Token]] -> [Token]) -> [[[Token]]] -> [[Token]]
forall a b. (a -> b) -> [a] -> [b]
map [[Token]] -> [Token]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Token]]] -> [[Token]]) -> [[[Token]]] -> [[Token]]
forall a b. (a -> b) -> a -> b
$ [Token] -> [[Token]] -> [[[Token]]]
forall a. Eq a => a -> [a] -> [[a]]
splitList [Token
Comma] ([[Token]] -> [[[Token]]]) -> [[Token]] -> [[[Token]]]
forall a b. (a -> b) -> a -> b
$ [Token] -> [[Token]]
parseOperands [Token]
toks

f :: NumericValue -> Float
f :: NumericValue -> Float
f (NVInteger x :: Integer
x) = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x
f (NVNumber x :: Scientific
x) = Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x
p :: NumericValue -> Float
p :: NumericValue -> Float
p (NVInteger x :: Integer
x) = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 100
-- Do the division while we're in base-10!
p (NVNumber x :: Scientific
x) = Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat (Scientific
xScientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/Integer -> Int -> Scientific
scientific 1 2)
p' :: NumericValue -> Length
p' :: NumericValue -> Length
p' = Float -> Length
Scale (Float -> Length)
-> (NumericValue -> Float) -> NumericValue -> Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericValue -> Float
p
f' :: NumericValue -> Length
f' :: NumericValue -> Length
f' = Float -> Length
Absolute (Float -> Length)
-> (NumericValue -> Float) -> NumericValue -> Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericValue -> Float
f

------
--- Utils taken from HappStack
------

-- | Repeadly splits a list by the provided separator and collects the results
splitList :: Eq a => a -> [a] -> [[a]]
splitList :: a -> [a] -> [[a]]
splitList _   [] = []
splitList sep :: a
sep list :: [a]
list = [a]
h[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
splitList a
sep [a]
t
        where (h :: [a]
h,t :: [a]
t)=(a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
split (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
sep) [a]
list

-- | Split is like break, but the matching element is dropped.
split :: (a -> Bool) -> [a] -> ([a], [a])
split :: (a -> Bool) -> [a] -> ([a], [a])
split filt :: a -> Bool
filt s :: [a]
s = ([a]
x,[a]
y)
        where
        (x :: [a]
x,y' :: [a]
y')=(a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
filt [a]
s
        y :: [a]
y = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
y' then [] else [a] -> [a]
forall a. [a] -> [a]
tail [a]
y'

------
--- Dynamically-computed properties
------

resolveSize :: (Float, Float) -> (Float, Float) -> Resize -> (Float, Float)
resolveSize :: (Float, Float) -> (Float, Float) -> Resize -> (Float, Float)
resolveSize (owidth :: Float
owidth, oheight :: Float
oheight) (width :: Float
width, height :: Float
height) Contain
    | Float
width Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
owidth, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
oheight, Float
height Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
width = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
    | Float
width Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
owidth = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw)
    | Float
height Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
oheight = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
    | Float
height Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
width = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw)
    | Bool
otherwise = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
  where
    sh :: Float
sh = Float
oheightFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
height
    sw :: Float
sw = Float
owidthFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
width
resolveSize (owidth :: Float
owidth, oheight :: Float
oheight) (width :: Float
width, height :: Float
height) Cover
    | Float
owidth Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
width, Float
oheight Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
    | Float
oheight Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
height, Float
owidth Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw)
    | Float
owidth Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
width = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw)
    | Float
oheight Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
height = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
    | Float
oheight Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
    | Float
owidth Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw)
    | Float
height Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
width = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sw)
    | Bool
otherwise = (Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh, Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
sh)
  where
    sh :: Float
sh = Float
oheightFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
height
    sw :: Float
sw = Float
owidthFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
width
resolveSize _ ret :: (Float, Float)
ret (Size Auto Auto) = (Float, Float)
ret
resolveSize _ (width :: Float
width, height :: Float
height) (Size x :: Length
x y :: Length
y) = (Float
x', Float
y')
  where
    x' :: Float
x' | Absolute ret :: Float
ret <- Length
x = Float
ret
        | Scale s :: Float
s <- Length
x = Float
widthFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
s
        | Length
Auto <- Length
x = Float
y' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
widthFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
height
    y' :: Float
y' | Absolute ret :: Float
ret <- Length
y = Float
ret
        | Scale s :: Float
s <- Length
y = Float
heightFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
s
    -- NOTE: If Auto,Auto case wasn't handled above this'd be an infinite loop.
        | Length
Auto <- Length
y = Float
x' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
heightFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
width