hasmin-1.0.3: src/Hasmin/Parser/Value.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : Hasmin.Parser.Value
-- Copyright : (c) 2017 Cristian Adrián Ontivero
-- License : BSD3
-- Stability : experimental
-- Portability : unknown
--
-- Parsers for CSS values.
--
-----------------------------------------------------------------------------
module Hasmin.Parser.Value
( valuesFor
, valuesFallback
, value
, valuesInParens
, stringOrUrl
, percentage
, url
, stringtype
, stringvalue -- used in StringSpec
, shadowList -- used in ShadowSpec
, timingFunction
, repeatStyle
, position
, color
, number
, fontStyle
, textualvalue
, borderRadius
) where
import Control.Applicative ((<|>), many, optional)
import Control.Arrow (first)
import Control.Monad (mzero)
import Data.Functor (($>))
import Data.Monoid ((<>))
import Data.Maybe (fromMaybe, isNothing)
import Data.Text (Text)
import Data.Char (isAscii)
import Text.Parser.Permutation ((<|?>), (<$$>), (<$?>), (<||>), permute)
import qualified Data.Set as Set
import Data.Attoparsec.Text (asciiCI, char, option, Parser, skipSpace, string)
import qualified Data.Attoparsec.Text as A
import qualified Data.Char as C
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.List as L
import qualified Data.Text as T
import Hasmin.Parser.BasicShape
import Hasmin.Parser.BorderRadius
import Hasmin.Parser.Color
import Hasmin.Parser.Dimension
import Hasmin.Parser.Gradient
import Hasmin.Parser.Numeric
import Hasmin.Parser.PercentageLength
import Hasmin.Parser.Position
import Hasmin.Parser.String
import Hasmin.Parser.TimingFunction
import Hasmin.Parser.TransformFunction
import Hasmin.Parser.Utils
import Hasmin.Types.BgSize
import Hasmin.Types.Dimension
import Hasmin.Types.FilterFunction
import Hasmin.Types.Numeric
import Hasmin.Types.Position
import Hasmin.Types.RepeatStyle
import Hasmin.Types.Shadow
import Hasmin.Types.String
import Hasmin.Types.TransformFunction
import Hasmin.Types.Value
import Hasmin.Utils
-- | Given a propery name, it returns a specific parser of values for that
-- property. Fails if no specific parser is found.
valuesFor :: Text -> Parser Values
valuesFor propName = maybe mzero (<* skipComments) parser
where parser = Map.lookup (T.toLower propName) propertyValueParsersMap
-- A map relating dimension units and the percentage symbol,
-- to functions that construct that value. Meant to unify all the numerical
-- parsing in a single parse for generality without losing much efficiency.
-- See numericalvalue.
numericalConstructorsMap :: Map Text (Number -> Value)
numericalConstructorsMap = Map.fromList $ fmap (first T.toCaseFold) l
where frequencyFunc u v = FrequencyV (Frequency v u)
resolutionFunc u v = ResolutionV (Resolution v u)
l = [("hz", frequencyFunc Hz)
,("khz", frequencyFunc Khz)
,("dpi", resolutionFunc Dpi)
,("dpcm", resolutionFunc Dpcm)
,("dppx", resolutionFunc Dppx)
,("%", \x -> PercentageV (Percentage $ toRational x))
] ++ (fmap . fmap) (TimeV .) timeConstructorsList
++ (fmap . fmap) (AngleV .) angleConstructorsList
++ (fmap . fmap) (LengthV .) distanceConstructorsList
-- Unified numerical parser.
-- Parses <number>, dimensions (i.e. <length>, <angle>, ...), and <percentage>
numericalvalue :: Parser Value
numericalvalue = do
n <- number
rest <- opt (string "%" <|> A.takeWhile1 C.isAlpha)
if T.null rest -- if true, then it was just a <number> value
then pure $ NumberV n
else case Map.lookup (T.toCaseFold rest) numericalConstructorsMap of
Just f -> pure $ f n
Nothing -> mzero -- TODO see if we should return an "Other" value
hexvalue :: Parser Value
hexvalue = ColorV <$> hex
-- | Parser for <https://drafts.csswg.org/css-fonts-3/#propdef-font-style \<font-style\>>,
-- used in the @font-style@ and @font@ properties.
fontStyle :: Parser Value
fontStyle = Other <$> matchKeywords ["normal", "italic", "oblique"]
{-
fontWeight :: Parser Value
fontWeight = do
k <- ident
if Set.member k keywords
then pure $ mkOther k
else mzero
where keywords = Set.fromList ["normal", "bold", "lighter", "bolder"]
validNumbers = Set.fromList [100, 200, 300, 400, 500, 600, 700, 800, 900]
-}
fontSize :: Parser Value
fontSize = fontSizeKeyword
<|> (LengthV <$> distance)
<|> (PercentageV <$> percentage)
where fontSizeKeyword = Other <$> matchKeywords
["large", "xx-small", "x-small", "small", "medium",
"x-large", "xx-large", "smaller" , "larger"]
{- [ [ <‘font-style’> || <font-variant-css21> || <‘font-weight’> ||
- <‘font-stretch’> ]? <‘font-size’> [ / <‘line-height’> ]? <‘font-family’> ] |
- caption | icon | menu | message-box | small-caption | status-bar
where <font-variant-css21> = [normal | small-caps]
-}
positionvalue :: Parser Value
positionvalue = PositionV <$> position
{-
transformOrigin :: Parser Values
transformOrigin = twoVal <|> oneVal
where oneVal = (singleValue numericalvalue) <|> offsetKeyword
offsetKeyword = do
v1 <- ident
if v1 == "top" || v1 == "right" || v1 == "bottom" || v1 == "left" || v1 == "center"
then pure $ mkValues [mkOther v1]
else mzero
twoVal = do
(v1, v2) <- ((,) <$> yAxis <*> (skipComments *> (xAxis <|> numericalvalue)))
<|> ((,) <$> xAxis <*> (skipComments *> (yAxis <|> numericalvalue)))
<|> ((,) <$> numericalvalue <*> (skipComments *> (yAxis <|> xAxis)))
option (mkValues [v1,v2]) ((\x -> mkValues [v1,v2, LengthV x]) <$> distance)
yAxis = do
v1 <- ident
if v1 == "top" || v1 == "bottom" || v1 == "center"
then pure $ mkOther v1
else mzero
xAxis = do
v1 <- ident
if v1 == "right" || v1 == "left" || v1 == "center"
then pure $ mkOther v1
else mzero
-}
bgSize :: Parser BgSize
bgSize = twovaluesyntax <|> containOrCover
where containOrCover = parserFromPairs [("cover", pure Cover)
,("contain", pure Contain)]
twovaluesyntax = do
x <- bgsizeValue <* skipComments
(BgSize2 x <$> bgsizeValue) <|> pure (BgSize1 x)
bgsizeValue = (Left <$> percentageLength) <|> (Right <$> auto)
bgAttachment :: Parser TextV
bgAttachment = matchKeywords ["scroll", "fixed", "local"]
box :: Parser TextV
box = matchKeywords ["border-box", "padding-box", "content-box"]
-- [ <bg-layer> , ]* <final-bg-layer>
background :: Parser Values
background = do
xs <- many (bgLayer <* char ',' <* skipComments)
x <- finalBgLayer
pure $ if null xs
then Values x []
else Values (head xs) (fmap (Comma,) $ tail xs ++ [x])
-- <final-bg-layer> = <bg-image> || <position> [ / <bg-size> ]? || <repeat-style> || <attachment> || <box> || <box> || <'background-color'>
finalBgLayer :: Parser Value
finalBgLayer = do
layer <- permute (mkFinalBgLayer <$?> (Nothing, Just <$> image <* skipComments)
<|?> (Nothing, Just <$> positionAndBgSize <* skipComments)
<|?> (Nothing, Just <$> repeatStyle <* skipComments)
<|?> (Nothing, Just <$> bgAttachment <* skipComments)
<|?> (Nothing, Just <$> box <* skipComments)
<|?> (Nothing, Just <$> box <* skipComments)
<|?> (Nothing, Just <$> color <* skipComments))
if finalBgLayerIsEmpty layer
then mzero
else pure layer
where finalBgLayerIsEmpty (FinalBgLayer Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing) = True
finalBgLayerIsEmpty _ = False
-- parameters e and f are being swapped to deal with the permutation
-- changing the original order of the parsed values.
mkFinalBgLayer a Nothing c d e f g = FinalBgLayer a Nothing Nothing c d f e g
mkFinalBgLayer a (Just (p,s)) c d e f g = FinalBgLayer a (Just p) s c d f e g
-- <bg-layer> = <bg-image> || <position> [ / <bg-size> ]? || <repeat-style> || <attachment> || <box>{1,2}
bgLayer :: Parser Value
bgLayer = do
layer <- permute (mkBgLayer <$?> (Nothing, Just <$> image <* skipComments)
<|?> (Nothing, Just <$> positionAndBgSize <* skipComments)
<|?> (Nothing, Just <$> repeatStyle <* skipComments)
<|?> (Nothing, Just <$> bgAttachment <* skipComments)
<|?> (Nothing, Just <$> box2 <* skipComments))
if bgLayerIsEmpty layer
then mzero
else pure layer
where bgLayerIsEmpty (BgLayer Nothing Nothing Nothing Nothing Nothing Nothing Nothing) = True
bgLayerIsEmpty _ = False
mkBgLayer a Nothing c d Nothing = BgLayer a Nothing Nothing c d Nothing Nothing
mkBgLayer a (Just (p,s)) c d Nothing = BgLayer a (Just p) s c d Nothing Nothing
mkBgLayer a Nothing c d (Just (i,j)) = BgLayer a Nothing Nothing c d (Just i) j
mkBgLayer a (Just (p,s)) c d (Just (i,j)) = BgLayer a (Just p) s c d (Just i) j
box2 :: Parser (TextV, Maybe TextV)
box2 = do
x <- box <* skipComments
y <- optional box
pure (x,y)
-- used for the background property, which takes among other things:
-- <position> [ / <bg-size> ]?
positionAndBgSize :: Parser (Position, Maybe BgSize)
positionAndBgSize = mzip position (optional (slash *> bgSize))
matchKeywords :: [Text] -> Parser TextV
matchKeywords listOfKeywords = do
i <- ident
if T.toCaseFold i `elem` Set.fromList listOfKeywords
then pure $ TextV i
else mzero
-- <image> = <url> | <image()> | <image-set()> | <element()> | <cross-fade()> | <gradient>
image :: Parser Value
image = do
i <- ident
let lowercased = T.toLower i
if lowercased == "none"
then pure $ mkOther "none"
else do _ <- char '('
if Set.member lowercased possibilities
then fromMaybe mzero (Map.lookup lowercased functionsMap)
else mzero
where possibilities = Set.fromList
["url", "element", "linear-gradient", "radial-gradient"]
transition :: Parser Values
transition = parseCommaSeparated singleTransition
-- [ none | <single-transition-property> ] || <time> || <single-transition-timing-function> || <time>
singleTransition :: Parser Value
singleTransition = do
st <- permute (mkSingleTransition <$?> (Nothing, Just <$> singleTransitionProperty <* skipComments)
<|?> (Nothing, Just <$> time <* skipComments)
<|?> (Nothing, Just <$> timingFunction <* skipComments)
<|?> (Nothing, Just <$> time <* skipComments))
if singleTransitionIsEmpty st
then mzero
else pure st
where singleTransitionIsEmpty (SingleTransition Nothing Nothing Nothing Nothing) = True
singleTransitionIsEmpty _ = False
-- Needed because permute is swapping the order of the time parameters.
mkSingleTransition a b c d = SingleTransition a d c b
singleTransitionProperty = do
i <- ident
let lowercased = T.toLower i
if lowercased `Set.member` excludedKeywords
then mzero
else pure $ TextV i
excludedKeywords = Set.fromList ["initial", "inherit", "unset", "default", "none"]
backgroundSize :: Parser Values
backgroundSize = parseCommaSeparated (BgSizeV <$> bgSize)
auto :: Parser Auto
auto = asciiCI "auto" $> Auto
propertyValueParsersMap :: Map Text (Parser Values)
propertyValueParsersMap = Map.fromList
[--("color", (:[]) <$> colorvalue)
("display", singleValue textualvalue)
,("font", singleValue font)
,("font-size", singleValue fontSize)
,("font-style", singleValue fontStyle)
,("font-weight", singleValue numberOrText)
,("font-family", fontFamilyValues)
,("background", background)
,("background-repeat", parseCommaSeparated (RepeatStyleV <$> repeatStyle))
,("background-size", backgroundSize)
,("border-radius", singleValue (BorderRadiusV <$> borderRadius))
,("box-shadow", shadowList)
,("-o-box-shadow", shadowList)
,("-moz-box-shadow", shadowList)
,("-webkit-box-shadow", shadowList)
,("text-shadow", textShadow)
,("animation", animation)
,("-o-animation", animation)
,("-ms-animation", animation)
,("-moz-animation", animation)
,("-webkit-animation", animation)
,("transition", transition)
,("-o-transition", transition)
,("-ms-transition", transition)
,("-moz-transition", transition)
,("-webkit-transition", transition)
,("height", singleValue numberOrText) -- <length>|<percentage>|auto
,("margin-bottom", singleValue numberOrText)
,("margin-left", singleValue numberOrText)
,("background-position", singleValue positionvalue)
,("perspective-origin", singleValue positionvalue)
,("-o-perspective-origin", singleValue positionvalue)
,("-moz-perspective-origin", singleValue positionvalue)
,("-webkit-perspective-origin", singleValue positionvalue)
,("mask-position", positionList)
,("-webkit-mask-position", positionList)
,("object-position", singleValue positionvalue)
-- ,("transform-origin", transformOrigin)
-- ,("-ms-transform-origin", transformOrigin)
-- ,("-webkit-transform-origin", transformOrigin)
-- ,("font",
-- ,("margin-right", numberOrText)
-- ,("margin-top", numberOrText)
-- ,("opacity", someNumericalValue)
-- ,("overflow", someText)
-- ,("padding-bottom", someNumericalValue)
-- ,("padding-left", someNumericalValue)
-- ,("padding-right", someNumericalValue)
-- ,("padding-top", someNumericalValue)
-- ,("position", someText)
-- ,("text-align", someText)
-- ,("width", numberOrText)
]
where numberOrText = numericalvalue <|> textualvalue
-- helper wrapper
singleValue :: Parser Value -> Parser Values
singleValue = (flip Values [] <$>)
-- | Parses until the end of the declaration, i.e. ';' or '}'.
-- Used to deal with invalid input, or an IE specific hack.
invalidvalue :: Parser Value
invalidvalue = mkOther <$> A.takeWhile1 cond
where cond c = c /= '\\' && c /= ';' && c /= '}' && c /= '!'
-- [ [ <'font-style'> || <font-variant-css21> || <'font-weight'> ||
-- <'font-stretch'> ]? <'font-size'> [ / <'line-height'> ]? <'font-family'> ] |
font :: Parser Value
font = systemFonts <|> do
(fsty, fvar, fwgt, fstr) <- parse4
(fsz, lh) <- fontSizeAndLineHeight
ff <- ((:) <$> fontfamily <* skipComments) <*> many (char ',' *> lexeme fontfamily)
pure $ FontV fsty fvar fwgt fstr fsz lh ff
where systemFonts = Other <$> parseIdents ["caption", "icon", "menu", "message-box", "small-caption", "status-bar"]
fontSizeAndLineHeight = do
fsz <- fontSize <* skipComments
lh <- optional (char '/' *> lexeme lineHeight)
pure (fsz, lh)
lineHeight = let validNum = do n <- numericalvalue
case n of
NumberV _ -> pure n
PercentageV _ -> pure n
LengthV _ -> pure n
_ -> mzero
in (Other <$> parseIdents ["normal"]) <|> validNum
fontWeightNumber :: Parser Value
fontWeightNumber = do
n <- number
if Set.notMember n (Set.fromList [100, 200, 300, 400, 500, 600, 700, 800, 900])
then mzero
else do c <- A.peekChar
case c of
Nothing -> mzero
Just x -> if isAscii x || x == '%'
then mzero
else pure $ NumberV n
parseFirstFour j = (storeProperty' j <$> fontWeightNumber <* skipComments) <|> do
i <- ident
case Map.lookup (T.toLower i) m of
Just x -> case x of
FontWeight -> pure $ storeProperty' j (mkOther i)
_ -> pure $ storeProperty j x (TextV i)
Nothing -> mzero
where m =
Map.fromList $ zip ["ultra-condensed", "extra-condensed", "condensed", "semi-condensed", "semi-expanded", "expanded", "extra-expanded", "ultra-expanded"] (repeat FontStretch)
++ zip ["small-caps"] (repeat FontVariant)
++ zip ["italic", "oblique"] (repeat FontStyle)
++ zip ["bold", "bolder", "lighter"] (repeat FontWeight)
++ [("normal", Ambiguous)]
parse4 :: Parser (Maybe TextV, Maybe TextV, Maybe Value, Maybe TextV)
parse4 = do
let initialized = (Nothing, Nothing, Nothing, Nothing, 0)
w <- option initialized (parseFirstFour initialized <* skipComments)
x <- option w (parseFirstFour w <* skipComments)
y <- option x (parseFirstFour x <* skipComments)
(a,b,c,d,e) <- option y (parseFirstFour y <* skipComments)
pure $ fillTuple (a,b,c,d) e
fillTuple (a,b,c,d) 0 = (a,b,c,d)
fillTuple (a,b,c,d) x
| isNothing a = fillTuple (Just nrml,b,c,d) (x-1)
| isNothing b = fillTuple (a, Just nrml,c,d) (x-1)
| isNothing c = fillTuple (a,b, Just $ Other nrml,d) (x-1)
| isNothing d = fillTuple (a,b,c, Just nrml) (x-1)
| otherwise = (a,b,c,d)
where nrml = TextV "normal"
data FontProperty = FontStyle | FontVariant | FontWeight | FontStretch | Ambiguous
deriving (Eq, Show)
storeProperty :: (Maybe TextV, Maybe TextV, Maybe Value, Maybe TextV, Int) -> FontProperty -> TextV
-> (Maybe TextV, Maybe TextV, Maybe Value, Maybe TextV, Int)
storeProperty (a,b,c,d,i) y x = replace y
where replace FontStyle = (Just x,b,c,d,i)
replace FontVariant = (a, Just x,c,d,i)
replace FontStretch = (a,b,c, Just x,i)
replace Ambiguous = (a,b,c,d,i + 1)
replace _ = (a,b,c,d,i)
storeProperty' :: (Maybe TextV, Maybe TextV, Maybe Value, Maybe TextV, Int) -> Value
-> (Maybe TextV, Maybe TextV, Maybe Value, Maybe TextV, Int)
storeProperty' (a,b,_,d,i) x = (a,b, Just x,d,i)
-- font-style: normal
-- font-variant: normal
-- font-weight: normal
-- font-stretch: normal
-- font-size: medium
-- line-height: normal
-- font-family: depends on user agent
fontFamilyValues :: Parser Values
fontFamilyValues = singleValue csswideKeyword <|> do
v <- fontfamily
vs <- many (mzip separator fontfamily)
pure $ Values v vs
fontfamily :: Parser Value
fontfamily = stringvalue <|> (mkOther <$> unquotedFontFamily)
local :: Parser Value
local = functionParser $
Local <$> ((Left <$> unquotedFontFamily) <|> (Right <$> stringtype))
unquotedFontFamily :: Parser Text
unquotedFontFamily = do
v <- ident
vs <- many (skipComments *> ident)
pure $ v <> foldMap (T.singleton ' ' <>) vs
textualParsers :: Text -> Parser Value
textualParsers i = let t = T.toCaseFold i
in fromMaybe (pure $ mkOther i) (Map.lookup t textualParsersMap)
where textualParsersMap = Map.union csswideKeywordsMap namedColorsValueParsersMap
namedColorsValueParsersMap = (fmap . fmap) ColorV namedColorsParsersMap
csswideKeyword :: Parser Value
csswideKeyword = do
i <- ident <* skipComments
let lowercased = T.toLower i
case Map.lookup lowercased csswideKeywordsMap of
Nothing -> mzero
Just x -> do c <- A.peekChar
case c of
Nothing -> x
Just y -> if y `elem` ['!', ';', '}']
then x
else mzero
csswideKeywordsMap :: Map Text (Parser Value)
csswideKeywordsMap = Map.fromList
[("initial", pure Initial)
,("inherit", pure Inherit)
,("unset", pure Unset)]
stringvalue :: Parser Value
stringvalue = StringV <$> stringtype
functionParsers :: Text -> Parser Value
functionParsers i = char '(' *>
case Map.lookup (T.toLower i) functionsMap of
Just x -> x <|> genericFunc i
Nothing -> genericFunc i
<|> (mkOther <$> (f i "(" <$> someText <*> string ")"))
where f x y z w = x <> y <> z <> w
someText = A.takeWhile (/= ')')
genericFunc :: Text -> Parser Value
genericFunc i = (GenericFunc i <$> valuesInParens) <* char ')'
valuesInParens :: Parser Values
valuesInParens = Values <$> v <*> many (mzip separator v) <* skipComments
where v = textualvalue
<|> numericalvalue
<|> hexvalue
<|> stringvalue
stringOrUrl :: Parser (Either StringType Url)
stringOrUrl = (Left <$> stringtype) <|> (Right <$> someUrl)
where someUrl :: Parser Url
someUrl = asciiCI "url" *> char '(' *> url
-- | Parser for <https://www.w3.org/TR/css-backgrounds-3/#typedef-repeat-style \<repeat-style\>>,
-- used in @background-repeat@ and @background@.
repeatStyle :: Parser RepeatStyle
repeatStyle = do
i <- ident
let lowercased = T.toLower i
case L.lookup lowercased singleKeywords of
Nothing -> case Map.lookup lowercased keywordPairs of
Nothing -> mzero
Just y -> (RepeatStyle2 y <$> secondKeyword)
<|> pure (RepeatStyle1 y)
Just x -> pure x
where secondKeyword = do
z <- skipComments *> ident
maybe mzero pure $ Map.lookup (T.toLower z) keywordPairs
singleKeywords = [("repeat-x", RepeatX), ("repeat-y", RepeatY)]
keywordPairs = Map.fromList [("repeat", RsRepeat)
,("no-repeat", RsNoRepeat)
,("space", RsSpace)
,("round", RsRound)]
functionsMap :: Map Text (Parser Value)
functionsMap = Map.fromList (colorFunctionValueParsers ++ l)
where colorFunctionValueParsers = (fmap . fmap . fmap) ColorV colorFunctionsParsers
l = [("url", UrlV <$> url)
,("format", format)
,("local", local)
-- <gradient> parsers
,("linear-gradient", GradientV "linear-gradient" <$> lineargradient)
,("-o-linear-gradient", GradientV "-o-linear-gradient" <$> lineargradient)
,("-ms-linear-gradient", GradientV "-ms-linear-gradient" <$> lineargradient)
,("-moz-linear-gradient", GradientV "-moz-linear-gradient" <$> lineargradient)
,("-webkit-linear-gradient", GradientV "-webkit-linear-gradient" <$> lineargradient)
,("radial-gradient", GradientV "radial-gradient" <$> radialgradient)
,("-o-radial-gradient", GradientV "-o-radial-gradient" <$> radialgradient)
,("-moz-radial-gradient", GradientV "-moz-radial-gradient" <$> radialgradient)
,("-webkit-radial-gradient", GradientV "-webkit-radial-gradient" <$> radialgradient)
--,("repeating-linear-gradient", ? ) -- TODO
--,("repeating-radial-gradient", ? ) -- TODO
-- <shape>
,("rect", rect)
-- <transform-function>
,("matrix", TransformV <$> matrix)
,("matrix3d", TransformV <$> matrix3d)
,("rotate", (TransformV . Rotate) <$> functionParser angle)
,("rotate3d", TransformV <$> rotate3d)
,("rotatex", (TransformV . Rotate) <$> functionParser angle)
,("rotatey", (TransformV . Rotate) <$> functionParser angle)
,("rotatez", (TransformV . Rotate) <$> functionParser angle)
,("scale", TransformV <$> scale)
,("scale3d", TransformV <$> scale3d)
,("scalex", (TransformV . ScaleY) <$> functionParser number)
,("scaley", (TransformV . ScaleY) <$> functionParser number)
,("scalez", (TransformV . ScaleZ) <$> functionParser number)
,("skew", TransformV <$> skew)
,("skewx", (TransformV . SkewX) <$> functionParser angle)
,("skewy", (TransformV . SkewY) <$> functionParser angle)
,("translate", TransformV <$> translate)
,("translate3d", TransformV <$> translate3d)
,("translatex", (TransformV . TranslateX) <$> functionParser percentageLength)
,("translatey", (TransformV . TranslateY) <$> functionParser percentageLength)
,("translatez", (TransformV . TranslateZ) <$> functionParser distance)
,("perspective", (TransformV . Perspective) <$> functionParser distance)
-- <timing-function>
,("cubic-bezier", TimingFuncV <$> cubicbezier)
,("steps", TimingFuncV <$> steps)
-- <filter-function>
,("blur", (FilterV . Blur) <$> functionParser distance)
,("contrast", (FilterV . Contrast) <$> functionParser numberPercentage)
,("grayscale", (FilterV . Grayscale) <$> functionParser numberPercentage)
,("invert", (FilterV . Invert) <$> functionParser numberPercentage)
,("opacity", (FilterV . Opacity) <$> functionParser numberPercentage)
,("saturate", (FilterV . Saturate) <$> functionParser numberPercentage)
,("sepia", (FilterV . Sepia) <$> functionParser numberPercentage)
,("brightness", (FilterV . Brightness) <$> functionParser numberPercentage)
,("drop-shadow", FilterV <$> dropShadow)
,("hue-rotate", (FilterV . HueRotate) <$> functionParser angle)
,("element", genericFunc "element")
-- <basic-shape>
,("circle", BasicShapeV <$> functionParser circle)
,("ellipse", BasicShapeV <$> functionParser ellipse)
,("inset", BasicShapeV <$> functionParser inset)
,("polygon", BasicShapeV <$> functionParser polygon)
--
-- <image> https://drafts.csswg.org/css-images
-- Note: <gradient> is a type of <image> !
-- cross-fade()
-- image()
-- image-set()
-- image-set()
-- element()
--
--
--,("stylistic", functionParser ident) -- IDENT
--,("styleset", ? ) -- ident#
--,("swash", ? ) -- ident
--,("annotation", ? ) -- ident
--,("attr", ? ) -- <attr-name> <type-or-unit>? [, <attr-fallback> ]?
--,("calc", ? ) -- <calc-sum> , experimental
--,("character-variant", ? ) -- ident#
--,("element", ? ) -- id selector, experimental
--,("ornaments", ? ) -- ident
--,("symbols", ? ) -- <symbols-type>? [ <string> | <image> ]+
--,("var", ? ) -- experimental: <custom-property-name> [, <declaration-value> ]?
-- minmax()
]
dropShadow :: Parser FilterFunction
dropShadow = functionParser $
DropShadow <$> len <*> len <*> optional len <*> optional color
where len = distance <* skipComments
textShadow :: Parser Values
textShadow = parseCommaSeparated shadowText
shadowText :: Parser Value
shadowText = permute (mkShadowText <$$> (lns <* skipComments)
<|?> (Nothing , Just <$> color <* skipComments))
where mkShadowText (x,y,b) = ShadowText x y b
lns = do
l1 <- distance
l2 <- lexeme distance
l3 <- optional (distance <* skipComments)
pure (l1,l2,l3)
-- | Parser for <https://drafts.csswg.org/css-backgrounds-3/#typedef-shadow \<shadow>>
-- values, used in the @box-shadow@ property.
shadowList :: Parser Values
shadowList = parseCommaSeparated (ShadowV <$> shadow)
positionList :: Parser Values
positionList = parseCommaSeparated positionvalue
parseCommaSeparated :: Parser Value -> Parser Values
parseCommaSeparated p = do
v <- p
vs <- lexeme $ many (mzip commaSeparator p)
c <- A.peekChar
case c of
Just x -> if x `elem` ['!', ';', '}']
then pure $ Values v vs
else mzero
Nothing -> pure $ Values v vs
shadow :: Parser Shadow
shadow = permute (mkShadow <$?> (False, asciiCI "inset" $> True <* skipComments)
<||> fourLengths
<|?> (Nothing , Just <$> color <* skipComments))
where mkShadow i (l1,l2,l3,l4) = Shadow i l1 l2 l3 l4
fourLengths = do
l1 <- distance
l2 <- lexeme distance
l3 <- optional (distance <* skipComments)
l4 <- optional (distance <* skipComments)
pure (l1,l2,l3,l4)
numberPercentage :: Parser (Either Number Percentage)
numberPercentage = do
n <- numericalvalue
case n of
NumberV x -> pure $ Left x
PercentageV p -> pure $ Right p
_ -> mzero
-- | Assumes "rect(" has been already parsed
rect :: Parser Value
rect = functionParser (Rect <$> dc <*> dc <*> dc <*> distance)
where dc = distance <* comma
-- It uses skipSpace instead of skipComments, since comments aren't valid inside
-- the url-token. From the spec:
-- COMMENT tokens cannot occur within other tokens: thus, "url(/*x*/pic.png)"
-- denotes the URI "/*x*/pic.png", not "pic.png".
--
-- | Parser for <https://drafts.csswg.org/css-values-3/#urls \<url\>>. Assumes
-- @\"url(\"@ has already been parsed.
url :: Parser Url
url = Url <$> (skipSpace *> someUri <* skipSpace <* char ')')
where someUri = (Right <$> stringtype) <|> (Left <$> nonQuotedUri)
nonQuotedUri = A.takeWhile1 (/= ')') -- TODO maybe parse ident?
-- format(<string>#)
-- Assumes "format(" has been already parsed
format :: Parser Value
format = Format <$> functionParser p
where p = (:) <$> stringtype <*> many (comma *> stringtype)
-- | For cases when CSS hacks are used, e.g.: @margin-top: 1px \\9;@.
valuesFallback :: Parser Values
valuesFallback = Values <$> value <*> many (mzip separator value) <* skipComments
value :: Parser Value
value = textualvalue
<|> numericalvalue
<|> hexvalue
<|> stringvalue
<|> invalidvalue
separator :: Parser Separator
separator = lexeme $ (char ',' $> Comma)
<|> (char '/' $> Slash)
<|> pure Space
commaSeparator :: Parser Separator
commaSeparator = lexeme (char ',' $> Comma)
-- <single-animation>#
animation :: Parser Values
animation = parseCommaSeparated singleAnimation
-- <single-animation> = <time> || <timing-function> || <time> || <animation-iteration-count> || <animation-direction> || <animation-fill-mode> || <animation-play-state> || [ none | <keyframes-name> ]
singleAnimation :: Parser Value
singleAnimation = do
sa <- permute (mkSingleAnimation <$?> (Nothing, Just <$> keyframesName <* skipComments)
<|?> (Nothing, Just <$> iterationCount <* skipComments)
<|?> (Nothing, Just <$> time <* skipComments)
<|?> (Nothing, Just <$> time <* skipComments)
<|?> (Nothing, Just <$> timingFunction <* skipComments)
<|?> (Nothing, Just <$> animationDirection <* skipComments)
<|?> (Nothing, Just <$> animationFillMode <* skipComments)
<|?> (Nothing, Just <$> animationPlayState <* skipComments))
if saIsEmpty sa
then mzero
else pure sa
where -- mkSingleAnimation is used to order properly the overlapping values parsed by permute.
mkSingleAnimation kf ic t1 t2 tf c d e = SingleAnimation t2 tf t1 ic c d e kf
saIsEmpty (SingleAnimation Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing) = True
saIsEmpty _ = False
iterationCount = (mkOther <$> asciiCI "infinite") <|> (NumberV <$> number)
animationDirection = parseIdents ["normal", "reverse", "alternate", "alternate-reverse"]
animationFillMode = parseIdents ["none", "forwards", "backwards", "both"]
animationPlayState = parseIdents ["running", "paused"]
keyframesName = stringvalue <|> (mkOther <$> ident)
parseIdents :: [Text] -> Parser TextV
parseIdents ls = do
i <- ident
if Set.member (T.toLower i) s
then pure $ TextV i
else mzero
where s = Set.fromList ls
-- <single-animation-fill-mode> = none | forwards | backwards | both
textualvalue :: Parser Value
textualvalue = do
i <- ident
if i == "\\9" -- iehack
then mzero
else do c <- A.peekChar
case c of
Just '(' -> functionParsers i
Just ':' -> mzero -- invalid
_ -> textualParsers i