    {-# LANGUAGE OverloadedStrings #-}
    -- | Parsing CSS selectors into queries.
    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
    $cshowsPrec :: Int -> SelectorGroup -> ShowS
    showsPrec :: Int -> SelectorGroup -> ShowS
    $cshow :: SelectorGroup -> String
    show :: SelectorGroup -> String
    $cshowList :: [SelectorGroup] -> ShowS
    showList :: [SelectorGroup] -> ShowS
    Show, SelectorGroup -> SelectorGroup -> Bool
    (SelectorGroup -> SelectorGroup -> Bool)
    -> (SelectorGroup -> SelectorGroup -> Bool) -> Eq SelectorGroup
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SelectorGroup -> SelectorGroup -> Bool
    == :: SelectorGroup -> SelectorGroup -> Bool
    $c/= :: SelectorGroup -> SelectorGroup -> Bool
    /= :: 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
    $cshowsPrec :: Int -> Selector -> ShowS
    showsPrec :: Int -> Selector -> ShowS
    $cshow :: Selector -> String
    show :: Selector -> String
    $cshowList :: [Selector] -> ShowS
    showList :: [Selector] -> ShowS
    Show, Selector -> Selector -> Bool
    (Selector -> Selector -> Bool)
    -> (Selector -> Selector -> Bool) -> Eq Selector
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Selector -> Selector -> Bool
    == :: Selector -> Selector -> Bool
    $c/= :: Selector -> Selector -> Bool
    /= :: Selector -> Selector -> Bool
    Eq)

    -- The official syntax specification for CSS2 can be found here:
    --      http://www.w3.org/TR/CSS2/syndata.html
    -- but that spec is tricky to fully support. Instead we do the minimal and we
    -- can extend it as needed.

    -- | 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 :: 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

    -- Below this line is the Parsec parser for css queries.
    cssQuery :: Parser [[SelectorGroup]]
    cssQuery :: Parser [[SelectorGroup]]
    cssQuery = Parser Text Char -> Parser Text String
    forall a. Parser Text a -> Parser Text [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (Char -> Parser Text Char
    char Char
    ' ') Parser Text String
    -> Parser [[SelectorGroup]] -> Parser [[SelectorGroup]]
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Parser Text Char -> Parser Text String
    forall a. Parser Text a -> Parser Text [a]
    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 a. Parser Text a -> Parser Text [a]
    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 a. Parser Text a -> Parser Text a -> Parser Text a
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Parser Text Char -> Parser Text String
    forall a. Parser Text a -> Parser Text [a]
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a. Parser Text a -> Parser Text a -> Parser Text a
    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 a. Parser Text a -> Parser Text a -> Parser Text a
    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 a. Parser Text a -> Parser Text a -> Parser Text a
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
    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 a b. Parser Text a -> Parser Text b -> Parser Text b
    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 : Parse an identifier (not yet supporting escapes and unicode as
    -- part of the identifier). Basically the regex: [-]?[_a-zA-Z][_a-zA-Z0-9]*
    pIdent :: Parser Text
    pIdent :: Parser Text
    pIdent = do
        leadingMinus <- Text -> Parser Text
    string Text
    "-" Parser Text -> Parser Text -> Parser Text
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Text -> Parser Text
    forall a. a -> Parser Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Text
    ""
        nmstart <- T.singleton <$> satisfy (\Char
    c -> Char -> Bool
    isAlpha Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_')
        nmchar <- 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
    '-')
        return $ T.concat [ leadingMinus, nmstart, 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 :: forall a. Parser a -> Parser a
    pSquare Parser a
    p = Char -> Parser Text Char
    char Char
    '[' Parser Text Char -> Parser a -> Parser a
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser a
    p Parser a -> Parser Text Char -> Parser a
    forall a b. Parser Text a -> Parser Text b -> Parser Text 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 :: forall a. Parser a -> Parser a
    pOptionalTrailingSpace Parser a
    p = Parser a
    p Parser a -> Parser Text String -> Parser a
    forall a b. Parser Text a -> Parser Text b -> Parser Text a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser Text Char -> Parser Text String
    forall a. Parser Text a -> Parser Text [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (Char -> Parser Text Char
    char Char
    ' ')