content: {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : Hasmin.Parser.Selector
  -- Copyright   : (c) 2017 Cristian Adrián Ontivero
  -- License     : BSD3
  -- Stability   : experimental
  -- Portability : unknown
  --
  -----------------------------------------------------------------------------
  module Hasmin.Parser.Selector
      ( selectors
      , selector
      ) where
  
  import Control.Applicative ((<|>), many, some, empty, optional)
  import Data.Attoparsec.Combinator (sepBy)
  import Data.Attoparsec.Text (asciiCI, char, Parser, satisfy, string)
  import qualified Data.Attoparsec.Text as A
  import Data.Map.Strict (Map)
  import qualified Data.Map.Strict as Map
  import Data.Text (Text)
  import qualified Data.Text as T
  import qualified Data.Text.Lazy as TL
  import Data.Functor (($>))
  import qualified Data.Text.Lazy.Builder as LB
  import Data.List.NonEmpty (NonEmpty( (:|) ))
  
  import Hasmin.Parser.Utils
  import Hasmin.Parser.String
  import Hasmin.Utils
  
  import Hasmin.Types.Selector
  import Hasmin.Types.String
  
  -- | Parser for CSS complex selectors (see 'Selector' for more details).
  selector :: Parser Selector
  selector = Selector <$> compoundSelector <*> combinatorsAndSelectors
    where combinatorsAndSelectors = many $ mzip (combinator <* skipComments) compoundSelector
  
  -- First tries with '>>' (descendant), '>' (child), '+' (adjacent sibling), and
  -- '~' (general sibling) combinators. If those fail, it tries with the
  -- descendant (whitespace) combinator. This is done to allow comments in-between.
  --
  -- | Parser for selector combinators, i.e. ">>" (descendant), '>' (child), '+'
  -- (adjacent sibling), '~' (general sibling), and ' ' (descendant) combinators.
  combinator :: Parser Combinator
  combinator =  (skipComments *> ((string ">>" $> DescendantBrackets)
            <|> (char '>' $> Child)
            <|> (char '+' $> AdjacentSibling)
            <|> (char '~' $> GeneralSibling)))
            <|> (satisfy ws $> DescendantSpace)
    where ws c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f'
  
  compoundSelector :: Parser CompoundSelector
  compoundSelector = cs1 <|> cs2
    where cs1 = do
              sel  <- typeSelector <|> universal
              sels <- many p
              pure $ sel:|sels
          cs2 = (Universal mempty :|) <$> some p
          p = idSel <|> classSel <|> attributeSel <|> pseudo
  
  -- | Parses a \"number sign\" (U+0023, \#) immediately followed by the ID value,
  -- which must be a CSS identifier.
  idSel :: Parser SimpleSelector
  idSel = do
      _    <- char '#'
      name <- mconcat <$> some nmchar
      pure . IdSel . TL.toStrict $ LB.toLazyText name
  
  -- class: '.' IDENT
  classSel :: Parser SimpleSelector
  classSel = char '.' *> (ClassSel <$> ident)
  
  {-
  attrib
    : '[' S* [ namespace_prefix ]? IDENT S*
          [ [ PREFIXMATCH |
              SUFFIXMATCH |
              SUBSTRINGMATCH |
              '=' |
              INCLUDES |
              DASHMATCH ] S* [ IDENT | STRING ] S*
          ]? ']'
    ;
  -}
  -- FIXME namespace prefixes aren't allowed inside attribute selectors,
  -- but they should be.
  attributeSel :: Parser SimpleSelector
  attributeSel = do
      _     <- char '['
      attId <- lexeme ident
      g     <- A.option Attribute attValue
      _     <- char ']'
      pure $ AttributeSel (g attId)
    where attValue = do
            f <- ((string "^=" $> (:^=:)) <|>
                  (string "$=" $> (:$=:)) <|>
                  (string "*=" $> (:*=:)) <|>
                  (string "="  $> (:=:))  <|>
                  (string "~=" $> (:~=:)) <|>
                  (string "|=" $> (:|=:))) <* skipComments
            attval <- identOrString <* skipComments
            pure (`f` attval)
  
  -- type_selector: [namespace_prefix]? element_name
  typeSelector :: Parser SimpleSelector
  typeSelector = Type <$> opt namespacePrefix <*> ident
  
  -- universal: [ namespace_prefix ]? '*'
  universal :: Parser SimpleSelector
  universal = Universal <$> opt namespacePrefix <* char '*'
  
  -- namespace_prefix: [ IDENT | '*' ]? '|'
  namespacePrefix :: Parser Text
  namespacePrefix = opt (ident <|> string "*") <* char '|'
  
  {- '::' starts a pseudo-element, ':' a pseudo-class
     Exceptions: :first-line, :first-letter, :before and :after.
     Note that pseudo-elements are restricted to one per selector and
     occur only in the last simple_selector_sequence.
  
     <pseudo-class-selector> = ':' <ident-token> |
                               ':' <function-token> <any-value> ')'
     <pseudo-element-selector> = ':' <pseudo-class-selector>
  -}
  -- pseudo: ':' ':'? [ IDENT | functional_pseudo ]
  pseudo :: Parser SimpleSelector
  pseudo = char ':' *> (pseudoElementSelector <|> pseudoClassSelector)
    where pseudoClassSelector = do
              i <- ident
              c <- A.peekChar
              case c of
                Just '(' -> char '(' *> case Map.lookup (T.toLower i) fpcMap of
                              Just p  -> functionParser p
                              Nothing -> functionParser (FunctionalPseudoClass i <$> A.takeWhile (/= ')'))
                _        -> pure $ PseudoClass i
          pseudoElementSelector =
              (char ':' *> (PseudoElem <$> ident)) <|> (ident >>= handleSpecialCase)
            where
              handleSpecialCase :: Text -> Parser SimpleSelector
              handleSpecialCase t
                  | isSpecialPseudoElement = pure $ PseudoElem t
                  | otherwise              = empty
                where isSpecialPseudoElement = T.toLower t `elem` specialPseudoElements
  
  -- \<An+B> microsyntax parser.
  anplusb :: Parser AnPlusB
  anplusb = (asciiCI "even" $> Even)
        <|> (asciiCI "odd" $> Odd)
        <|> do
          s    <- optional parseSign
          dgts <- A.option mempty digits
          case dgts of
            [] -> ciN *> skipComments *> A.option (A s Nothing) (AB s Nothing <$> bValue)
            _  -> let n = read dgts :: Int
                  in (ciN *> skipComments *> A.option (A s $ Just n) (AB s (Just n) <$> bValue))
                      <|> (pure . B $ getSign s * n)
    where ciN       = satisfy (\c -> c == 'N' || c == 'n')
          parseSign = (char '-' $> Minus) <|> (char '+' $> Plus)
          getSign (Just Minus) = -1
          getSign _            = 1
          bValue    = do
              readPlus <- (char '-' $> False) <|> (char '+' $> True)
              d        <- skipComments *> digits
              if readPlus
                 then pure $ read d
                 else pure $ read ('-':d)
  
  -- Functional pseudo classes parsers map
  fpcMap :: Map Text (Parser SimpleSelector)
  fpcMap = Map.fromList
      [buildTuple "nth-of-type"      (\x -> FunctionalPseudoClass2 x <$> anplusb)
      ,buildTuple "nth-last-of-type" (\x -> FunctionalPseudoClass2 x <$> anplusb)
      ,buildTuple "nth-column"       (\x -> FunctionalPseudoClass2 x <$> anplusb)
      ,buildTuple "nth-last-column"  (\x -> FunctionalPseudoClass2 x <$> anplusb)
      ,buildTuple "not"              (\x -> FunctionalPseudoClass1 x <$> compoundSelectorList)
      ,buildTuple "matches"          (\x -> FunctionalPseudoClass1 x <$> compoundSelectorList)
      ,buildTuple "nth-child"        (anbAndSelectors . FunctionalPseudoClass3)
      ,buildTuple "nth-last-child"   (anbAndSelectors . FunctionalPseudoClass3)
      ,buildTuple "lang"             (const (Lang <$> identOrString))
      --
      -- :drop( [ active || valid || invalid ]? )
      -- The :drop() functional pseudo-class is identical to :drop
      -- ,("drop", anplusb)
      --
      -- It accepts a comma-separated list of one or more language ranges as its
      -- argument. Each language range in :lang() must be a valid CSS <ident> or
      -- <string>.
      -- ,("lang", anplusb)
      --
      -- ,("dir", text)
      -- ,("has", relative selectors)
      ]
    where buildTuple t c = (t, c t)
          compoundSelectorList = (:) <$> compoundSelector <*> many (comma *> compoundSelector)
          anbAndSelectors constructor = do
              a <- anplusb <* skipComments
              o <- A.option [] (asciiCI "of" *> skipComments *> compoundSelectorList)
              pure $ constructor a o
  
  -- | Parse a list of comma-separated selectors, ignoring whitespace and
  -- comments.
  selectors :: Parser [Selector]
  selectors = lexeme selector `sepBy` char ','
  
  identOrString :: Parser (Either Text StringType)
  identOrString = (Left <$> ident) <|> (Right <$> stringtype)
  