{-# LANGUAGE OverloadedStrings #-}
module Graphics.Rendering.Rect.CSS.Border(Border(..), BorderStyle(..),
    topColour, rightColour, bottomColour, leftColour) where

import Stylist (PropertyParser(..), parseUnorderedShorthand, parseOperands)
import Data.CSS.Syntax.Tokens (Token(..))
import Graphics.Rendering.Rect.CSS.Colour (ColourPallet(foreground), parseColour)
import Data.Colour (AlphaColour)
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)

data Border = Border {
    Border -> ColourPallet
borderPallet :: ColourPallet,
    Border -> BorderStyle
topStyle :: BorderStyle,
    Border -> Maybe (AlphaColour Float)
topColour' :: Maybe (AlphaColour Float),
    Border -> BorderStyle
rightStyle :: BorderStyle,
    Border -> Maybe (AlphaColour Float)
rightColour' :: Maybe (AlphaColour Float),
    Border -> BorderStyle
bottomStyle :: BorderStyle,
    Border -> Maybe (AlphaColour Float)
bottomColour' :: Maybe (AlphaColour Float),
    Border -> BorderStyle
leftStyle :: BorderStyle,
    Border -> Maybe (AlphaColour Float)
leftColour' :: Maybe (AlphaColour Float)
} deriving (Border -> Border -> Bool
(Border -> Border -> Bool)
-> (Border -> Border -> Bool) -> Eq Border
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Border -> Border -> Bool
$c/= :: Border -> Border -> Bool
== :: Border -> Border -> Bool
$c== :: Border -> Border -> Bool
Eq, Int -> Border -> ShowS
[Border] -> ShowS
Border -> String
(Int -> Border -> ShowS)
-> (Border -> String) -> ([Border] -> ShowS) -> Show Border
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Border] -> ShowS
$cshowList :: [Border] -> ShowS
show :: Border -> String
$cshow :: Border -> String
showsPrec :: Int -> Border -> ShowS
$cshowsPrec :: Int -> Border -> ShowS
Show, ReadPrec [Border]
ReadPrec Border
Int -> ReadS Border
ReadS [Border]
(Int -> ReadS Border)
-> ReadS [Border]
-> ReadPrec Border
-> ReadPrec [Border]
-> Read Border
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Border]
$creadListPrec :: ReadPrec [Border]
readPrec :: ReadPrec Border
$creadPrec :: ReadPrec Border
readList :: ReadS [Border]
$creadList :: ReadS [Border]
readsPrec :: Int -> ReadS Border
$creadsPrec :: Int -> ReadS Border
Read)

resolveColour :: Border -> Maybe (AlphaColour Float) -> AlphaColour Float
resolveColour :: Border -> Maybe (AlphaColour Float) -> AlphaColour Float
resolveColour self :: Border
self = AlphaColour Float -> Maybe (AlphaColour Float) -> AlphaColour Float
forall a. a -> Maybe a -> a
fromMaybe (AlphaColour Float
 -> Maybe (AlphaColour Float) -> AlphaColour Float)
-> AlphaColour Float
-> Maybe (AlphaColour Float)
-> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ ColourPallet -> AlphaColour Float
foreground (ColourPallet -> AlphaColour Float)
-> ColourPallet -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Border -> ColourPallet
borderPallet Border
self
topColour, rightColour, bottomColour, leftColour :: Border -> AlphaColour Float
topColour :: Border -> AlphaColour Float
topColour self :: Border
self = Border -> Maybe (AlphaColour Float) -> AlphaColour Float
resolveColour Border
self (Maybe (AlphaColour Float) -> AlphaColour Float)
-> Maybe (AlphaColour Float) -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Border -> Maybe (AlphaColour Float)
topColour' Border
self
rightColour :: Border -> AlphaColour Float
rightColour self :: Border
self = Border -> Maybe (AlphaColour Float) -> AlphaColour Float
resolveColour Border
self (Maybe (AlphaColour Float) -> AlphaColour Float)
-> Maybe (AlphaColour Float) -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Border -> Maybe (AlphaColour Float)
rightColour' Border
self
bottomColour :: Border -> AlphaColour Float
bottomColour self :: Border
self = Border -> Maybe (AlphaColour Float) -> AlphaColour Float
resolveColour Border
self (Maybe (AlphaColour Float) -> AlphaColour Float)
-> Maybe (AlphaColour Float) -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Border -> Maybe (AlphaColour Float)
bottomColour' Border
self
leftColour :: Border -> AlphaColour Float
leftColour self :: Border
self = Border -> Maybe (AlphaColour Float) -> AlphaColour Float
resolveColour Border
self (Maybe (AlphaColour Float) -> AlphaColour Float)
-> Maybe (AlphaColour Float) -> AlphaColour Float
forall a b. (a -> b) -> a -> b
$ Border -> Maybe (AlphaColour Float)
leftColour' Border
self

