integrated yesod tests to scaffolder. still work in progress

package-list.sh

@@ -10,4 +10,5 @@ pkgs=(      ./yesod-routes
             ./yesod-auth
             ./yesod-sitemap
             ./yesod-default
-            ./yesod                 )
+            ./yesod
+            ./yesod-test            )

yesod-test/LICENSE

@@ -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.

yesod-test/Setup.lhs

@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

yesod-test/Yesod/Test.hs

@@ -0,0 +1,392 @@
+{-# 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.
+
+This is the helloworld and kitchen sink. In this case for testing a yesod app.
+  
+>  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 $ S4M 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 nonce" $ do
+>        doGet_ "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 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:
+>        doPost "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
+>        doPost "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 "rubs the lotion on it's skin or else it gets the hose again" $ do
+>        msgs <- testDB $ do (selectList [] [] :: SqlPersist IO [(Key SqlPersist Message, Message)])
+>        assertEqual "One Message in the DB" 1 (DL.length msgs)
+
+-}
+
+module Yesod.Test (
+  -- * Declaring and running your test suite
+  runTests, describe, it,
+
+  -- * 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.
+  doPost, doPost_, doGet, doGet_, doRequest,
+  byName, byLabel, addFile, addNonce, addNonce_,
+
+  -- * Running database queries
+  testDB,
+
+  -- * 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, txt)
+import Network.Wai
+import Network.Wai.Test
+import Control.Monad.Trans.State (get, put, execStateT, StateT)
+import "monads-tf" Control.Monad.Trans
+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 = 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 = 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 = 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) <- 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 <- get
+  SpecsData app conn specs <- liftIO $ execStateT action sData
+  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 <- get
+  let spec = Core.it label $ do
+        _ <- execStateT action $ OneSpecData app conn "" Nothing
+        return ()
+  put $ SpecsData app conn (specs++spec)
+
+-- Performs a given action using the last response.
+withResponse :: HoldsResponse a => b -> (SResponse -> StateT a IO b) -> StateT a IO b
+withResponse e f = maybe err f =<< fmap readResponse get
+ where
+  err = do
+    liftIO $ HUnit.assertFailure "There was no response, you should make a request"
+    return e
+
+-- | 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 -> StateT a IO [Html]
+htmlQuery query = withResponse [] $ \ res ->
+  case findBySelector (BSL8.unpack $ simpleBody res) query of
+    Left err -> do 
+      liftIO $ HUnit.assertFailure $ query ++ " did not parse: " ++ (show err)
+      return []
+    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 -> 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 -> StateT a IO ()
+bodyContains txt = withResponse () $ \ res ->
+  liftIO $ HUnit.assertBool ("Expected body to contain " ++ txt) $ (simpleBody res) `contains` txt
+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 -> StateT a IO ()
+htmlAllContain query search = do
+  matches <- htmlQuery query
+  case matches of
+    [] -> liftIO $ HUnit.assertFailure $ "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 -> 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 => 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 -> 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 <- get
+  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
+addFile :: String -> FilePath -> String -> RequestBuilder ()
+addFile name path mimetype = do
+  RequestBuilderData parts r <- get
+  contents <- liftIO $ BSL8.readFile path
+  put $ RequestBuilderData ((ReqFilePart name path contents mimetype):parts) r
+
+-- | Some frameworks like 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. This looks up a label
+-- and adds a parameter for the field name that label is pointing to.
+--
+-- If the label or field it points to are not found its treated as a faild Hspec assertion.
+byLabel :: String -> String -> RequestBuilder ()
+byLabel label value = withResponse () $ \ res -> do
+  let
+    body = BSL8.unpack $ simpleBody res
+    mfor = parseHTML body $ deep $
+      hasName "label" >>> filterA (getChildren >>> hasText (DL.isInfixOf label)) >>> getAttrValue "for"
+
+  case mfor of
+    for:[] -> do
+      let mname = parseHTML body $ deep $ hasAttrValue "id" (==for) >>> getAttrValue "name"
+      case mname of
+        "":_ -> liftIO $ HUnit.assertFailure $
+          "Label "++label++" resolved to id "++for++" which was not found. "
+        name:_ -> byName name value
+        _ -> liftIO $ HUnit.assertFailure $ "More than one input with id " ++ for
+    [] -> liftIO $ HUnit.assertFailure $ "No label contained: "++label
+    _ -> liftIO $ HUnit.assertFailure $ "More than one label contained "++label
+
+-- | Useful for yesod testing: Lookup a _nonce form field and add it's value to the params
+-- being built. Receives a selector that should point to the form containing the desired nonce.
+addNonce_ :: String -> RequestBuilder ()
+addNonce_ scope = do
+  matches <- htmlQuery $ scope ++ "input[name=_nonce][type=hidden][value]"
+  case matches of
+    [] -> liftIO $ HUnit.assertFailure $ "No nonce found in the current page"
+    element:[] -> byName "_nonce" $ head $ parseHTML element $ getAttrValue "value"
+    _ -> liftIO $ HUnit.assertFailure $ "More than one nonce found in the page"
+
+-- | For responses that display a single form, lookup the current Nonce on the page and
+-- add it to the params being built
+addNonce :: RequestBuilder ()
+addNonce = addNonce_ ""
+
+-- | Perform a POST request to url, using params
+doPost :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
+doPost url paramsBuild = do
+  doRequest "POST" url paramsBuild
+
+-- | Perform a POST request without params
+doPost_ :: BS8.ByteString -> OneSpec ()
+doPost_ = flip doPost $ return ()
+ 
+-- | Perform a GET request to url, using params
+doGet :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
+doGet url paramsBuild = doRequest "GET" url paramsBuild
+
+-- | Perform a GET request without params
+doGet_ :: BS8.ByteString -> OneSpec ()
+doGet_ = flip doGet $ 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 <- get
+  RequestBuilderData parts _ <- liftIO $ 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
+  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 = 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.
+testDB :: SqlPersist IO a -> OneSpec a
+testDB query = do
+  OneSpecData _ pool _ _ <- get
+  liftIO $ runSqlPool query pool

