module Text.CSS.Parser where
import Text.Parsec
import qualified Data.Functor.Identity as I
import Data.List
import Text.CSS.Utils
data Selector = Selector { sName :: String, sAttrs :: [(String,String)], spseudoSelectores :: [String] } | Space | ChildOf | FollowedBy deriving (Show)
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)) ++ "}"
typeSelector :: ParsecT [Char] u I.Identity [Char]
typeSelector = many1 alphaNum
universalSelector :: ParsecT [Char] u I.Identity String
universalSelector = string "*"
pseudoSelector :: ParsecT [Char] u I.Identity [Char]
pseudoSelector = char ':' >> many1 (alphaNum <|> oneOf "-()")
classSelector :: ParsecT [Char] u I.Identity ([Char], [Char])
classSelector = do
val <- char '.' >> many1 alphaNum
return ("class", '~':val)
idSelector :: ParsecT [Char] u I.Identity ([Char], [Char])
idSelector = do
val <- char '#' >> many1 alphaNum
return ("id", val)
attributeSelector :: ParsecT [Char] u I.Identity ([Char], [Char])
attributeSelector = do
_contents <- between (char '[') (char ']') (many1 (alphaNum <|> oneOf "|~=\"'"))
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, "")
secondarySelector = many1 (classSelector <|> idSelector <|> attributeSelector)
space_ = do
many1 $ string " "
return Space
childOf = do
spaces >> string ">" >> spaces
return ChildOf
followedBy = do
spaces >> string "+" >> spaces
return FollowedBy
simpleSelectorTag :: ParsecT [Char] u I.Identity Selector
simpleSelectorTag = do
tagName <- typeSelector <|> universalSelector
attrs <- secondarySelector <|> return []
pseudo <- many1 pseudoSelector <|> return []
return $ Selector tagName attrs pseudo
simpleSelectorNoTag = do
attrs <- secondarySelector
pseudo <- many1 pseudoSelector <|> return []
return $ Selector "*" attrs pseudo
simpleSelector :: ParsecT [Char] u I.Identity Selector
simpleSelector = simpleSelectorTag <|> simpleSelectorNoTag <|> try childOf <|> try followedBy <|> space_
selector :: ParsecT [Char] u I.Identity [[Selector]]
selector = many1 simpleSelector `sepBy` (spaces >> string "," >> spaces)
css = parse selector ""