data BorderStyle = NoBorder | Solid | Dashed | Dotted | Double
    | Groove | Ridge | Inset | Outset deriving (BorderStyle -> BorderStyle -> Bool
(BorderStyle -> BorderStyle -> Bool)
-> (BorderStyle -> BorderStyle -> Bool) -> Eq BorderStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BorderStyle -> BorderStyle -> Bool
$c/= :: BorderStyle -> BorderStyle -> Bool
== :: BorderStyle -> BorderStyle -> Bool
$c== :: BorderStyle -> BorderStyle -> Bool
Eq, Int -> BorderStyle -> ShowS
[BorderStyle] -> ShowS
BorderStyle -> String
(Int -> BorderStyle -> ShowS)
-> (BorderStyle -> String)
-> ([BorderStyle] -> ShowS)
-> Show BorderStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BorderStyle] -> ShowS
$cshowList :: [BorderStyle] -> ShowS
show :: BorderStyle -> String
$cshow :: BorderStyle -> String
showsPrec :: Int -> BorderStyle -> ShowS
$cshowsPrec :: Int -> BorderStyle -> ShowS
Show, ReadPrec [BorderStyle]
ReadPrec BorderStyle
Int -> ReadS BorderStyle
ReadS [BorderStyle]
(Int -> ReadS BorderStyle)
-> ReadS [BorderStyle]
-> ReadPrec BorderStyle
-> ReadPrec [BorderStyle]
-> Read BorderStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BorderStyle]
$creadListPrec :: ReadPrec [BorderStyle]
readPrec :: ReadPrec BorderStyle
$creadPrec :: ReadPrec BorderStyle
readList :: ReadS [BorderStyle]
$creadList :: ReadS [BorderStyle]
readsPrec :: Int -> ReadS BorderStyle
$creadsPrec :: Int -> ReadS BorderStyle
Read, Int -> BorderStyle
BorderStyle -> Int
BorderStyle -> [BorderStyle]
BorderStyle -> BorderStyle
BorderStyle -> BorderStyle -> [BorderStyle]
BorderStyle -> BorderStyle -> BorderStyle -> [BorderStyle]
(BorderStyle -> BorderStyle)
-> (BorderStyle -> BorderStyle)
-> (Int -> BorderStyle)
-> (BorderStyle -> Int)
-> (BorderStyle -> [BorderStyle])
-> (BorderStyle -> BorderStyle -> [BorderStyle])
-> (BorderStyle -> BorderStyle -> [BorderStyle])
-> (BorderStyle -> BorderStyle -> BorderStyle -> [BorderStyle])
-> Enum BorderStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BorderStyle -> BorderStyle -> BorderStyle -> [BorderStyle]
$cenumFromThenTo :: BorderStyle -> BorderStyle -> BorderStyle -> [BorderStyle]
enumFromTo :: BorderStyle -> BorderStyle -> [BorderStyle]
$cenumFromTo :: BorderStyle -> BorderStyle -> [BorderStyle]
enumFromThen :: BorderStyle -> BorderStyle -> [BorderStyle]
$cenumFromThen :: BorderStyle -> BorderStyle -> [BorderStyle]
enumFrom :: BorderStyle -> [BorderStyle]
$cenumFrom :: BorderStyle -> [BorderStyle]
fromEnum :: BorderStyle -> Int
$cfromEnum :: BorderStyle -> Int
toEnum :: Int -> BorderStyle
$ctoEnum :: Int -> BorderStyle
pred :: BorderStyle -> BorderStyle
$cpred :: BorderStyle -> BorderStyle
succ :: BorderStyle -> BorderStyle
$csucc :: BorderStyle -> BorderStyle
Enum)

