haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

integrated scaffold and improved scaffolded site

Browse Source
This commit is contained in:
Nubis 2012-01-24 19:27:35 +08:00 committed by gregwebs
parent a72a62827b
commit a7ce59cd2a
14 changed files with 381 additions and 151 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

256
yesod-test/Yesod/Test.hs
View File

@ -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 "monads-tf" Control.Monad.Trans
import qualified Control.Monad.Trans.State as ST
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
SpecsData app conn specs <- liftIO $ execStateT action sData
put $ SpecsData app conn (Core.describe label [specs])
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 <- 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 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
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.
@ -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 query = withResponse [] $ \ res ->
htmlQuery :: HoldsResponse a => Query -> ST.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 []
Left err -> failure $ query ++ " did not parse: " ++ (show err)
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 number = withResponse () $ \ SResponse { simpleStatus = s } ->
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
@ -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 txt = withResponse () $ \ res ->
liftIO $ HUnit.assertBool ("Expected body to contain " ++ txt) $ (simpleBody res) `contains` txt
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 -> 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 = withResponse () $ \ SResponse { simpleBody = b } ->
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 -> 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
put $ RequestBuilderData ((ReqPlainPart name value):parts) r
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
addFile :: String -> FilePath -> String -> RequestBuilder ()
addFile name path mimetype = do
RequestBuilderData parts r <- get
fileByName :: String -> FilePath -> String -> RequestBuilder ()
fileByName name path mimetype = do
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
-- 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
-- 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
mfor = parseHTML body $ deep $
hasName "label" >>> filterA (getChildren >>> hasText (DL.isInfixOf label)) >>> getAttrValue "for"
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
"":_ -> 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
"":_ -> 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
-- | 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.
-- | 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
[] -> 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
-- add it to the params being built
-- | 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
doPost :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
doPost url paramsBuild = do
post :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
post url paramsBuild = do
doRequest "POST" url paramsBuild
-- | Perform a POST request without params
doPost_ :: BS8.ByteString -> OneSpec ()
doPost_ = flip doPost $ return ()
post_ :: BS8.ByteString -> OneSpec ()
post_ = flip post $ return ()
-- | Perform a GET request to url, using params
doGet :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
doGet url paramsBuild = doRequest "GET" url paramsBuild
get :: BS8.ByteString -> RequestBuilder () -> OneSpec ()
get url paramsBuild = doRequest "GET" url paramsBuild
-- | Perform a GET request without params
doGet_ :: BS8.ByteString -> OneSpec ()
doGet_ = flip doGet $ return ()
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 <- get
RequestBuilderData parts _ <- liftIO $ execStateT paramsBuild $ RequestBuilderData [] mRes
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
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 =
SRequest (mkRequest [("Cookie",cookie), ("Content-Type", "application/x-www-form-urlencoded")]) $
BSL8.pack $ DL.concat $ DL.intersperse "&" $ map singlepartPart parts
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]
@ -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
testDB query = do
OneSpecData _ pool _ _ <- get
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 ""

2
yesod-test/yesod-test.cabal
View File

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

15
yesod/Scaffolding/Scaffolder.hs
View File

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

26
yesod/scaffold/Handler/Root.hs.cg
View File

@ -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
setTitle "~project~ homepage"
aDomId <- lift newIdent
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

42
yesod/scaffold/cabal_test_suite.cg Normal file
View File

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

2
yesod/scaffold/config/mongoDB.yml.cg
View File

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

2
yesod/scaffold/config/postgresql.yml.cg
View File

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

2
yesod/scaffold/config/routes.cg
View File

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

2
yesod/scaffold/config/sqlite.yml.cg
View File

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

42
yesod/scaffold/templates/boilerplate-wrapper.hamlet.cg Normal file
View File

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

52
yesod/scaffold/templates/default-layout.lucius.cg
View File

@ -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;
}

41
yesod/scaffold/templates/homepage.hamlet.cg
View File

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

2
yesod/scaffold/templates/homepage.lucius.cg
View File

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

46
yesod/scaffold/tests_main.hs.cg Normal file
View File

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