yesod-test 1.4.0.1 → 1.4.0.2

raw patch · 3 files changed

+56/−46 lines, 3 files

Files

• Yesod/Test/CssQuery.hs +47/−45
• test/main.hs +8/−0
• yesod-test.cabal +1/−1

@@ -9,10 +9,7 @@ import Prelude hiding (takeWhile) import Data.Text (Text) import Data.Attoparsec.Text-import Control.Applicative-import Data.Char--import qualified Data.Text as T+import Control.Applicative (many, (<|>), optional)  data SelectorGroup   = DirectChildren [Selector]@@ -30,13 +27,6 @@   | 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 @@  -- 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 = pOptionalTrailingSpace $ DeepChildren <$> parseSelectors--parseSelectors :: Parser [Selector]-parseSelectors = many1 $-    parseId <|> parseClass <|> parseTag <|> parseAttr+deepChildren = do +  sels <- selectors+  _ <- optional $ char ' '+  return $ DeepChildren sels+  +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-    [ ByAttrEquals <$> pIdent <*> (string "=" *> pAttrValue)-    , ByAttrContains <$> pIdent <*> (string "*=" *> pAttrValue)-    , ByAttrStarts <$> pIdent <*> (string "^=" *> pAttrValue)-    , ByAttrEnds <$> pIdent <*> (string "$=" *> pAttrValue)-    , ByAttrExists <$> 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 = do-    leadingMinus <- string "-" <|> pure ""-    nmstart <- T.singleton <$> satisfy (\c -> isAlpha c || c == '_')-    nmchar <- takeWhile (\c -> isAlphaNum c || c == '_')-    return $ T.concat [ leadingMinus, nmstart, nmchar ]---pAttrValue :: Parser Text-pAttrValue = takeWhile (/= ']')+parseAttr = do+  _ <- char '['+  name <- takeWhile $ flip notElem ",#.=$^*]"+  (parseAttrExists name)+    <|> (parseAttrWith "=" ByAttrEquals name)+    <|> (parseAttrWith "*=" ByAttrContains name)+    <|> (parseAttrWith "^=" ByAttrStarts name)+    <|> (parseAttrWith "$=" ByAttrEnds name) -pSquare :: Parser a -> Parser a-pSquare p = char '[' *> p <* char ']'+parseAttrExists :: Text -> Parser Selector+parseAttrExists attrname = do+  _ <- char ']'+  return $ ByAttrExists attrname -pOptionalTrailingSpace :: Parser a -> Parser a-pOptionalTrailingSpace p = p <* optional (char ' ')+parseAttrWith :: Text -> (Text -> Text -> Selector) -> Text -> Parser Selector+parseAttrWith sign constructor name = do+  _ <- string sign+  value <- takeWhile $ flip notElem ",#.]"+  _ <- char ']'+  return $ constructor name value

@@ -44,6 +44,14 @@             html = "<input name='_token' type='hidden' value='foo'><form class='foo'><input name='_token' type='hidden' value='bar'></form>"             expected = "<input name=\"_token\" type=\"hidden\" value=\"bar\" />"          in it query $ findBySelector_ html (pack query) @?= [expected]+        it "descendents and children" $+            let html = "<html><p><b><i><u>hello</u></i></b></p></html>"+                query = "p > b u"+             in findBySelector_ html query @?= ["<u>hello</u>"]+        it "hyphenated classes" $+            let html = "<html><p class='foo-bar'><b><i><u>hello</u></i></b></p></html>"+                query = "p.foo-bar u"+             in findBySelector_ html query @?= ["<u>hello</u>"]         it "descendents" $             let html = "<html><p><b><i>hello</i></b></p></html>"                 query = "p i"

@@ -1,5 +1,5 @@ name:               yesod-test-version:            1.4.0.1+version:            1.4.0.2 license:            MIT license-file:       LICENSE author:             Nubis <nubis@woobiz.com.ar>