style :: Token -> Maybe BorderStyle
style :: Token -> Maybe BorderStyle
style (Ident "initial") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
NoBorder
style (Ident "none") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
NoBorder
style (Ident "hidden") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
NoBorder
style (Ident "solid") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Solid
style (Ident "dashed") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Dashed
style (Ident "dotted") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Dotted
style (Ident "double") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Double
style (Ident "groove") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Groove
style (Ident "ridge") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Ridge
style (Ident "inset") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Inset
style (Ident "outset") = BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
Outset
style _ = Maybe BorderStyle
forall a. Maybe a
Nothing

instance PropertyParser Border where
    temp :: Border
temp = Border :: ColourPallet
-> BorderStyle
-> Maybe (AlphaColour Float)
-> BorderStyle
-> Maybe (AlphaColour Float)
-> BorderStyle
-> Maybe (AlphaColour Float)
-> BorderStyle
-> Maybe (AlphaColour Float)
-> Border
Border {
        borderPallet :: ColourPallet
borderPallet = ColourPallet
forall a. PropertyParser a => a
temp,
        topStyle :: BorderStyle
topStyle = BorderStyle
NoBorder,
        topColour' :: Maybe (AlphaColour Float)
topColour' = Maybe (AlphaColour Float)
forall a. Maybe a
Nothing,
        rightStyle :: BorderStyle
rightStyle = BorderStyle
NoBorder,
        rightColour' :: Maybe (AlphaColour Float)
rightColour' = Maybe (AlphaColour Float)
forall a. Maybe a
Nothing,
        bottomStyle :: BorderStyle
bottomStyle = BorderStyle
NoBorder,
        bottomColour' :: Maybe (AlphaColour Float)
bottomColour' = Maybe (AlphaColour Float)
forall a. Maybe a
Nothing,
        leftStyle :: BorderStyle
leftStyle = BorderStyle
NoBorder,
        leftColour' :: Maybe (AlphaColour Float)
leftColour' = Maybe (AlphaColour Float)
forall a. Maybe a
Nothing
      }
    inherit :: Border -> Border
inherit = Border -> Border -> Border
forall a b. a -> b -> a
const Border
forall a. PropertyParser a => a
temp
    priority :: Border -> [Text]
priority = [Text] -> Border -> [Text]
forall a b. a -> b -> a
const []

    longhand :: Border -> Border -> Text -> [Token] -> Maybe Border
longhand _ s :: Border
s "border-top-style" [t :: Token
t] | Just v :: BorderStyle
v <- Token -> Maybe BorderStyle
style Token
t = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
s {topStyle :: BorderStyle
topStyle=BorderStyle
v}
    longhand _ s :: Border
s "border-right-style" [t :: Token
t] | Just v :: BorderStyle
v<-Token -> Maybe BorderStyle
style Token
t=Border -> Maybe Border
forall a. a -> Maybe a
Just Border
s {rightStyle :: BorderStyle
rightStyle=BorderStyle
v}
    longhand _ s :: Border
s "border-bottom-style" [t :: Token
t]|Just v :: BorderStyle
v<-Token -> Maybe BorderStyle
style Token
t=Border -> Maybe Border
forall a. a -> Maybe a
Just Border
s {bottomStyle :: BorderStyle
bottomStyle=BorderStyle
v}
    longhand _ s :: Border
s "border-left-style" [t :: Token
t] | Just v :: BorderStyle
v<-Token -> Maybe BorderStyle
style Token
t = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
s {leftStyle :: BorderStyle
leftStyle=BorderStyle
v}
    longhand _ self :: Border
