content: {-# 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
  