{-# 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)
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
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
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
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
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 = []
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)
| 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
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
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
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 :: (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'
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
| 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