yesod-test (empty) → 0.1
raw patch · 6 files changed
+698/−0 lines, 6 filesdep +HUnitdep +basedep +bytestringsetup-changed
Dependencies added: HUnit, base, bytestring, hspec, http-types, hxt, network, parsec, persistent, text, transformers, wai, wai-test
Files
- LICENSE +25/−0
- README.md +75/−0
- Setup.lhs +7/−0
- Yesod/Test.hs +372/−0
- Yesod/Test/TransversingCSS.hs +177/−0
- yesod-test.cabal +42/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Nubis. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,75 @@+# TestWaiPersistent - Pragmatic integration tests for haskell web applications using WAI and Persistent + +yesod-test is designed for testing web applications built using wai and persistent. +It's main goal is to encourage integration and system testing of web applications by making everything /easy to test/. + +Your tests are like browser sessions that keep track of cookies and the last +visited page. You can perform assertions on the content of HTML responses, +using css selectors to explore the document more easily. + +You can also easily build requests using forms present in the current page. +This is very useful for testing web applications built in yesod for example, +were your forms may have field names generated by the framework or a randomly +generated "\_token" field. + +Your database is also directly available so you can use runDB to set up +backend pre-conditions, or to assert that your session is having the desired effect. + +The testing facilities behind the scenes are HUnit and HSpec. + +This is the helloworld and kitchen sink. In this case for testing a yesod app. + +```haskell + + import Yesod + import Yesod.Static + import qualified MySite.Settings as Settings + import MySite.Models + + main :: IO a + main = do + cfg <- (loadConfig Test) >>= either fail return + st <- static Settings.staticDir + Settings.withConnectionPool (connStr cfg) $ \cnPool -> do + -- ... Perhaps some code here to truncate your test database? + app <- toWaiApp $ MyApp st cfg + runTests app cnPool $ mySuite + + mySuite = do + describe "Basic navigation and assertions" $ do + it "Gets a page that has a form, with auto generated fields and token" $ do + get_ "url/of/page/with/form" -- Load a page + statusIs 200 -- Assert the status was success + + bodyContains "Hello Person" -- Assert any part of the document contains some text. + + -- Perform a css queries and assertions. + htmlCount "form .main" 1 -- It matches 1 element + htmlAllContain "h1#mainTitle" "Sign Up Now!" -- All matches have some text + + -- Performs the post using the current page to extract field values: + post "url/to/post/to" $ do + addNonce -- Add the _nonce field with the currently shown value + + -- Lookup field by the text on the labels pointing to them. + byLabel "Email:" "gustavo@cerati.com" + byLabel "Password:" "secret" + byLabel "Confirm:" "secret" + + it "Sends another form, this one has a file" $ do + post "url/to/post/file/to" $ do + -- You can add files this easy, you still have to provide the mime type manually though. + addFile "file_field_name" "path/to/local/file" "image/jpeg" + + -- And of course you can add any field if you know it's name + byName "answer" "42" + + statusIs 302 + + describe "Db access, still very raw" $ do + it "selects the list" $ do + msgs <- testDB $ do (selectList [] [] :: SqlPersist IO [(Key SqlPersist Message, Message)]) + assertEqual "One Message in the DB" 1 (DL.length msgs) + +``` +
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ Yesod/Test.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-|+Yesod.Test is a pragmatic framework for testing web applications built+using wai and persistent.++By pragmatic I may also mean 'dirty'. It's main goal is to encourage integration+and system testing of web applications by making everything /easy to test/. ++Your tests are like browser sessions that keep track of cookies and the last+visited page. You can perform assertions on the content of HTML responses,+using css selectors to explore the document more easily.++You can also easily build requests using forms present in the current page.+This is very useful for testing web applications built in yesod for example,+were your forms may have field names generated by the framework or a randomly+generated '_nonce' field.++Your database is also directly available so you can use runDB to set up+backend pre-conditions, or to assert that your session is having the desired effect.++-}++module Yesod.Test (+ -- * Declaring and running your test suite+ runTests, describe, it, Specs, OneSpec,++ -- * Making requests+ -- | To make a request you need to point to an url and pass in some parameters.+ --+ -- To build your parameters you will use the RequestBuilder monad that lets you+ -- add values, add files, lookup fields by label and find the current+ -- nonce value and add it to your request too.+ -- + post, post_, get, get_, doRequest,+ byName, fileByName,++ -- | Yesod cat auto generate field ids, so you are never sure what+ -- the argument name should be for each one of your args when constructing+ -- your requests. What you do know is the /label/ of the field.+ -- These functions let you add parameters to your request based+ -- on currently displayed label names.+ byLabel, fileByLabel,++ -- | Does the current form have a _nonce? Use any of these to add it to your+ -- request parameters.+ addNonce, addNonce_,++ -- * Running database queries+ runDB,++ -- * Assertions+ assertEqual, statusIs, bodyContains, htmlAllContain, htmlCount,++ -- * Utils for debugging tests+ printBody, printMatches,++ -- * Utils for building your own assertions+ -- | Please consider generalizing and contributing the assertions you write.+ htmlQuery, parseHTML++)++where++import qualified Test.Hspec.Core as Core+import qualified Test.Hspec.Runner as Runner+import qualified Data.List as DL+import qualified Data.Maybe as DY+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Test.HUnit as HUnit+import qualified Test.Hspec.HUnit ()+import qualified Network.HTTP.Types as H+import qualified Network.Socket.Internal as Sock+import Text.XML.HXT.Core hiding (app, err)+import Network.Wai+import Network.Wai.Test+import qualified Control.Monad.Trans.State as ST+import Control.Monad.IO.Class+import System.IO+import Yesod.Test.TransversingCSS+import Database.Persist.GenericSql++-- | The state used in 'describe' to build a list of specs+data SpecsData = SpecsData Application ConnectionPool [Core.Spec]++-- | The specs state monad is where 'describe' runs.+type Specs = ST.StateT SpecsData IO ()++-- | The state used in a single test case defined using 'it'+data OneSpecData = OneSpecData Application ConnectionPool CookieValue (Maybe SResponse)++-- | The OneSpec state monad is where 'it' runs.+type OneSpec = ST.StateT OneSpecData IO++data RequestBuilderData = RequestBuilderData [RequestPart] (Maybe SResponse)++-- | Request parts let us discern regular key/values from files sent in the request.+data RequestPart+ = ReqPlainPart String String+ | ReqFilePart String FilePath BSL8.ByteString String++-- | The RequestBuilder state monad constructs an url encoded string of arguments+-- to send with your requests. Some of the functions that run on it use the current+-- response to analize the forms that the server is expecting to receive.+type RequestBuilder = ST.StateT RequestBuilderData IO++-- | Both the OneSpec and RequestBuilder monads hold a response that can be analized,+-- by making them instances of this class we can have general methods that work on+-- the last received response.+class HoldsResponse a where+ readResponse :: a -> Maybe SResponse+instance HoldsResponse OneSpecData where+ readResponse (OneSpecData _ _ _ x) = x+instance HoldsResponse RequestBuilderData where+ readResponse (RequestBuilderData _ x) = x+ +type CookieValue = H.Ascii++-- | Runs your test suite, using you wai 'Application' and 'ConnectionPool' for performing +-- the database queries in your tests.+--+-- You application may already have your connection pool but you need to pass another one+-- separately here.+-- +-- Look at the examples directory on this package to get an idea of the (small) amount of+-- boilerplate code you'll need to write before calling this.+runTests :: Application -> ConnectionPool -> Specs -> IO a+runTests app connection specsDef = do+ (SpecsData _ _ specs) <- ST.execStateT specsDef (SpecsData app connection [])+ Runner.hspecX specs++-- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'+-- and 'ConnectionPool'+describe :: String -> Specs -> Specs+describe label action = do+ sData <- ST.get+ SpecsData app conn specs <- liftIO $ ST.execStateT action sData+ ST.put $ SpecsData app conn (Core.describe label [specs])++-- | Describe a single test that keeps cookies, and a reference to the last response.+it :: String -> OneSpec () -> Specs+it label action = do+ SpecsData app conn specs <- ST.get+ let spec = Core.it label $ do+ _ <- ST.execStateT action $ OneSpecData app conn "" Nothing+ return ()+ ST.put $ SpecsData app conn (specs++spec)++-- Performs a given action using the last response.+withResponse :: HoldsResponse a => (SResponse -> ST.StateT a IO b) -> ST.StateT a IO b+withResponse f = maybe err f =<< fmap readResponse ST.get+ where err = failure "There was no response, you should make a request"++-- | Use HXT to parse a value from an html tag.+-- Check for usage examples in this module's source.+parseHTML :: String -> LA XmlTree a -> [a]+parseHTML html p = runLA (hread >>> p ) html++-- | Query the last response using css selectors, returns a list of matched fragments+htmlQuery :: HoldsResponse a => Query -> ST.StateT a IO [Html]+htmlQuery query = withResponse $ \ res ->+ case findBySelector (BSL8.unpack $ simpleBody res) query of+ Left err -> failure $ query ++ " did not parse: " ++ (show err)+ Right matches -> return matches++-- | Asserts that the two given values are equal.+assertEqual :: (Eq a) => String -> a -> a -> OneSpec ()+assertEqual msg a b = liftIO $ HUnit.assertBool msg (a == b)++-- | Assert the last response status is as expected.+statusIs :: HoldsResponse a => Int -> ST.StateT a IO ()+statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->+ liftIO $ flip HUnit.assertBool (H.statusCode s == number) $ concat+ [ "Expected status was ", show number+ , " but received status was ", show $ H.statusCode s+ ]++-- | Assert the last response has the given text. The check is performed using the response+-- body in full text form.+bodyContains :: HoldsResponse a => String -> ST.StateT a IO ()+bodyContains text = withResponse $ \ res ->+ liftIO $ HUnit.assertBool ("Expected body to contain " ++ text) $+ (simpleBody res) `contains` text++contains :: BSL8.ByteString -> String -> Bool+contains a b = DL.isInfixOf b (BSL8.unpack a)++-- | Queries the html using a css selector, and all matched elements must contain+-- the given string.+htmlAllContain :: HoldsResponse a => Query -> String -> ST.StateT a IO ()+htmlAllContain query search = do+ matches <- htmlQuery query+ case matches of+ [] -> failure $ "Nothing matched css query: "++query+ _ -> liftIO $ HUnit.assertBool ("Not all "++query++" contain "++search) $+ DL.all (DL.isInfixOf search) matches++-- | Performs a css query on the last response and asserts the matched elements+-- are as many as expected.+htmlCount :: HoldsResponse a => Query -> Int -> ST.StateT a IO ()+htmlCount query count = do+ matches <- fmap DL.length $ htmlQuery query+ liftIO $ flip HUnit.assertBool (matches == count)+ ("Expected "++(show count)++" elements to match "++query++", found "++(show matches))++-- | Outputs the last response body to stderr (So it doesn't get captured by HSpec)+printBody :: HoldsResponse a => ST.StateT a IO ()+printBody = withResponse $ \ SResponse { simpleBody = b } -> + liftIO $ hPutStrLn stderr $ BSL8.unpack b++-- | Performs a CSS query and print the matches to stderr.+printMatches :: HoldsResponse a => Query -> ST.StateT a IO ()+printMatches query = do+ matches <- htmlQuery query+ liftIO $ hPutStrLn stderr $ show matches++-- | Add a parameter with the given name and value.+byName :: String -> String -> RequestBuilder ()+byName name value = do+ RequestBuilderData parts r <- ST.get+ ST.put $ RequestBuilderData ((ReqPlainPart name value):parts) r++-- | Add a file to be posted with the current request+--+-- Adding a file will automatically change your request content-type to be multipart/form-data+fileByName :: String -> FilePath -> String -> RequestBuilder ()+fileByName name path mimetype = do+ RequestBuilderData parts r <- ST.get+ contents <- liftIO $ BSL8.readFile path+ ST.put $ RequestBuilderData ((ReqFilePart name path contents mimetype):parts) r++-- This looks up the name of a field based on the contents of the label pointing to it.+nameFromLabel :: String -> RequestBuilder String+nameFromLabel label = withResponse $ \ res -> do+ let+ body = BSL8.unpack $ simpleBody res+ escaped = escapeHtmlEntities label+ mfor = parseHTML body $ deep $ hasName "label"+ >>> filterA (xshow this >>> mkText >>> hasText (DL.isInfixOf escaped))+ >>> getAttrValue "for"++ case mfor of+ for:[] -> do+ let mname = parseHTML body $ deep $ hasAttrValue "id" (==for) >>> getAttrValue "name"+ case mname of+ "":_ -> failure $ "Label "++label++" resolved to id "++for++" which was not found. "+ name:_ -> return name+ _ -> failure $ "More than one input with id " ++ for+ [] -> failure $ "No label contained: "++label+ _ -> failure $ "More than one label contained "++label++-- | Escape HTML entities in a string, so you can write the text you want in+-- label lookups without worrying about the fact that yesod escapes some characters.+escapeHtmlEntities :: String -> String +escapeHtmlEntities "" = ""+escapeHtmlEntities (c:cs) = case c of+ '<' -> '&' : 'l' : 't' : ';' : escapeHtmlEntities cs+ '>' -> '&' : 'g' : 't' : ';' : escapeHtmlEntities cs+ '&' -> '&' : 'a' : 'm' : 'p' : ';' : escapeHtmlEntities cs+ '"' -> '&' : 'q' : 'u' : 'o' : 't' : ';' : escapeHtmlEntities cs+ '\'' -> '&' : '#' : '3' : '9' : ';' : escapeHtmlEntities cs+ x -> x : escapeHtmlEntities cs++byLabel :: String -> String -> RequestBuilder ()+byLabel label value = do+ name <- nameFromLabel label+ byName name value++fileByLabel :: String -> FilePath -> String -> RequestBuilder ()+fileByLabel label path mime = do+ name <- nameFromLabel label+ fileByName name path mime++-- | Lookup a _nonce form field and add it's value to the params. +-- Receives a CSS selector that should resolve to the form element containing the nonce.+addNonce_ :: String -> RequestBuilder ()+addNonce_ scope = do+ matches <- htmlQuery $ scope ++ "input[name=_nonce][type=hidden][value]"+ case matches of+ [] -> failure $ "No nonce found in the current page"+ element:[] -> byName "_nonce" $ head $ parseHTML element $ getAttrValue "value"+ _ -> failure $ "More than one nonce found in the page"++-- | For responses that display a single form, just lookup the only nonce available.+addNonce :: RequestBuilder ()+addNonce = addNonce_ ""++-- | Perform a POST request to url, using params+post :: BS8.ByteString -> RequestBuilder () -> OneSpec ()+post url paramsBuild = do+ doRequest "POST" url paramsBuild++-- | Perform a POST request without params+post_ :: BS8.ByteString -> OneSpec ()+post_ = flip post $ return ()+ +-- | Perform a GET request to url, using params+get :: BS8.ByteString -> RequestBuilder () -> OneSpec ()+get url paramsBuild = doRequest "GET" url paramsBuild++-- | Perform a GET request without params+get_ :: BS8.ByteString -> OneSpec ()+get_ = flip get $ return ()++-- | General interface to performing requests, letting you specify the request method and extra headers.+doRequest :: H.Method -> BS8.ByteString -> RequestBuilder a -> OneSpec ()+doRequest method url paramsBuild = do+ OneSpecData app conn cookie mRes <- ST.get+ RequestBuilderData parts _ <- liftIO $ ST.execStateT paramsBuild $ RequestBuilderData [] mRes+ let req = if DL.any isFile parts+ then makeMultipart cookie parts+ else makeSinglepart cookie parts++ response <- liftIO $ runSession (srequest req) app+ let cookie' = DY.fromMaybe cookie $ fmap snd $ DL.find (("Set-Cookie"==) . fst) $ simpleHeaders response+ ST.put $ OneSpecData app conn cookie' (Just response)+ where+ isFile (ReqFilePart _ _ _ _) = True+ isFile _ = False++ -- For building the multi-part requests+ boundary :: String+ boundary = "*******noneedtomakethisrandom"+ separator = BS8.concat ["--", BS8.pack boundary, "\r\n"]+ makeMultipart cookie parts =+ flip SRequest (BSL8.fromChunks [multiPartBody parts]) $ mkRequest+ [ ("Cookie", cookie)+ , ("Content-Type", BS8.pack $ "multipart/form-data; boundary=" ++ boundary)]+ multiPartBody parts =+ BS8.concat $ separator : [BS8.concat [multipartPart p, separator] | p <- parts]+ multipartPart (ReqPlainPart k v) = BS8.concat+ [ "Content-Disposition: form-data; "+ , "name=\"", (BS8.pack k), "\"\r\n\r\n"+ , (BS8.pack v), "\r\n"]+ multipartPart (ReqFilePart k v bytes mime) = BS8.concat+ [ "Content-Disposition: form-data; "+ , "name=\"", BS8.pack k, "\"; "+ , "filename=\"", BS8.pack v, "\"\r\n"+ , "Content-Type: ", BS8.pack mime, "\r\n\r\n"+ , BS8.concat $ BSL8.toChunks bytes, "\r\n"]++ -- For building the regular non-multipart requests+ makeSinglepart cookie parts = SRequest (mkRequest + [("Cookie",cookie), ("Content-Type", "application/x-www-form-urlencoded")]) $+ BSL8.pack $ DL.concat $ DL.intersperse "&" $ map singlepartPart parts++ singlepartPart (ReqFilePart _ _ _ _) = ""+ singlepartPart (ReqPlainPart k v) = concat [k,"=",v]++ -- General request making + mkRequest headers = defaultRequest+ { requestMethod = method+ , remoteHost = Sock.SockAddrInet 1 2+ , requestHeaders = headers+ , rawPathInfo = url+ , pathInfo = DL.filter (/="") $ T.split (== '/') $ TE.decodeUtf8 url+ }+ +-- | Run a persistent db query. For asserting on the results of performed actions+-- or setting up pre-conditions. At the moment this part is still very raw.+runDB :: SqlPersist IO a -> OneSpec a+runDB query = do+ OneSpecData _ pool _ _ <- ST.get+ liftIO $ runSqlPool query pool++-- Yes, just a shortcut+failure :: (MonadIO a) => String -> a b+failure reason = (liftIO $ HUnit.assertFailure reason) >> error ""
+ Yesod/Test/TransversingCSS.hs view
@@ -0,0 +1,177 @@+{- |+This module uses HXT to transverse an HTML document using CSS selectors.++The most important function here is 'findBySelector', it takes a CSS query and+a string containing the HTML to look into,+and it returns a list of the HTML fragments that matched the given query.++Only a subset of the CSS spec is currently supported:++ * By tag name: /table td a/+ + * By class names: /.container .content/++ * By Id: /#oneId/++ * By attribute: /[hasIt]/, /[exact=match]/, /[contains*=text]/, /[starts^=with]/, /[ends$=with]/+ + * Union: /a, span, p/+ + * Immediate children: /div > p/ ++ * Get jiggy with it: /div[data-attr=yeah] > .mon, .foo.bar div, #oneThing/++-}++module Yesod.Test.TransversingCSS (+ findBySelector,+ Html,+ Query,+ -- * For HXT hackers+ -- | These functions expose some low level details that you can blissfully ignore.+ parseQuery,+ runQuery,+ queryToArrow,+ Selector(..),+ SelectorGroup(..)++ )+where++import Text.XML.HXT.Core+import qualified Data.List as DL+import Text.ParserCombinators.Parsec+import Text.Parsec.Prim (Parsec)++type Html = String+type Query = String+ +-- | Perform a css 'Query' on 'Html'. Returns Either+--+-- * Left: Query parse error.+--+-- * Right: List of matching Html fragments.+findBySelector :: Html-> Query -> Either ParseError [Html]+findBySelector html query = fmap (runQuery html) (parseQuery query)++-- Run a compiled query on Html, returning a list of matching Html fragments.+runQuery :: Html -> [[SelectorGroup]] -> [Html]+runQuery html query =+ runLA (hread >>> (queryToArrow query) >>> xshow this) html++-- | Transform a compiled query into the HXT arrow that finally transverses the Html+queryToArrow :: ArrowXml a => [[SelectorGroup]] -> a XmlTree XmlTree+queryToArrow commaSeparated = + DL.foldl uniteCommaSeparated none commaSeparated+ where+ uniteCommaSeparated accum selectorGroups =+ accum <+> (DL.foldl sequenceSelectorGroups this selectorGroups)+ sequenceSelectorGroups accum (DirectChildren sels) =+ accum >>> getChildren >>> (DL.foldl applySelectors this $ sels)+ sequenceSelectorGroups accum (DeepChildren sels) =+ accum >>> getChildren >>> multi (DL.foldl applySelectors this $ sels)+ applySelectors accum selector = accum >>> (toArrow selector)+ toArrow selector = case selector of+ ById v -> hasAttrValue "id" (==v)+ ByClass v -> hasAttrValue "class" ((DL.elem v) . words)+ ByTagName v -> hasName v+ ByAttrExists n -> hasAttr n+ ByAttrEquals n v -> hasAttrValue n (==v)+ ByAttrContains n v -> hasAttrValue n (DL.isInfixOf v)+ ByAttrStarts n v -> hasAttrValue n (DL.isPrefixOf v)+ ByAttrEnds n v -> hasAttrValue n (DL.isSuffixOf v)++-- | 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 "" ++data SelectorGroup + = DirectChildren [Selector]+ | DeepChildren [Selector]+ deriving Show++data Selector+ = ById String+ | ByClass String+ | ByTagName String+ | ByAttrExists String+ | ByAttrEquals String String+ | ByAttrContains String String+ | ByAttrStarts String String+ | ByAttrEnds String String+ deriving Show++-- 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+
+ yesod-test.cabal view
@@ -0,0 +1,42 @@+name: yesod-test+version: 0.1+license: BSD3+license-file: LICENSE+author: Nubis <nubis@woobiz.com.ar>+maintainer: Nubis <nubis@woobiz.com.ar>+synopsis: integration testing for WAI/Yesod Applications +category: Web, Yesod, Testing+stability: Experimental+cabal-version: >= 1.6+build-type: Simple+homepage: http://www.yesodweb.com+description: Behaviour Oriented integration Testing for Yesod Applications +extra-source-files: README.md, LICENSE++flag ghc7++library+ if flag(ghc7)+ build-depends: base >= 4.3 && < 5+ cpp-options: -DGHC7+ else+ build-depends: base >= 4 && < 4.3+ build-depends: hxt >= 9.1.6+ , parsec >= 2.1 && < 4+ , persistent >= 0.8 && < 0.9+ , transformers >= 0.2.2 && < 0.3+ , wai >= 1.1 && < 1.2+ , wai-test >= 1.0 && < 2.0+ , network >= 2.2 && < 2.4+ , http-types >= 0.6 && < 0.7+ , HUnit >= 1.2 && < 1.3+ , hspec >= 0.9 && < 1.0+ , bytestring >= 0.9+ , text+ exposed-modules: Yesod.Test+ other-modules: Yesod.Test.TransversingCSS+ ghc-options: -Wall++source-repository head+ type: git+ location: git://github.com/yesodweb/yesod.git