content: module Text.CSS.Parser where
  
  import Text.Parsec
  import qualified Data.Functor.Identity as I
  import Data.List
  import Data.Maybe
  import Text.CSS.Utils
  -- if no tag name was given, sName will be set to '*'
  -- attrs are (attr name, attr value).
  -- if attr value is the empty string, we just check to
  -- make sure that the element has that attribute.
  --
  -- if the attr value is prefixed with a '~', we treat
  -- that attribute as a list of words separated by a space
  -- and make sure that at least one of those words matches.
  --
  -- if the attr value is prefixed with a `|`, the value must
  -- be exactly val or start with val immediately followed by a '-'.
  -- This is primarily intended to allow language subcode matches.
  -- Example: [lang|="en"] matches "en", "en-US", etc.
  -- From: http://www.w3.org/TR/CSS2/selector.html.
  data Selector = Selector { sName :: String, sAttrs :: [(String,String)], spseudoSelectores :: [String] } | Space | ChildOf | FollowedBy deriving (Show)
  
  -- pretty printers for debugging
  pp Space = "<space>"
  pp ChildOf = "<child of>"
  pp FollowedBy = "<followed by>"
  pp (Selector name attrs pseudo) = show name ++ ":" ++ showMap attrs ++ ", " ++ show pseudo
      where showMap m = ("{" ++ (foldl (\acc (k,v) -> acc ++ (show k) ++ ":" ++ (show v) ++ ", ") "" m)) ++ "}"
  
  {- Some lexeme parsers -}
  ident :: ParsecT [Char] u I.Identity String
  ident = do c1 <- optionMaybe (char '-')
             c2 <- nmstart
             cs <- many nmchar
             return $ concat [maybeToList c1, [c2], cs]
  
  nmstart = alphaNum <|> char '_'
  nmchar  = alphaNum <|> oneOf "_-"
  
  {- TYPE SELECTORS FOLLOW -}
  
  -- | selects a tag name, like @ h1 @
  typeSelector :: ParsecT [Char] u I.Identity [Char]
  typeSelector = many1 (alphaNum <|> oneOf "_-")
  
  -- | universal selector, selects @ * @
  universalSelector :: ParsecT [Char] u I.Identity String
  universalSelector = string "*"
  
  {- SECONDARY SELECTORS FOLLOW -}
  
  -- | selects a pseudo-element or pseudo-class, like @ :link @, @ :first-child @ etc.
  pseudoSelector :: ParsecT [Char] u I.Identity [Char]
  pseudoSelector = char ':' >> many1 (alphaNum <|> oneOf "-()")
  
  -- | class selector, selects @ .foo @
  classSelector :: ParsecT [Char] u I.Identity ([Char], [Char])
  classSelector = do
      val <- char '.' >> ident
      return ("class", '~':val)
  
  -- | id selector, selects @ #foo @
  idSelector :: ParsecT [Char] u I.Identity ([Char], [Char])
  idSelector = do
      val <- char '#' >> many1 nmchar
      return ("id", val)
  
  -- | selects attributes, like @ [id] @ (element must have id) or @ [id=foo] @ (element must have id foo).
  attributeSelector :: ParsecT [Char] u I.Identity ([Char], [Char])
  attributeSelector = do
        _contents <- between (char '[') (char ']') (many1 (noneOf "[]"))
        -- remove quotes
        let contents = filter (\c -> c /= '"' && c /= '\'') _contents
        if "~=" `isInfixOf` contents
            then return $ (\(a, b) -> (a, '~':b)) $ splitOn "~=" contents
            else if "|=" `isInfixOf` contents
                then return $ (\(a, b) -> (a, '|':b)) $ splitOn "|=" contents
                else if '=' `elem` contents
                     then return $ splitOn "=" contents
                     else return (contents, "")
  
  -- | selector for everything after the type except pseudoSelectores
  secondarySelector = many1 (classSelector <|> idSelector <|> attributeSelector)
  
  {- COMBINATOR SELECTORS FOLLOW -}
  
  space_ = do
      many1 $ string " "
      return Space
  
  childOf = do
      spaces >> string ">" >> spaces
      return ChildOf
  
  followedBy = do
      spaces >> string "+" >> spaces
      return FollowedBy
  
  {- SIMPLE SELECTORS FOLLOW -}
  
  -- | selects a tagname followed by one or more secondary selectors
  -- example: @ a.foo @, @ *#hello @, @ h1 @ etc
  simpleSelectorTag :: ParsecT [Char] u I.Identity Selector
  simpleSelectorTag = do
      tagName <- typeSelector <|> universalSelector
      attrs <- secondarySelector <|> return []
      pseudo <- many1 pseudoSelector <|> return []
      return $ Selector tagName attrs pseudo
  
  -- | selects one or more secondary selectors
  -- and automatically prepends the universal selector to them.
  -- example: @ .foo @, @ #hello @ etc
  simpleSelectorNoTag = do
      attrs <- secondarySelector
      pseudo <- many1 pseudoSelector <|> return []
      return $ Selector "*" attrs pseudo
  
  -- | A simple selector is either a type selector or universal selector followed immediately by zero or more attribute selectors, ID selectors, or pseudo-classes, in any order.
  simpleSelector :: ParsecT [Char] u I.Identity Selector
  simpleSelector = simpleSelectorTag <|> simpleSelectorNoTag <|> try childOf <|> try followedBy <|> space_
  
  -- | One or more simple selectors separated by combinators.
  selector :: ParsecT [Char] u I.Identity [[Selector]]
  selector = many1 simpleSelector `sepBy` (spaces >> string "," >> spaces)
  
  css = parse selector ""
  