self@Border { borderPallet :: Border -> ColourPallet
borderPallet = ColourPallet
cc } "border-top-color" ts :: [Token]
ts
        | Just ([], v :: AlphaColour Float
v) <- ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour ColourPallet
cc [Token]
ts = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self { topColour' :: Maybe (AlphaColour Float)
topColour' = AlphaColour Float -> Maybe (AlphaColour Float)
forall a. a -> Maybe a
Just AlphaColour Float
v }
    longhand _ self :: Border
self@Border { borderPallet :: Border -> ColourPallet
borderPallet = ColourPallet
cc } "border-right-color" ts :: [Token]
ts
        | Just ([], v :: AlphaColour Float
v) <- ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour ColourPallet
cc [Token]
ts = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self { rightColour' :: Maybe (AlphaColour Float)
rightColour' = AlphaColour Float -> Maybe (AlphaColour Float)
forall a. a -> Maybe a
Just AlphaColour Float
v }
    longhand _ self :: Border
self@Border { borderPallet :: Border -> ColourPallet
borderPallet = ColourPallet
cc } "border-bottom-color" ts :: [Token]
ts
        | Just ([], v :: AlphaColour Float
v) <- ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour ColourPallet
cc [Token]
ts = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self { bottomColour' :: Maybe (AlphaColour Float)
bottomColour' = AlphaColour Float -> Maybe (AlphaColour Float)
forall a. a -> Maybe a
Just AlphaColour Float
v }
    longhand _ self :: Border
self@Border { borderPallet :: Border -> ColourPallet
borderPallet = ColourPallet
cc } "border-left-color" ts :: [Token]
ts
        | Just ([], v :: AlphaColour Float
v) <- ColourPallet -> [Token] -> Maybe ([Token], AlphaColour Float)
parseColour ColourPallet
cc [Token]
ts = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self { leftColour' :: Maybe (AlphaColour Float)
leftColour' = AlphaColour Float -> Maybe (AlphaColour Float)
forall a. a -> Maybe a
Just AlphaColour Float
v }

    -- Should be handled by caller, but for the sake of shorthands...
    longhand _ self :: Border
self "border-top-width" [Dimension _ _ "px"] = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self
    longhand _ self :: Border
self "border-right-width" [Dimension _ _ "px"] = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self
    longhand _ self :: Border
self "border-bottom-width" [Dimension _ _ "px"] = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self
    longhand _ self :: Border
self "border-left-width" [Dimension _ _ "px"] = Border -> Maybe Border
forall a. a -> Maybe a
Just Border
self
    longhand _ _ _ _ = Maybe Border
forall a. Maybe a
Nothing

    shorthand :: Border -> Text -> [Token] -> Props
shorthand self :: Border
self "border-width" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 4, (top :: [Token]
top:right :: [Token]
right:bottom :: [Token]
bottom:left :: [Token]
left:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-top-width") [[Token]]
x =
                [("border-top-width", [Token]
top), ("border-right-width", [Token]
right),
                 ("border-bottom-width", [Token]
bottom), ("border-left-width", [Token]
left)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    -- Define other border shorthands here to properly handle border-widths
    shorthand self :: Border
self "border" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-color", "border-style", "border-width"] [Token]
toks
    shorthand self :: Border
self "border-top" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-top-color", "border-top-style", "border-top-width"] [Token]
toks
    shorthand self :: Border
self "border-right" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-right-color", "border-right-style", "border-right-width"] [Token]
toks
    shorthand self :: Border
self "border-bottom" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-bottom-color", "border-bottom-style", "border-bottom-width"] [Token]
toks
    shorthand self :: Border
self "border-left" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-left-color", "border-left-style", "border-left-width"] [Token]
toks
    shorthand self :: Border
self "border-inline" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-inline-color", "border-inline-style", "border-inline-width"] [Token]
toks
    shorthand self :: Border
self "border-inline-start" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-inline-start-color", "border-inline-start-style",
        "border-inline-start-width"] [Token]
toks
    shorthand self :: Border
self "border-inline-end" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-inline-end-color", "border-inline-end-style",
        "border-inline-end-width"] [Token]