yesod-test/Yesod/Test/TransversingCSS.hs

@@ -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/yesod-test.cabal

@@ -0,0 +1,40 @@
+name:               yesod-test
+version:            0.1
+license:            BSD3
+license-file:       LICENSE
+author:             Nubis <nubis@woobiz.com.ar>
+maintainer:         Nubis <nubis@woobiz.com.ar>
+synopsis:           Behaviour Oriented integration Testing for 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
+
+library
+    build-depends:   hxt >= 9.1.5
+                   , parsec >= 3.1.1
+                   , base
+                   , containers
+                   , filepath
+                   , persistent >= 0.6.4
+                   , monad-control >= 0.2
+                   , transformers >= 0.2
+                   , wai-test
+                   , wai >= 0.4
+                   , ascii
+                   , network
+                   , http-types >= 0.6
+                   , hspec >= 0.9
+                   , HUnit >= 1.0
+                   , bytestring
+                   , text
+                   , monads-tf
+    exposed-modules: Yesod.Test
+    ghc-options:  -Wall
+
+source-repository head
+  type: git
+  location: git://github.com/yesodweb/yesod.git

yesod/Scaffolding/Scaffolder.hs

@@ -5,7 +5,7 @@ module Scaffolding.Scaffolder (scaffold) where
 import Scaffolding.CodeGen
 
 import Language.Haskell.TH.Syntax
-import Control.Monad (unless)
+import Control.Monad (unless, when)
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Encoding as LT
 import qualified Data.ByteString.Lazy as L
@@ -83,6 +83,11 @@ scaffold = do
         uncapitalize s = toLower (head s) : tail s
         backendLower = uncapitalize $ show backend 
         upper = show backend
+    
+    puts $(codegenDir "input" "use-tests")
+    useTestsC <- prompt $ flip elem $ [return 'y', return 'n']
+    let useTests = useTestsC == "y"
+    let testsDep = if useTests then ", yesod-test" else ""
 
     let runMigration  =
           case backend of
@@ -145,6 +150,7 @@ scaffold = do
     mkDir "deploy"
     mkDir "Settings"
     mkDir "messages"
+    mkDir "tests"
      
     writeFile' ("deploy/Procfile") $(codegen "deploy/Procfile")
 
@@ -188,6 +194,7 @@ scaffold = do
         $(codegen "templates/homepage.julius")
     unless isTiny $ writeFile' "config/models" $(codegen "config/models")
     writeFile' "messages/en.msg" $(codegen "messages/en.msg")
+    when useTests $ writeFile' "Tests.hs" $(codegen "Tests.hs")
 
     S.writeFile (dir ++ "/static/js/modernizr.js")
         $(runIO (S.readFile "scaffold/static/js/modernizr.js.cg") >>= \bs ->

yesod/input/use-tests.cg

@@ -0,0 +1,6 @@
+Yesod also comes with an optional integration tests tool.
+You should always test your application, the only reason
+not to use the yesod testing facilities is because you
+already have some other testing tool that you like better.
+
+Include tests?: 

yesod/scaffold/Tests.hs.cg

@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+module Testing (main) where
+
+import Import
+import Settings
+import Yesod
+import Yesod.Static
+import Yesod.Logger (makeLogger)
+import qualified Database.Persist.Base
+import Database.Persist.GenericSql (runMigration)
+import Yesod.Default.Config
+import Yesod.Test
+import Application
+
+main :: IO a
+main = do
+    conf <- loadConfig Testing
+    logger <- makeLogger
+    dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
+            $ either error return . Database.Persist.Base.loadConfig
+    s <- static Settings.staticDir
+    Database.Persist.Base.withPool (dbconf :: Settings.PersistConfig) $ \p -> do
+        Database.Persist.Base.runPool dbconf ~runMigration~ p
+        app <- toWaiAppPlain $ ~sitearg~ conf logger s p
+        runTests app p allTests
+
+allTests = do
+  describe "These are some example tests" $ do
+    it "loads the index and checks it looks right" $ do
+      doGet_ "."
+      printBody
+      statusIs 200
+      htmlCount "form" 1
+      htmlAllContain "h1" "Welcome to Yesod!"
+

yesod/scaffold/project.cabal.cg

@@ -97,4 +97,4 @@ executable         ~project~
                  , wai-extra                     >= 1.0        && < 1.2
                  , yaml                          >= 0.5        && < 0.6
                  , http-conduit                  >= 1.2        && < 1.3
-
+                 ~testsDep~