integrated scaffold and improved scaffolded site

yesod-test/Yesod/Test.hs

@@ -19,63 +19,11 @@ 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,
+  runTests, describe, it, Specs, OneSpec,
 
   -- * Making requests
   -- | To make a request you need to point to an url and pass in some parameters.
@@ -83,11 +31,23 @@ module Yesod.Test (
   -- 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_,
+  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
-  testDB,
+  runDB,
 
   -- * Assertions
   assertEqual, statusIs, bodyContains, htmlAllContain, htmlCount,
@@ -115,11 +75,11 @@ 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 Text.XML.HXT.Core hiding (app, err)
 import Network.Wai
 import Network.Wai.Test
-import Control.Monad.Trans.State (get, put, execStateT, StateT)
+import qualified Control.Monad.Trans.State as ST
-import "monads-tf" Control.Monad.Trans
+import Control.Monad.IO.Class
 import System.IO
 import Yesod.Test.TransversingCSS
 import Database.Persist.GenericSql
@@ -128,13 +88,13 @@ import Database.Persist.GenericSql
 data SpecsData = SpecsData Application ConnectionPool [Core.Spec]
 
 -- | The specs state monad is where 'describe' runs.
-type Specs = StateT SpecsData IO ()
+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 = StateT OneSpecData IO
+type OneSpec = ST.StateT OneSpecData IO
 
 data RequestBuilderData = RequestBuilderData [RequestPart] (Maybe SResponse)
 
@@ -146,7 +106,7 @@ data RequestPart
 -- | 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
+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
@@ -170,33 +130,30 @@ type CookieValue = H.Ascii
 -- 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 [])
