Revert "yesod-test: Improve CSS selector parser."

This reverts commit 581a688cf5.

yesod-test/Yesod/Test/CssQuery.hs

@@ -9,10 +9,7 @@ module Yesod.Test.CssQuery
 import Prelude hiding (takeWhile)
 import Data.Text (Text)
 import Data.Attoparsec.Text
-import Control.Applicative
+import Control.Applicative (many, (<|>), optional)
-import Data.Char
-
-import qualified Data.Text as T
 
 data SelectorGroup
   = DirectChildren [Selector]
@@ -30,13 +27,6 @@ data Selector
   | ByAttrEnds Text Text
   deriving (Show, 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.
@@ -51,54 +41,66 @@ parseQuery = parseOnly cssQuery
 
 -- Below this line is the Parsec parser for css queries.
 cssQuery :: Parser [[SelectorGroup]]
-cssQuery = sepBy rules (char ',' >> optional (char ' '))
+cssQuery = sepBy rules (char ',' >> (optional (char ' ')))
 
 rules :: Parser [SelectorGroup]
 rules = many $ directChildren <|> deepChildren
 
 directChildren :: Parser SelectorGroup
-directChildren = string "> " >> DirectChildren <$> parseSelectors
+directChildren = do
+  _ <- char '>'
+  _ <- char ' '
+  sels <- selectors
+  _ <- optional $ char ' '
+  return $ DirectChildren sels
 
 deepChildren :: Parser SelectorGroup
-deepChildren = DeepChildren <$> parseSelectors
+deepChildren = do 
-
+  sels <- selectors
-parseSelectors :: Parser [Selector]
+  _ <- optional $ char ' '
-parseSelectors = pOptionalTrailingSpace . many1 $
+  return $ DeepChildren sels
-    parseId <|> parseClass <|> parseTag <|> parseAttr
+  
+selectors :: Parser [Selector]
+selectors = many1 $ parseId
+  <|> parseClass
+  <|> parseTag
+  <|> parseAttr
 
 parseId :: Parser Selector
-parseId = char '#' >> ById <$> pIdent
+parseId = do
+  _ <- char '#'
+  x <- takeWhile $ flip notElem ",#.[ >"
+  return $ ById x
 
 parseClass :: Parser Selector
-parseClass = char '.' >> ByClass <$> pIdent
+parseClass = do
+  _ <- char '.'
+  x <- takeWhile $ flip notElem ",#.[ >"
+  return $ ByClass x
 
 parseTag :: Parser Selector
-parseTag = ByTagName <$> pIdent
+parseTag = do
+  x <- takeWhile1 $ flip notElem ",#.[ >"
+  return $ ByTagName x
 
 parseAttr :: Parser Selector
-parseAttr = pSquare $ choice
+parseAttr = do
-    [ ByAttrEquals <$> pIdent <*> (string "=" *> pAttrValue)
+  _ <- char '['
-    , ByAttrContains <$> pIdent <*> (string "*=" *> pAttrValue)
+  name <- takeWhile $ flip notElem ",#.=$^*]"
-    , ByAttrStarts <$> pIdent <*> (string "^=" *> pAttrValue)
+  (parseAttrExists name)
-    , ByAttrEnds <$> pIdent <*> (string "$=" *> pAttrValue)
+    <|> (parseAttrWith "=" ByAttrEquals name)
-    , ByAttrExists <$> pIdent
+    <|> (parseAttrWith "*=" ByAttrContains name)
-    ]
+    <|> (parseAttrWith "^=" ByAttrStarts name)
+    <|> (parseAttrWith "$=" ByAttrEnds name)
 
--- | pIdent : Parse an identifier (not yet supporting escapes and unicode as
+parseAttrExists :: Text -> Parser Selector
--- part of the identifier). Basically the regex: [-]?[_a-zA-Z][_a-zA-Z0-9]*
+parseAttrExists attrname = do
-pIdent :: Parser Text
+  _ <- char ']'
-pIdent = pOptionalTrailingSpace $ do
+  return $ ByAttrExists attrname
-    leadingMinus <- string "-" <|> pure ""
-    nmstart <- T.singleton <$> satisfy (\c -> isAlpha c || c == '_')
-    nmchar <- takeWhile (\c -> isAlphaNum c || c == '_')
-    return $ T.concat [ leadingMinus, nmstart, nmchar ]
 
-
+parseAttrWith :: Text -> (Text -> Text -> Selector) -> Text -> Parser Selector
-pAttrValue :: Parser Text
+parseAttrWith sign constructor name = do
-pAttrValue = takeWhile (/= ']')
+  _ <- string sign
-
+  value <- takeWhile $ flip notElem ",#.]"
-pSquare :: Parser a -> Parser a
+  _ <- char ']'
-pSquare p = char '[' *> p <* char ']'
+  return $ constructor name value
-
-pOptionalTrailingSpace :: Parser a -> Parser a
-pOptionalTrailingSpace p = p <* optional (char ' ')