{-# LANGUAGE OverloadedStrings #-}
module Yesod.Test.CssQuery
( SelectorGroup (..)
, Selector (..)
, parseQuery
) where
import Prelude hiding (takeWhile)
import Data.Text (Text)
import Data.Attoparsec.Text
import Control.Applicative
import Data.Char
import qualified Data.Text as T
data SelectorGroup
= DirectChildren [Selector]
| DeepChildren [Selector]
deriving (Int -> SelectorGroup -> ShowS
[SelectorGroup] -> ShowS
SelectorGroup -> String
(Int -> SelectorGroup -> ShowS)
-> (SelectorGroup -> String)
-> ([SelectorGroup] -> ShowS)
-> Show SelectorGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorGroup] -> ShowS
$cshowList :: [SelectorGroup] -> ShowS
show :: SelectorGroup -> String
$cshow :: SelectorGroup -> String
showsPrec :: Int -> SelectorGroup -> ShowS
$cshowsPrec :: Int -> SelectorGroup -> ShowS
Show, SelectorGroup -> SelectorGroup -> Bool
(SelectorGroup -> SelectorGroup -> Bool)
-> (SelectorGroup -> SelectorGroup -> Bool) -> Eq SelectorGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorGroup -> SelectorGroup -> Bool
$c/= :: SelectorGroup -> SelectorGroup -> Bool
== :: SelectorGroup -> SelectorGroup -> Bool
$c== :: SelectorGroup -> SelectorGroup -> Bool
Eq)
data Selector
= ById Text
| ByClass Text
| ByTagName Text
| ByAttrExists Text
| ByAttrEquals Text Text
| ByAttrContains Text Text
| ByAttrStarts Text Text
| ByAttrEnds Text Text
deriving (Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show, Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq)
parseQuery :: Text -> Either String [[SelectorGroup]]
parseQuery :: Text -> Either String [[SelectorGroup]]
parseQuery = Parser [[SelectorGroup]] -> Text -> Either String [[SelectorGroup]]
forall a. Parser a -> Text -> Either String a
parseOnly Parser [[SelectorGroup]]
cssQuery
cssQuery :: Parser [[SelectorGroup]]
cssQuery :: Parser [[SelectorGroup]]
cssQuery = Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Text Char
char Char
' ') Parser Text String
-> Parser [[SelectorGroup]] -> Parser [[SelectorGroup]]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text [SelectorGroup]
-> Parser Text String -> Parser [[SelectorGroup]]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Text [SelectorGroup]
rules (Char -> Parser Text Char
char Char
',' Parser Text Char -> Parser Text String -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Text Char
char Char
' '))
rules :: Parser [SelectorGroup]
rules :: Parser Text [SelectorGroup]
rules = Parser Text SelectorGroup -> Parser Text [SelectorGroup]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text SelectorGroup -> Parser Text [SelectorGroup])
-> Parser Text SelectorGroup -> Parser Text [SelectorGroup]
forall a b. (a -> b) -> a -> b
$ Parser Text SelectorGroup
directChildren Parser Text SelectorGroup
-> Parser Text SelectorGroup -> Parser Text SelectorGroup
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text SelectorGroup
deepChildren
directChildren :: Parser SelectorGroup
directChildren :: Parser Text SelectorGroup
directChildren =
Text -> Parser Text
string Text
"> " Parser Text -> Parser Text String -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Text Char
char Char
' ')) Parser Text String
-> Parser Text SelectorGroup -> Parser Text SelectorGroup
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Selector] -> SelectorGroup
DirectChildren ([Selector] -> SelectorGroup)
-> Parser Text [Selector] -> Parser Text SelectorGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Selector] -> Parser Text [Selector]
forall a. Parser a -> Parser a
pOptionalTrailingSpace Parser Text [Selector]
parseSelectors
deepChildren :: Parser SelectorGroup
deepChildren :: Parser Text SelectorGroup
deepChildren = Parser Text SelectorGroup -> Parser Text SelectorGroup
forall a. Parser a -> Parser a
pOptionalTrailingSpace (Parser Text SelectorGroup -> Parser Text SelectorGroup)
-> Parser Text SelectorGroup -> Parser Text SelectorGroup
forall a b. (a -> b) -> a -> b
$ [Selector] -> SelectorGroup
DeepChildren ([Selector] -> SelectorGroup)
-> Parser Text [Selector] -> Parser Text SelectorGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Selector]
parseSelectors
parseSelectors :: Parser [Selector]
parseSelectors :: Parser Text [Selector]
parseSelectors = Parser Text Selector -> Parser Text [Selector]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser Text Selector -> Parser Text [Selector])
-> Parser Text Selector -> Parser Text [Selector]
forall a b. (a -> b) -> a -> b
$
Parser Text Selector
parseId Parser Text Selector
-> Parser Text Selector -> Parser Text Selector
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Selector
parseClass Parser Text Selector
-> Parser Text Selector -> Parser Text Selector
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Selector
parseTag Parser Text Selector
-> Parser Text Selector -> Parser Text Selector
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Selector
parseAttr
parseId :: Parser Selector
parseId :: Parser Text Selector
parseId = Char -> Parser Text Char
char Char
'#' Parser Text Char -> Parser Text Selector -> Parser Text Selector
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Selector
ById (Text -> Selector) -> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent
parseClass :: Parser Selector
parseClass :: Parser Text Selector
parseClass = Char -> Parser Text Char
char Char
'.' Parser Text Char -> Parser Text Selector -> Parser Text Selector
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Selector
ByClass (Text -> Selector) -> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent
parseTag :: Parser Selector
parseTag :: Parser Text Selector
parseTag = Text -> Selector
ByTagName (Text -> Selector) -> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent
parseAttr :: Parser Selector
parseAttr :: Parser Text Selector
parseAttr = Parser Text Selector -> Parser Text Selector
forall a. Parser a -> Parser a
pSquare (Parser Text Selector -> Parser Text Selector)
-> Parser Text Selector -> Parser Text Selector
forall a b. (a -> b) -> a -> b
$ [Parser Text Selector] -> Parser Text Selector
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
[ Text -> Text -> Selector
ByAttrEquals (Text -> Text -> Selector)
-> Parser Text -> Parser Text (Text -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent Parser Text (Text -> Selector)
-> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
"=" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
pAttrValue)
, Text -> Text -> Selector
ByAttrContains (Text -> Text -> Selector)
-> Parser Text -> Parser Text (Text -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent Parser Text (Text -> Selector)
-> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
"*=" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
pAttrValue)
, Text -> Text -> Selector
ByAttrStarts (Text -> Text -> Selector)
-> Parser Text -> Parser Text (Text -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent Parser Text (Text -> Selector)
-> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
"^=" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
pAttrValue)
, Text -> Text -> Selector
ByAttrEnds (Text -> Text -> Selector)
-> Parser Text -> Parser Text (Text -> Selector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent Parser Text (Text -> Selector)
-> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
string Text
"$=" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
pAttrValue)
, Text -> Selector
ByAttrExists (Text -> Selector) -> Parser Text -> Parser Text Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pIdent
]
pIdent :: Parser Text
pIdent :: Parser Text
pIdent = do
Text
leadingMinus <- Text -> Parser Text
string Text
"-" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
Text
nmstart <- Char -> Text
T.singleton (Char -> Text) -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Char
satisfy (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
Text
nmchar <- (Char -> Bool) -> Parser Text
takeWhile (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
leadingMinus, Text
nmstart, Text
nmchar ]
pAttrValue :: Parser Text
pAttrValue :: Parser Text
pAttrValue = (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
pSquare :: Parser a -> Parser a
pSquare :: Parser a -> Parser a
pSquare Parser a
p = Char -> Parser Text Char
char Char
'[' Parser Text Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser Text Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
']'
pOptionalTrailingSpace :: Parser a -> Parser a
pOptionalTrailingSpace :: Parser a -> Parser a
pOptionalTrailingSpace Parser a
p = Parser a
p Parser a -> Parser Text String -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Text Char
char Char
' ')