toks
    shorthand self :: Border
self "border-block" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-block-color", "border-block-style", "border-block-width"] [Token]
toks
    shorthand self :: Border
self "border-block-start" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-block-start-color", "border-block-start-style",
        "border-block-start-width"] [Token]
toks
    shorthand self :: Border
self "border-block-end" toks :: [Token]
toks = Border -> [Text] -> [Token] -> Props
forall a. PropertyParser a => a -> [Text] -> [Token] -> Props
parseUnorderedShorthand Border
self [
        "border-block-end-color", "border-block-end-style",
        "border-block-end-width"] [Token]
toks
    shorthand self :: Border
self "border-color" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 4, (top :: [Token]
top:right :: [Token]
right:bottom :: [Token]
bottom:left :: [Token]
left:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-top-color") [[Token]]
x =
                [("border-top-color", [Token]
top), ("border-right-color", [Token]
right),
                 ("border-bottom-color", [Token]
bottom), ("border-left-color", [Token]
left)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-style" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 4, (top :: [Token]
top:right :: [Token]
right:bottom :: [Token]
bottom:left :: [Token]
left:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-top-style") [[Token]]
x =
                [("border-top-style", [Token]
top), ("border-right-style", [Token]
right),
                 ("border-bottom-style", [Token]
bottom), ("border-left-style", [Token]
left)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-width" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 4, (top :: [Token]
top:right :: [Token]
right:bottom :: [Token]
bottom:left :: [Token]
left:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-top-width") [[Token]]
x =
                [("border-top-width", [Token]
top), ("border-right-width", [Token]
right),
                 ("border-bottom-width", [Token]
bottom), ("border-left-width", [Token]
left)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-inline-color" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2, (s :: [Token]
s:e :: [Token]
e:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-inline-start-color") [[Token]]
x =
                [("border-inline-start-color", [Token]
s), ("border-inline-end-color", [Token]
e)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-inline-style" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2, (s :: [Token]
s:e :: [Token]
e:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-inline-start-style") [[Token]]
x =
                [("border-inline-start-style", [Token]
s), ("border-inline-end-style", [Token]
e)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-inline-width" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2, (s :: [Token]
s:e :: [Token]
e:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-inline-start-width") [[Token]]
x =
                [("border-inline-start-width", [Token]
s), ("border-inline-end-style", [Token]
e)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-block-color" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2, (s :: [Token]
s:e :: [Token]
e:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-block-start-color") [[Token]]
x =
                [("border-block-start-color", [Token]
s), ("border-block-end-color", [Token]
e)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-block-style" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2, (s :: [Token]
s:e :: [Token]
e:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-block-start-style") [[Token]]
x =
                [("border-block-start-style", [Token]
s), ("border-block-end-style", [Token]
e)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self "border-block-width" toks :: [Token]
toks
        | [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& [[Token]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token]]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2, (s :: [Token]
s:e :: [Token]
e:_) <- [[Token]] -> [[Token]]
forall a. [a] -> [a]
cycle [[Token]]
x,
            ([Token] -> Bool) -> [[Token]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Border -> Text -> [Token] -> Bool
forall a. PropertyParser a => a -> Text -> [Token] -> Bool
validProp Border
self "border-block-start-width") [[Token]]
x =
                [("border-block-start-width", [Token]
s), ("border-block-end-width", [Token]
e)]
      where x :: [[Token]]
x = [Token] -> [[Token]]
parseOperands [Token]
toks
    shorthand self :: Border
self k :: Text
k v :: [Token]
v | Just _ <- Border -> Border -> Text -> [Token] -> Maybe Border
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand Border
self Border
self Text
k [Token]
v = [(Text
k, [Token]
v)]
        | Bool
otherwise = []

validProp :: PropertyParser a => a -> Text -> [Token] -> Bool
validProp :: a -> Text -> [Token] -> Bool
validProp self :: a
self key :: Text
key value :: [Token]
value = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a -> Text -> [Token] -> Maybe a
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand a
self a
self Text
key [Token]
value