content: {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : Hasmin.Parser.Internal
  -- Copyright   : (c) 2017 Cristian Adrián Ontivero
  -- License     : BSD3
  -- Stability   : experimental
  -- Portability : unknown
  --
  -----------------------------------------------------------------------------
  module Hasmin.Parser.Internal
      ( stylesheet
      , atRule
      , atMedia
      , styleRule
      , rule
      , rules
      , declaration
      , declarations
      , selector
      , supportsCondition
      ) where
  
  import Control.Applicative ((<|>), many, some, optional)
  import Data.Functor (($>))
  import Data.Attoparsec.Combinator (lookAhead, endOfInput)
  import Data.Attoparsec.Text (asciiCI, char, manyTill,
    Parser, satisfy)
  import Data.List.NonEmpty (NonEmpty)
  import Data.Monoid ((<>))
  import Data.Maybe (fromMaybe)
  import Data.Text (Text)
  import qualified Data.List.NonEmpty as NE
  import qualified Data.Map.Strict as Map
  import qualified Data.Set as Set
  import qualified Data.Attoparsec.Text as A
  import qualified Data.Char as C
  import qualified Data.Text as T
  
  import Hasmin.Parser.Utils
  import Hasmin.Parser.Value
  import Hasmin.Parser.Selector
  import Hasmin.Types.Stylesheet
  import Hasmin.Types.Declaration
  
  -- | Parser for a declaration, starting by the property name.
  declaration :: Parser Declaration
  declaration = do
      p  <- property <* colon
      v  <- valuesFor p <|> valuesFallback
      i  <- important
      ie <- lexeme iehack
      pure $ Declaration p v i ie
  
  -- | Parser for property names. Usually, 'ident' would be enough, but this
  -- parser adds support for IE hacks (e.g. *width), which deviate from the CSS
  -- grammar.
  property :: Parser Text
  property = mappend <$> opt ie7orLessHack <*> ident
    where ie7orLessHack = T.singleton <$> satisfy (`Set.member` ie7orLessHacks)
          ie7orLessHacks = Set.fromList ("!$&*()=%+@,./`[]#~?:<>|" :: String)
  
  -- | Used to parse the "!important" at the end of declarations, ignoring spaces
  -- and comments after the '!'.
  important :: Parser Bool
  important = A.option False (char '!' *> skipComments *> asciiCI "important" $> True)
  
  iehack :: Parser Bool
  iehack = A.option False (A.string "\\9" $> True)
  
  -- Note: The handleSemicolons outside is needed to handle parsing "h1 { ; }".
  --
  -- | Parser for a list of declarations, ignoring spaces, comments, and empty
  -- declarations (e.g. ; ;)
  declarations :: Parser [Declaration]
  declarations = many (declaration <* handleSemicolons) <* handleSemicolons
    where handleSemicolons = many (A.char ';' *> skipComments)
  
  -- | Parser for CSS at-rules (e.g. \@keyframes, \@media)
  atRule :: Parser Rule
  atRule = do
      _ <- char '@'
      ruleType <- ident
      fromMaybe (atBlock ruleType) (Map.lookup ruleType m)
    where m = Map.fromList [("charset",           atCharset)
                           ,("import",            atImport)
                           ,("namespace",         atNamespace)
                           ,("media",             atMedia)
                           ,("supports",          atSupports)
                           -- ,("document",          atDocument)
                           -- ,("page",              atPage)
                           ,("font-face",         skipComments *> atBlock "font-face")
                           ,("keyframes",         atKeyframe mempty )
                           ,("-webkit-keyframes", atKeyframe "-webkit-")
                           ,("-moz-keyframes",    atKeyframe "-moz-")
                           ,("-o-keyframes",      atKeyframe "-o-")
                           -- ,("viewport",              atViewport)
                           -- ,("counter-style",         atCounterStyle)
                           -- ,("font-feature-value",    atFontFeatureValue)
                           ]
  -- @import [ <string> | <url> ] [<media-query-list>]?;
  atImport :: Parser Rule
  atImport = do
      esu <- skipComments *> stringOrUrl
      mql <- A.option [] mediaQueryList
      _   <- skipComments <* char ';'
      pure $ AtImport esu mql
  
  atCharset :: Parser Rule
  atCharset = AtCharset <$> (lexeme stringtype <* char ';')
  
  -- @namespace <namespace-prefix>? [ <string> | <uri> ];
  -- where
  -- <namespace-prefix> = IDENT
  atNamespace :: Parser Rule
  atNamespace = do
      i   <- skipComments *> A.option mempty ident
      ret <- if T.null i
                then AtNamespace i . Left <$> stringtype
                else decideBasedOn i
      _ <- skipComments <* char ';'
      pure ret
    where decideBasedOn x
              | T.toCaseFold x == "url" =
                  do c <- A.peekChar
                     case c of
                       Just '(' -> AtNamespace mempty <$> (char '(' *> (Right <$> url))
                       _        -> AtNamespace x <$> (skipComments *> stringOrUrl)
              | otherwise = AtNamespace x <$> (skipComments *> stringOrUrl)
  
  atKeyframe :: Text -> Parser Rule
  atKeyframe t = do
      name <- lexeme ident <* char '{'
      bs   <- many (keyframeBlock <* skipComments)
      _    <- char '}'
      pure $ AtKeyframes t name bs
  
  keyframeBlock :: Parser KeyframeBlock
  keyframeBlock = do
      sel  <- lexeme kfsList
      ds   <- char '{' *> skipComments *> declarations <* char '}'
      pure $ KeyframeBlock sel ds
    where from = asciiCI "from" $> From
          to   = asciiCI "to" $> To
          keyframeSelector = from <|> to <|> (KFPercentage <$> percentage)
          kfsList = (:) <$> keyframeSelector <*> many (comma *> keyframeSelector)
  
  atMedia :: Parser Rule
  atMedia = do
      m <- satisfy C.isSpace *> mediaQueryList
      _ <- char '{' <* skipComments
      r <- manyTill (rule <* skipComments) (lookAhead (char '}'))
      _ <- char '}'
      pure $ AtMedia m r
  
  atSupports :: Parser Rule
  atSupports = do
      sc <- satisfy C.isSpace *> supportsCondition
      _  <- lexeme (char '{')
      r  <- manyTill (rule <* skipComments) (lookAhead (char '}'))
      _ <- char '}'
      pure $ AtSupports sc r
  
  -- | Parser for a <https://drafts.csswg.org/css-conditional-3/#supports_condition supports_condition>,
  -- needed by @\@supports@ rules.
  supportsCondition :: Parser SupportsCondition
  supportsCondition = asciiCI "not" *> skipComments *> (Not <$> supportsCondInParens)
                  <|> supportsConjunction
                  <|> supportsDisjunction
                  <|> (Parens <$> supportsCondInParens)
    where
      supportsDisjunction :: Parser SupportsCondition
      supportsDisjunction = supportsHelper Or "or"
  
      supportsConjunction :: Parser SupportsCondition
      supportsConjunction = supportsHelper And "and"
  
  supportsCondInParens :: Parser SupportsCondInParens
  supportsCondInParens = do
      _ <- char '('
      x <- lexeme $ (ParensCond <$> supportsCondition) <|> (ParensDec <$> atSupportsDeclaration)
      _ <- char ')'
      pure x
  
  atSupportsDeclaration :: Parser Declaration
  atSupportsDeclaration = do
      p  <- property <* colon
      v  <- valuesFor p <|> valuesInParens
      pure $ Declaration p v False False
  
  -- customPropertyIdent :: Parser Text
  -- customPropertyIdent = (<>) <$> string "-" <*> ident
  
  supportsHelper :: (SupportsCondInParens -> NonEmpty SupportsCondInParens -> SupportsCondition)
                 ->  Text -> Parser SupportsCondition
  supportsHelper c t = do
      x  <- supportsCondInParens <* skipComments
      xs <- some (asciiCI t *> lexeme supportsCondInParens)
      pure $ c x (NE.fromList xs)
  
  -- TODO clean code
  -- the "manyTill .. lookAhead" was added because if we only used "rules", it
  -- doesn't know when to stop, and breaks the parser
  atBlock :: Text -> Parser Rule
  atBlock i = do
    t <- mappend i <$> A.takeWhile (/= '{') <* char '{'
    r <- skipComments *> ((AtBlockWithDec t <$> declarations) <|> (AtBlockWithRules t <$> manyTill (rule <* skipComments) (lookAhead (char '}'))))
    _ <- char '}'
    pure r
  
  -- | Parses a CSS style rule, e.g. @body { padding: 0; }@
  styleRule :: Parser Rule
  styleRule = do
      sels <- selectors <* char '{' <* skipComments
      decs <- declarations <* char '}'
      pure $ StyleRule sels decs
  
  -- | Parser for a CSS rule, which can be either an at-rule (e.g. \@charset), or a style
  -- rule.
  rule :: Parser Rule
  rule = atRule <|> styleRule
  
  -- | Parser for CSS rules (both style rules, and at-rules), which can be
  -- separated by whitespace or comments.
  rules :: Parser [Rule]
  rules = manyTill (rule <* skipComments) endOfInput
  
  -- | Parse a stylesheet, starting by the \@charset, \@import and \@namespace
  -- rules, followed by the list of rules, and ignoring any unneeded whitespace
  -- and comments.
  stylesheet :: Parser [Rule]
  stylesheet = do
    charset    <- A.option [] ((:[]) <$> atCharset <* skipComments)
    imports    <- many (atImport <* skipComments)
    namespaces <- many (atNamespace <* skipComments)
    _ <- skipComments -- if there is no charset, import, or namespace at rule we need this here.
    rest <- rules
    pure $ charset <> imports <> namespaces <> rest
  
  -- | Media Feature values. Per the
  -- <https://www.w3.org/TR/css3-mediaqueries/#values original spec (6.1)>,
  -- \<resolution\> only accepts dpi and dpcm units, dppx was added later.
  -- However, the w3c validator considers it valid, so we make no exceptions.
  {-
  data MediaFeatureValue = MFV_Length Length
                         | MFV_Ratio Ratio
                         | MFV_Number Number
                         | MFV_Resolution Resolution
                         | MFV_Other Text
  -}
  
  -- | Specs:
  --
  -- https://drafts.csswg.org/mediaqueries-3/#syntax
  -- https://www.w3.org/TR/css3-mediaqueries/
  -- https://www.w3.org/TR/CSS21/grammar.html
  --
  -- Implementation based on mozilla's pseudo BNF:
  -- https://developer.mozilla.org/en-US/docs/Web/CSS/Media_Queries/Using_media_queries
  mediaQueryList :: Parser [MediaQuery]
  mediaQueryList = lexeme ((:) <$> mediaQuery <*> many (char ',' *> skipComments *> mediaQuery))
  
  mediaQuery :: Parser MediaQuery
  mediaQuery = mediaQuery1 <|> mediaQuery2
    where mediaQuery1 = MediaQuery1 <$> optionalNotOrOnly <*> mediaType <*> andExpressions
          mediaQuery2 = MediaQuery2 <$> ((:) <$> expression <*> andExpressions)
          mediaType = lexeme ident
          andExpressions = many (h *> expression)
          h = lexeme (asciiCI "and" *> satisfy C.isSpace)
          optionalNotOrOnly = A.option mempty (asciiCI "not" <|> asciiCI "only")
  
  -- https://www.w3.org/TR/mediaqueries-4/#typedef-media-condition-without-or
  expression :: Parser Expression
  expression = char '(' *> skipComments *> (expr <|> expFallback)
    where expr = do
               e <- ident <* skipComments
               v <- optional (char ':' *> lexeme value)
               _ <- char ')' -- Needed here for expFallback to trigger
               pure $ Expression e v
          expFallback = InvalidExpression <$> A.takeWhile (/= ')') <* char ')'
  
  -- TODO implement the whole spec 4, or at least 3.
  -- Note: The code below pertains to CSS Media Queries Level 4.
  -- Since it is still too new and nobody implements it (afaik),
  -- I leave it here for future reference, when the need to cater for it
  -- arrives.
  {-
  mediaCondition = asciiCI "not"
                <|> asciiCI "and"
                <|> asciiCI "or"
                <|> mediaInParens
  
  mediaInParens = char '(' *> skipComments *> mediaCondition <* skipComments <* char ')'
  
  mediaFeature :: Parser MediaFeature
  mediaFeature = mfPlain <|> mfRange <|> mfBoolean
    where mfBoolean = ident
  
  mfRange = ident
  
  data MediaFeature = MFPlain Text Value
                    | MFBoolean Text
                    | MFRange Range
  
  data Range = Range1 Text RangeOp Value
             | Range2 Value RangeOp Text
             | Range3 Value RangeOp Text RangeOp Value
  
  data RangeOp = LTOP | GTOP | EQOP | GEQOP | LEQOP
  
  -- = <mf-name> [ '<' | '>' ]? '='? <mf-value>
  --            | <mf-value> [ '<' | '>' ]? '='? <mf-name>
  --            | <mf-value> '<' '='? <mf-name> '<' '='? <mf-value>
  --            | <mf-value> '>' '='? <mf-name> '>' '='? <mf-value>
  
  mfPlain = ident *> skipComments *> char ':' *> skipComments *> mfValue
  
  mfValue :: Parser Value
  mfValue = number <|> dimension <|> ident <|> ratio
  
  -- TODO check if both integers are positive (required by the spec)
  ratio :: Parser Value
  ratio = do
      n <- digits
      _ <- skipComments *> char '/' <* skipComments
      m <- digits
      pure $ Other (mconcat [n, "/", m])
  
  
  
  -- expr
  --  : term [ operator? term ]*
  --  ;
  --
  --term
  -- : unary_operator?
  --    [ NUMBER S* | PERCENTAGE S* | LENGTH S* | EMS S* | EXS S* | ANGLE S* |
  --      TIME S* | FREQ S* ]
  --  | STRING S* | IDENT S* | URI S* | hexcolor | function
  --  ;
  --
  
  data MediaFeatureType = Range | Discrete
  
  t =
    [("width",               Range)
    ,("height",              Range)
    ,("aspect-ratio",        Range)
    ,("orientation",         Discrete)
    ,("resolution",          Range)
    ,("scan",                Discrete)
    ,("grid",                Discrete)
    ,("update",              Discrete)
    ,("overflow-block",      Discrete)
    ,("overflow-inline",     Discrete)
    ,("color",               Range)
    ,("color-index",         Range)
    ,("monochrome",          Range)
    ,("color-gamut",         Discrete)
    ,("pointer",             Discrete)
    ,("hover",               Discrete)
    ,("any-pointer",         Discrete)
    ,("any-hover",           Discrete)
    ,("scripting",           Discrete)
    ,("device-width",        Range)
    ,("device-height",       Range)
    ,("device-aspect-ratio", Range)
    ]
  -}
  