+  (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 <- get
+  sData <- ST.get
-  SpecsData app conn specs <- liftIO $ execStateT action sData
+  SpecsData app conn specs <- liftIO $ ST.execStateT action sData
-  put $ SpecsData app conn (Core.describe label [specs])
+  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 <- get
+  SpecsData app conn specs <- ST.get
   let spec = Core.it label $ do
-        _ <- execStateT action $ OneSpecData app conn "" Nothing
+        _ <- ST.execStateT action $ OneSpecData app conn "" Nothing
         return ()
-  put $ SpecsData app conn (specs++spec)
+  ST.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 :: HoldsResponse a => (SResponse -> ST.StateT a IO b) -> ST.StateT a IO b
-withResponse e f = maybe err f =<< fmap readResponse get
+withResponse f = maybe err f =<< fmap readResponse ST.get
- where
+ where err = failure "There was no response, you should make a request"
-  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.
@@ -204,12 +161,10 @@ 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 :: HoldsResponse a => Query -> ST.StateT a IO [Html]
-htmlQuery query = withResponse [] $ \ res ->
+htmlQuery query = withResponse $ \ res ->
   case findBySelector (BSL8.unpack $ simpleBody res) query of
-    Left err -> do 
+    Left err -> failure $ query ++ " did not parse: " ++ (show err)
-      liftIO $ HUnit.assertFailure $ query ++ " did not parse: " ++ (show err)
-      return []
     Right matches -> return matches
 
 -- | Asserts that the two given values are equal.
@@ -217,8 +172,8 @@ 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 :: HoldsResponse a => Int -> ST.StateT a IO ()
-statusIs number = withResponse () $ \ SResponse { simpleStatus = s } ->
+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
@@ -226,37 +181,39 @@ statusIs number = withResponse () $ \ SResponse { simpleStatus = 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 :: HoldsResponse a => String -> ST.StateT a IO ()
-bodyContains txt = withResponse () $ \ res ->
+bodyContains text = withResponse $ \ res ->
-  liftIO $ HUnit.assertBool ("Expected body to contain " ++ txt) $ (simpleBody res) `contains` txt
+  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 -> StateT a IO ()
+htmlAllContain :: HoldsResponse a => Query -> String -> ST.StateT a IO ()
 htmlAllContain query search = do
   matches <- htmlQuery query
   case matches of
-    [] -> liftIO $ HUnit.assertFailure $ "Nothing matched css query: "++query
+    [] -> 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 -> StateT a IO ()
+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 => StateT a IO ()
+printBody :: HoldsResponse a => ST.StateT a IO ()
-printBody = withResponse () $ \ SResponse { simpleBody = b } -> 
+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 :: HoldsResponse a => Query -> ST.StateT a IO ()
 printMatches query = do
   matches <- htmlQuery query
   liftIO $ hPutStrLn stderr $ show matches
@@ -264,86 +221,103 @@ printMatches query = do
 -- | Add a parameter with the given name and value.
 byName :: String -> String -> RequestBuilder ()
 byName name value = do
-  RequestBuilderData parts r <- get
+  RequestBuilderData parts r <- ST.get
-  put $ RequestBuilderData ((ReqPlainPart name value):parts) r
+  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
-addFile :: String -> FilePath -> String -> RequestBuilder ()
+fileByName :: String -> FilePath -> String -> RequestBuilder ()
-addFile name path mimetype = do
+fileByName name path mimetype = do
-  RequestBuilderData parts r <- get
+  RequestBuilderData parts r <- ST.get
   contents <- liftIO $ BSL8.readFile path
-  put $ RequestBuilderData ((ReqFilePart name path contents mimetype):parts) r
+  ST.put $ RequestBuilderData ((ReqFilePart name path contents mimetype):parts) r
 
--- | Some frameworks like Yesod cat auto generate field ids, so you are never sure what
+-- This looks up the name of a field based on the contents of the label pointing to it.
--- the argument name should be for each one of your args when constructing
+nameFromLabel :: String -> RequestBuilder String
--- your requests. What you do know is the /label/ of the field. This looks up a label
+nameFromLabel label = withResponse $ \ res -> do
--- 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 $
+    escaped = escapeHtmlEntities label
-      hasName "label" >>> filterA (getChildren >>> hasText (DL.isInfixOf label)) >>> getAttrValue "for"
+    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
-        "":_ -> liftIO $ HUnit.assertFailure $
+        "":_ -> failure $ "Label "++label++" resolved to id "++for++" which was not found. "
-          "Label "++label++" resolved to id "++for++" which was not found. "
+        name:_ -> return name
-        name:_ -> byName name value
+        _ -> failure $ "More than one input with id " ++ for
-        _ -> liftIO $ HUnit.assertFailure $ "More than one input with id " ++ for
+    [] -> failure $ "No label contained: "++label
-    [] -> liftIO $ HUnit.assertFailure $ "No label contained: "++label
+    _ -> failure $ "More than one 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
+-- | Escape HTML entities in a string, so you can write the text you want in
--- being built. Receives a selector that should point to the form containing the desired nonce.
+-- 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
-    [] -> liftIO $ HUnit.assertFailure $ "No nonce found in the current page"
+    [] -> failure $ "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"
+    _ -> failure $ "More than one nonce found in the page"
 
--- | For responses that display a single form, lookup the current Nonce on the page and
+-- | For responses that display a single form, just lookup the only nonce available.
--- add it to the params being built
 addNonce :: RequestBuilder ()
 addNonce = addNonce_ ""
 
 -- | Perform a POST request to url, using params
-doPost :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
+post :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
-doPost url paramsBuild = do
+post url paramsBuild = do
   doRequest "POST" url paramsBuild
 
 -- | Perform a POST request without params
-doPost_ :: BS8.ByteString -> OneSpec ()
+post_ :: BS8.ByteString -> OneSpec ()
-doPost_ = flip doPost $ return ()
+post_ = flip post $ return ()
  
 -- | Perform a GET request to url, using params
-doGet :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
+get :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
-doGet url paramsBuild = doRequest "GET" url paramsBuild
+get url paramsBuild = doRequest "GET" url paramsBuild
 
 -- | Perform a GET request without params
-doGet_ :: BS8.ByteString -> OneSpec ()
+get_ :: BS8.ByteString -> OneSpec ()
-doGet_ = flip doGet $ return ()
+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 <- get
+  OneSpecData app conn cookie mRes <- ST.get
-  RequestBuilderData parts _ <- liftIO $ execStateT paramsBuild $ RequestBuilderData [] mRes
+  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
-  put $ OneSpecData app conn cookie' (Just response)
+  ST.put $ OneSpecData app conn cookie' (Just response)
  where
   isFile (ReqFilePart _ _ _ _) = True
   isFile _ = False
@@ -356,7 +330,8 @@ doRequest method url paramsBuild = do
     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]
+  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"
@@ -369,9 +344,10 @@ doRequest method url paramsBuild = do
     , BS8.concat $ BSL8.toChunks bytes, "\r\n"]
 
   -- For building the regular non-multipart requests
