diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index d15b310d..3548ddf8 100644 --- a/yesod-test/Yesod/Test.hs +++ b/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 "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 "" diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 6d268d1e..754d99b0 100644 --- a/yesod-test/yesod-test.cabal +++ b/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 diff --git a/yesod/Scaffolding/Scaffolder.hs b/yesod/Scaffolding/Scaffolder.hs index ccc50add..af79fddd 100644 --- a/yesod/Scaffolding/Scaffolder.hs +++ b/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 -> diff --git a/yesod/scaffold/Handler/Root.hs.cg b/yesod/scaffold/Handler/Root.hs.cg index 708a5382..1d5c1762 100644 --- a/yesod/scaffold/Handler/Root.hs.cg +++ b/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 - 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 diff --git a/yesod/scaffold/cabal_test_suite.cg b/yesod/scaffold/cabal_test_suite.cg new file mode 100644 index 00000000..806b57b6 --- /dev/null +++ b/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 diff --git a/yesod/scaffold/config/mongoDB.yml.cg b/yesod/scaffold/config/mongoDB.yml.cg index b97d7dfa..a7ba4064 100644 --- a/yesod/scaffold/config/mongoDB.yml.cg +++ b/yesod/scaffold/config/mongoDB.yml.cg @@ -9,7 +9,7 @@ Default: &defaults Development: <<: *defaults -Test: +Testing: database: ~project~_test <<: *defaults diff --git a/yesod/scaffold/config/postgresql.yml.cg b/yesod/scaffold/config/postgresql.yml.cg index aceae393..56b718f5 100644 --- a/yesod/scaffold/config/postgresql.yml.cg +++ b/yesod/scaffold/config/postgresql.yml.cg @@ -9,7 +9,7 @@ Default: &defaults Development: <<: *defaults -Test: +Testing: database: ~project~_test <<: *defaults diff --git a/yesod/scaffold/config/routes.cg b/yesod/scaffold/config/routes.cg index 7a0bb067..ac818391 100644 --- a/yesod/scaffold/config/routes.cg +++ b/yesod/scaffold/config/routes.cg @@ -4,4 +4,4 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/ RootR GET +/ RootR GET POST diff --git a/yesod/scaffold/config/sqlite.yml.cg b/yesod/scaffold/config/sqlite.yml.cg index ebee1fa8..499afd76 100644 --- a/yesod/scaffold/config/sqlite.yml.cg +++ b/yesod/scaffold/config/sqlite.yml.cg @@ -5,7 +5,7 @@ Default: &defaults Development: <<: *defaults -Test: +Testing: database: ~project~_test.sqlite3 <<: *defaults diff --git a/yesod/scaffold/templates/boilerplate-wrapper.hamlet.cg b/yesod/scaffold/templates/boilerplate-wrapper.hamlet.cg new file mode 100644 index 00000000..11b34199 --- /dev/null +++ b/yesod/scaffold/templates/boilerplate-wrapper.hamlet.cg @@ -0,0 +1,42 @@ +\ +\ +\ +\ +\ + + + + + #{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]--> \ No newline at end of file diff --git a/yesod/scaffold/templates/default-layout.lucius.cg b/yesod/scaffold/templates/default-layout.lucius.cg index 853ac29a..59c6386b 100644 --- a/yesod/scaffold/templates/default-layout.lucius.cg +++ b/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; } diff --git a/yesod/scaffold/templates/homepage.hamlet.cg b/yesod/scaffold/templates/homepage.hamlet.cg index e8907860..07f2084b 100644 --- a/yesod/scaffold/templates/homepage.hamlet.cg +++ b/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> diff --git a/yesod/scaffold/templates/homepage.lucius.cg b/yesod/scaffold/templates/homepage.lucius.cg index f8fa5617..54986f81 100644 --- a/yesod/scaffold/templates/homepage.lucius.cg +++ b/yesod/scaffold/templates/homepage.lucius.cg @@ -1,6 +1,6 @@ h1 { text-align: center } -h2##{h2id} { +h2##{aDomId} { color: #990 } diff --git a/yesod/scaffold/tests_main.hs.cg b/yesod/scaffold/tests_main.hs.cg new file mode 100644 index 00000000..596ed2a5 --- /dev/null +++ b/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"