104 lines
2.7 KiB
Haskell
104 lines
2.7 KiB
Haskell
-- | Parsing CSS selectors into queries.
|
|
module Yesod.Test.CssQuery
|
|
( SelectorGroup (..)
|
|
, Selector (..)
|
|
, parseQuery
|
|
) where
|
|
|
|
import Text.ParserCombinators.Parsec
|
|
import Text.Parsec.Prim (Parsec)
|
|
|
|
data SelectorGroup
|
|
= DirectChildren [Selector]
|
|
| DeepChildren [Selector]
|
|
deriving (Show, Eq)
|
|
|
|
data Selector
|
|
= ById String
|
|
| ByClass String
|
|
| ByTagName String
|
|
| ByAttrExists String
|
|
| ByAttrEquals String String
|
|
| ByAttrContains String String
|
|
| ByAttrStarts String String
|
|
| ByAttrEnds String String
|
|
deriving (Show, Eq)
|
|
|
|
-- | Parses a query into an intermediate format which is easy to feed to HXT
|
|
--
|
|
-- * The top-level lists represent the top level comma separated queries.
|
|
--
|
|
-- * SelectorGroup is a group of qualifiers which are separated
|
|
-- with spaces or > like these three: /table.main.odd tr.even > td.big/
|
|
--
|
|
-- * A SelectorGroup as a list of Selector items, following the above example
|
|
-- the selectors in the group are: /table/, /.main/ and /.odd/
|
|
parseQuery :: String -> Either ParseError [[SelectorGroup]]
|
|
parseQuery = parse cssQuery ""
|
|
|
|
-- Below this line is the Parsec parser for css queries.
|
|
cssQuery :: Parsec String u [[SelectorGroup]]
|
|
cssQuery = sepBy rules (char ',' >> (optional (char ' ')))
|
|
|
|
rules :: Parsec String u [SelectorGroup]
|
|
rules = many $ directChildren <|> deepChildren
|
|
|
|
directChildren :: Parsec String u SelectorGroup
|
|
directChildren = do
|
|
_ <- char '>'
|
|
_ <- char ' '
|
|
sels <- selectors
|
|
optional $ char ' '
|
|
return $ DirectChildren sels
|
|
|
|
deepChildren :: Parsec String u SelectorGroup
|
|
deepChildren = do
|
|
sels <- selectors
|
|
optional $ char ' '
|
|
return $ DeepChildren sels
|
|
|
|
selectors :: Parsec String u [Selector]
|
|
selectors = many1 $ parseId
|
|
<|> parseClass
|
|
<|> parseTag
|
|
<|> parseAttr
|
|
|
|
parseId :: Parsec String u Selector
|
|
parseId = do
|
|
_ <- char '#'
|
|
x <- many $ noneOf ",#.[ >"
|
|
return $ ById x
|
|
|
|
parseClass :: Parsec String u Selector
|
|
parseClass = do
|
|
_ <- char '.'
|
|
x <- many $ noneOf ",#.[ >"
|
|
return $ ByClass x
|
|
|
|
parseTag :: Parsec String u Selector
|
|
parseTag = do
|
|
x <- many1 $ noneOf ",#.[ >"
|
|
return $ ByTagName x
|
|
|
|
parseAttr :: Parsec String u Selector
|
|
parseAttr = do
|
|
_ <- char '['
|
|
name <- many $ noneOf ",#.=$^*]"
|
|
(parseAttrExists name)
|
|
<|> (parseAttrWith "=" ByAttrEquals name)
|
|
<|> (parseAttrWith "*=" ByAttrContains name)
|
|
<|> (parseAttrWith "^=" ByAttrStarts name)
|
|
<|> (parseAttrWith "$=" ByAttrEnds name)
|
|
|
|
parseAttrExists :: String -> Parsec String u Selector
|
|
parseAttrExists attrname = do
|
|
_ <- char ']'
|
|
return $ ByAttrExists attrname
|
|
|
|
parseAttrWith :: String -> (String -> String -> Selector) -> String -> Parsec String u Selector
|
|
parseAttrWith sign constructor name = do
|
|
_ <- string sign
|
|
value <- many $ noneOf ",#.]"
|
|
_ <- char ']'
|
|
return $ constructor name value
|