-  makeSinglepart cookie parts =
+  makeSinglepart cookie parts = SRequest (mkRequest 
-    SRequest (mkRequest [("Cookie",cookie), ("Content-Type", "application/x-www-form-urlencoded")]) $
+    [("Cookie",cookie), ("Content-Type", "application/x-www-form-urlencoded")]) $
-      BSL8.pack $ DL.concat $ DL.intersperse "&" $ map singlepartPart parts
+    BSL8.pack $ DL.concat $ DL.intersperse "&" $ map singlepartPart parts
+
   singlepartPart (ReqFilePart _ _ _ _) = ""
   singlepartPart (ReqPlainPart k v) = concat [k,"=",v]
 
@@ -381,12 +357,16 @@ doRequest method url paramsBuild = do
     , remoteHost = Sock.SockAddrInet 1 2
     , requestHeaders = headers
     , rawPathInfo = url
-    , pathInfo = T.split (== '/') $ TE.decodeUtf8 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.
-testDB :: SqlPersist IO a -> OneSpec a
+runDB :: SqlPersist IO a -> OneSpec a
-testDB query = do
+runDB query = do
-  OneSpecData _ pool _ _ <- get
+  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/yesod-test.cabal

@@ -32,7 +32,9 @@ library
                    , 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

yesod/Scaffolding/Scaffolder.hs

@@ -135,10 +135,12 @@ scaffold = do
     let fst3 (x, _, _) = x
     year <- show . fst3 . toGregorian . utctDay <$> getCurrentTime
 
-    let writeFile' fp s = do
+    let changeFile fileFunc fp s = do
             putStrLn $ "Generating " ++ fp
-            L.writeFile (dir ++ '/' : fp) $ LT.encodeUtf8 $ LT.pack s
+            fileFunc (dir ++ '/' : fp) $ LT.encodeUtf8 $ LT.pack s
         mkDir fp = createDirectoryIfMissing True $ dir ++ '/' : fp
+        writeFile' = changeFile L.writeFile
+        appendFile' = changeFile L.appendFile
 
     mkDir "Handler"
     mkDir "templates"
@@ -150,7 +152,6 @@ scaffold = do
     mkDir "deploy"
     mkDir "Settings"
     mkDir "messages"
-    mkDir "tests"
      
     writeFile' ("deploy/Procfile") $(codegen "deploy/Procfile")
 
@@ -168,6 +169,9 @@ scaffold = do
     writeFile' ("main.hs") $(codegen "main.hs")
     writeFile' ("devel.hs") $(codegen "devel.hs")
     writeFile' (project ++ ".cabal") $ ifTiny $(codegen "tiny/project.cabal") $(codegen "project.cabal")
+    when useTests $ do
+      appendFile' (project ++ ".cabal") $(codegen "cabal_test_suite")
+
     writeFile' ".ghci" $(codegen ".ghci")
     writeFile' "LICENSE" $(codegen "LICENSE")
     writeFile' ("Foundation.hs") $ ifTiny $(codegen "tiny/Foundation.hs") $(codegen "Foundation.hs")
