module Text.XML.Selector.Parser (parseJQ) where
import Text.Parsec
import Text.XML.Selector.Types
import Data.Maybe
import qualified Data.Map as M
type Parser a = Parsec String () a
parseJQ :: String -> [JQSelector]
parseJQ s = either (const []) id (parse parseKey "" (s++" "))
data JQSelectorToken = JQSelectorToken {
rel :: RelPrev,
tagNameIdClassAttr :: [NameIdClassAttr]
} deriving (Eq,Show)
transformSelector :: JQSelectorToken -> JQSelector
transformSelector (JQSelectorToken rel name) = JQSelector rel (t1 t) (t2 t) (t3 t) (t4 t)
where
t = f name (Nothing,Nothing,[],[])
f [] r = r
f ((TagName s):xs) r = f xs (Just s,t2 r,t3 r,t4 r)
f ((Id s):xs) r = f xs (t1 r,Just s,t3 r,t4 r)
f ((Class s):xs) r = f xs (t1 r,t2 r,s:t3 r,t4 r)
f ((Attr k op v):xs) r = f xs (t1 r,t2 r,t3 r,(g k op v):(t4 r))
f ((Not inners):xs) r = error ":not selector is not implemented yet."
t1 (a,_,_,_) = a
t2 (_,a,_,_) = a
t3 (_,_,a,_) = a
t4 (_,_,_,a) = a
g k op v = TagAttr k v (fromMaybe Exists (op >>= (flip M.lookup attrOpList)))
attrOpList :: M.Map String AttrRel
attrOpList = M.fromList [("=",Equal),("|=",Contains),("!=",NotEqual),("^=",Begin),("$=",End),("*=",ContainsWord)]
parseKey :: Parser [JQSelector]
parseKey = many1 selector
selector :: Parser JQSelector
selector = do
skipMany myspaces
sep <- optionMaybe (choice (map char ">+~"))
let t = case sep of
Just '>' -> Child
Just '+' -> Next
Just '~' -> Sibling
Nothing -> Descendant
_ -> error "Incorrect option."
skipMany myspaces
tok <- many1 $ choice [try selId, try selClass, try selTag, try selAttr, try selNot]
skipMany myspaces
return $ transformSelector (JQSelectorToken t tok)
data NameIdClassAttr =
TagName String | Id String | Class String | Attr String (Maybe String) (Maybe String)
| Not [NameIdClassAttr]
deriving (Eq,Show,Ord)
selTag :: Parser NameIdClassAttr
selTag = do
s <- many1 cssChar
return $ TagName s
selId :: Parser NameIdClassAttr
selId = do
char '#'
s <- many1 cssChar
return $ Id s
selClass :: Parser NameIdClassAttr
selClass = do
char '.'
s <- many1 cssChar
return $ Class s
selAttr :: Parser NameIdClassAttr
selAttr = do
char '['
k <- many1 cssChar
op <- optionMaybe attrOp
q <- optionMaybe (oneOf "\"'")
v <- optionMaybe $ many1 (noneOf (maybe "]" (:[]) q))
if isJust q then do
char (fromJust q)
else do
return ' '
char ']'
return (Attr k op v)
selNot :: Parser NameIdClassAttr
selNot = do
string ":not("
inners <- sepBy (choice [try selId, try selClass, try selTag, try selAttr, try selNot]) $ do
skipMany myspaces
char ','
skipMany myspaces
char ')'
return (Not inners)
myspaces = choice (map char " \t\r\n")
attrOp = choice $ map string ["=","|=","!=","*=","$=","^="]
cssChar = oneOf "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_"