@@ -194,7 +198,10 @@ 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")
+
+    when useTests $ do
+      mkDir "tests"
+      writeFile' "tests/main.hs" $(codegen "tests_main.hs")
 
     S.writeFile (dir ++ "/static/js/modernizr.js")
         $(runIO (S.readFile "scaffold/static/js/modernizr.js.cg") >>= \bs ->

yesod/scaffold/Handler/Root.hs.cg

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections, OverloadedStrings #-}
 module Handler.Root where
 
 import Import
@@ -11,7 +12,28 @@ import Import
 -- inclined, or create a single monolithic file.
 getRootR :: Handler RepHtml
 getRootR = do
+    ((_, formWidget), formEnctype) <- generateFormPost sampleForm
+    let submission = Nothing :: Maybe (FileInfo, Text)
+        handlerName = "getRootR" :: Text
     defaultLayout $ do
-        h2id <- lift newIdent
+        aDomId <- lift newIdent
-        setTitle "~project~ homepage"
+        setTitle "Welcome To Yesod!"
         $(widgetFile "homepage")
+
+postRootR :: Handler RepHtml
+postRootR = do
+    ((result, formWidget), formEnctype) <- runFormPost sampleForm
+    let handlerName = "postRootR" :: Text
+        submission = case result of
+            FormSuccess res -> Just res
+            _ -> Nothing
+
+    defaultLayout $ do
+        aDomId <- lift newIdent
+        setTitle "Welcome To Yesod!"
+        $(widgetFile "homepage")
+
+sampleForm :: Form (FileInfo, Text)
+sampleForm = renderDivs $ (,)
+    <$> fileAFormReq "Choose a file"
+    <*> areq textField "What's on the file?" Nothing

yesod/scaffold/cabal_test_suite.cg

@@ -0,0 +1,42 @@
+test-suite integration-tests
+    type: exitcode-stdio-1.0
+    main-is:        main.hs
+    hs-source-dirs: tests .
+    ghc-options:     -Wall
+    extensions: TemplateHaskell
+                QuasiQuotes
+                OverloadedStrings
+                NoImplicitPrelude
+                CPP
+                OverloadedStrings
+                MultiParamTypeClasses
+                TypeFamilies
+                GADTs
+                GeneralizedNewtypeDeriving
+                FlexibleContexts
+
+    build-depends: base                          >= 4          && < 5
+                 , yesod                         >= 0.10       && < 0.11
+                 , yesod-core                    >= 0.10       && < 0.11
+                 , yesod-auth                    >= 0.8        && < 0.9
+                 , yesod-static                  >= 0.10       && < 0.11
+                 , yesod-default                 >= 0.6        && < 0.7
+                 , yesod-form                    >= 0.4        && < 0.5
+                 , yesod-test                    >= 0.1        && < 0.2
+                 , mime-mail                     >= 0.3.0.3    && < 0.5
+                 , clientsession                 >= 0.7.3      && < 0.8
+                 , bytestring                    >= 0.9        && < 0.10
+                 , text                          >= 0.11       && < 0.12
+                 , persistent                    >= 0.7        && < 0.8
+                 , persistent-sqlite     >= 0.7        && < 0.8
+                 , template-haskell
+                 , hamlet                        >= 0.10       && < 0.11
+                 , shakespeare-css               >= 0.10       && < 0.11
+                 , shakespeare-js                >= 0.10       && < 0.11
+                 , shakespeare-text              >= 0.10       && < 0.11
+                 , hjsmin                        >= 0.0.14     && < 0.1
+                 , monad-control                 >= 0.3        && < 0.4
+                 , wai-extra                     >= 1.0        && < 1.1
+                 , yaml                          >= 0.5        && < 0.6
+                 , http-conduit                  >= 1.1        && < 1.2
+                 , haskell98

yesod/scaffold/config/mongoDB.yml.cg

@@ -9,7 +9,7 @@ Default: &defaults
 Development:
   <<: *defaults
 
-Test:
+Testing:
   database: ~project~_test
   <<: *defaults
 

yesod/scaffold/config/postgresql.yml.cg

@@ -9,7 +9,7 @@ Default: &defaults
 Development:
   <<: *defaults
 
-Test:
+Testing:
   database: ~project~_test
   <<: *defaults
 

yesod/scaffold/config/routes.cg

@@ -4,4 +4,4 @@
 /favicon.ico FaviconR GET
 /robots.txt RobotsR GET
 
-/ RootR GET
+/ RootR GET POST

yesod/scaffold/config/sqlite.yml.cg

@@ -5,7 +5,7 @@ Default: &defaults
 Development:
   <<: *defaults
 
-Test:
+Testing:
   database: ~project~_test.sqlite3
   <<: *defaults
 

yesod/scaffold/templates/boilerplate-wrapper.hamlet.cg

@@ -0,0 +1,42 @@
+\<!doctype html>
+\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
+\<!--[if IE 7]>    <html class="no-js ie7 oldie" lang="en"> <![endif]-->
+\<!--[if IE 8]>    <html class="no-js ie8 oldie" lang="en"> <![endif]-->
+\<!--[if gt IE 8]><!-->
+<html class="no-js" lang="en"> <!--<![endif]-->
+    <head>
+        <meta charset="UTF-8">
+
+        <title>#{pageTitle pc}
+        <meta name="description" content="">
+        <meta name="author" content="">
+
+        <meta name="viewport" content="width=device-width,initial-scale=1">
+
+        ^{pageHead pc}
+
+        \<!--[if lt IE 9]>
+        \<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
+        \<![endif]-->
+
+        <script>
+          document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
+    <body>
+        <div id="container">
+            <header>
+            <div id="main" role="main">
+              ^{pageBody pc}
+            <footer>
+
+        \<!-- Change UA-XXXXX-X to be your site's ID -->
+        <script>
+            window._gaq = [['_setAccount','UAXXXXXXXX1'],['_trackPageview'],['_trackPageLoadTime']];
+            YepNope.load({
+            \  load: ('https:' == location.protocol ? '//ssl' : '//www') + '.google-analytics.com/ga.js'
+            });
+        \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6.  chromium.org/developers/how-tos/chrome-frame-getting-started -->
+        \<!--[if lt IE 7 ]>
+            <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">
+            <script>
+                window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
+        \<![endif]-->

yesod/scaffold/templates/default-layout.lucius.cg

@@ -1,3 +1,53 @@
 body {
-    font-family: sans-serif;
+  font-family: helvetica;
+  font-size: 18px;
+  background: #f0f0f0;
+  line-height: 1.9em;
+}
+.content {
+  width: 850px;
+  margin: 0 auto;
+}
+em, a , form{
+  font-style: normal;
+  padding: 0.3em;
+  border: 1px solid #e0e0e0;
+  background: #fff;
+}
+form .required {
+  padding: 0.4em 0;
+  input {
+    margin-left: 0.5em;
+  }
+  .errors {
+    color: #f66;
+    display: inline;
+  }
+}
+
+ol {
+  padding: 0;
+  li {
+    list-style-type: square;
+    margin: 0.5em;
+  }
+}
+li {
+  list-style-image: disc;
+}
+
+form {
+  margin-top: 1em;
+}
+
+.message {
+  border: 1px solid #ff2;
+  background: #ffa;
+  margin: 1em 0;
+  padding: 1em;
+}
+
+footer {
+  text-align: center;
+  margin: 20px;
 }

yesod/scaffold/templates/homepage.hamlet.cg

@@ -1,2 +1,41 @@
 <h1>_{MsgHello}
-<h2 ##{h2id}>You do not have Javascript enabled.
+
+<p>Now that you have a working project you should use the 
+  <a href="http://www.yesodweb.com/book/">Yesod book</a> to learn more.
+
+<p>
+  You can also use this scaffolded site to explore some basic concepts, these are 
+  the main things to look at:
+
+<ol>
+  <li> This page was generated by the #{handlerName} handler in 
+    <em>Handler/Root.hs</em>.
+
+  <li> The #{handlerName} handler is set to generate your site's home screen in Routes file 
+    <em>config/routes</em>
+
+  <li> The HTML you are seeing now is actually composed by a number of <em>widgets</em>, 
+    most of them are brought together by the <em>defaultLayout</em> function which  
+    is defined in the <em>Foundation.hs</em> module, and used by <em>#{handlerName}</em>. 
+    All the files for templates and wigdets are in <em>templates</em>.
+
+  <li>
+    A Widget's Html, Css and Javascript are separated in three files with the 
+    <em>.hamlet</em>, <em>.lucius</em> and <em>.julius</em> extensions. 
+
+  <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this.
+    
+  <li #form>
+    This is an example trivial Form. Read the 
+    <a href="http://www.yesodweb.com/book/forms">Forms chapter</a> 
+    on the yesod book to learn more about them.
+    $maybe (info,con) <- submission
+      <div .message>
+        Your file's type was <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em>
+    <form method=post action=@{RootR}#form enctype=#{formEnctype}>
+      ^{formWidget}
+      <input type="submit" value="Send it!">
+
+  <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a 
+    test suite that performs tests on this page. 
+    You can run your tests by doing: <pre>cabal install --enable-tests && cabal test</pre>

yesod/scaffold/templates/homepage.lucius.cg

@@ -1,6 +1,6 @@
 h1 {
     text-align: center
 }
-h2##{h2id} {
+h2##{aDomId} {
     color: #990
 }

yesod/scaffold/tests_main.hs.cg

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main where
+
+import Import
+import Settings
+import Yesod.Static
+import Yesod.Logger (defaultDevelopmentLogger)
+import qualified Database.Persist.Store
+import Database.Persist.GenericSql (runMigration)
+import Yesod.Default.Config
+import Yesod.Test
+import Network.HTTP.Conduit (newManagerIO)
+import Application()
+
+main :: IO a
+main = do
+    conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra }
+    manager <- newManagerIO 10
+    logger <- defaultDevelopmentLogger
+    dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
+              Database.Persist.Store.loadConfig
+    s <- static Settings.staticDir
+    p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
+    app <- toWaiAppPlain $ ~sitearg~ conf logger s p manager
+    runTests app p allTests
+
+allTests :: Specs
+allTests = do
+  describe "These are some example tests" $ do
+    it "loads the index and checks it looks right" $ do
+      get_ "/"
+      statusIs 200
+      htmlAllContain "h1" "Hello"
+
+      post "/" $ do
+        addNonce
+        fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
+        byLabel "What's on the file?" "Some Content"
+
+      statusIs 200
+      htmlCount ".message" 1
+      htmlAllContain ".message" "Some Content"
+      htmlAllContain ".message" "text/plain"