diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 8a8f7f39..8802a0d1 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-| Yesod.Test is a pragmatic framework for testing web applications built using wai and persistent. @@ -16,7 +17,7 @@ This is very useful for testing web applications built in yesod for example, were your forms may have field names generated by the framework or a randomly generated '_nonce' field. -Your database is also directly available so you can use runDB to set up +Your database is also directly available so you can use runDBRunner to set up backend pre-conditions, or to assert that your session is having the desired effect. -} @@ -47,7 +48,7 @@ module Yesod.Test ( addNonce, addNonce_, -- * Running database queries - runDB, + runDBRunner, -- * Assertions assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains, @@ -84,25 +85,26 @@ import qualified Control.Monad.Trans.State as ST import Control.Monad.IO.Class import System.IO import Yesod.Test.TransversingCSS -import Database.Persist.GenericSql import Data.Monoid (mappend) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) import Text.XML.Cursor hiding (element) import qualified Text.XML.Cursor as C import qualified Text.HTML.DOM as HD +import Data.Conduit.Pool (Pool) +import Control.Monad.Trans.Control (MonadBaseControl) -- | The state used in 'describe' to build a list of specs -data SpecsData = SpecsData Application ConnectionPool [Core.Spec] +data SpecsData conn = SpecsData Application (Pool conn) [Core.Spec] -- | The specs state monad is where 'describe' runs. -type Specs = ST.StateT SpecsData IO () +type Specs conn = ST.StateT (SpecsData conn) IO () -- | The state used in a single test case defined using 'it' -data OneSpecData = OneSpecData Application ConnectionPool CookieValue (Maybe SResponse) +data OneSpecData conn = OneSpecData Application (Pool conn) CookieValue (Maybe SResponse) -- | The OneSpec state monad is where 'it' runs. -type OneSpec = ST.StateT OneSpecData IO +type OneSpec conn = ST.StateT (OneSpecData conn) IO data RequestBuilderData = RequestBuilderData [RequestPart] (Maybe SResponse) @@ -121,7 +123,7 @@ type RequestBuilder = ST.StateT RequestBuilderData IO -- the last received response. class HoldsResponse a where readResponse :: a -> Maybe SResponse -instance HoldsResponse OneSpecData where +instance HoldsResponse (OneSpecData conn) where readResponse (OneSpecData _ _ _ x) = x instance HoldsResponse RequestBuilderData where readResponse (RequestBuilderData _ x) = x @@ -136,21 +138,21 @@ type CookieValue = ByteString -- -- Look at the examples directory on this package to get an idea of the (small) amount of -- boilerplate code you'll need to write before calling this. -runTests :: Application -> ConnectionPool -> Specs -> IO () +runTests :: Application -> Pool conn -> Specs conn -> IO () runTests app connection specsDef = do (SpecsData _ _ specs) <- ST.execStateT specsDef (SpecsData app connection []) Runner.hspec specs -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application' -- and 'ConnectionPool' -describe :: String -> Specs -> Specs +describe :: String -> Specs conn -> Specs conn describe label action = do sData <- ST.get SpecsData app conn specs <- liftIO $ ST.execStateT action sData ST.put $ SpecsData app conn [Core.describe label specs] -- | Describe a single test that keeps cookies, and a reference to the last response. -it :: String -> OneSpec () -> Specs +it :: String -> OneSpec conn () -> Specs conn it label action = do SpecsData app conn specs <- ST.get let spec = Core.it label $ do @@ -177,7 +179,7 @@ htmlQuery query = withResponse $ \ res -> Right matches -> return $ map (encodeUtf8 . TL.pack) matches -- | Asserts that the two given values are equal. -assertEqual :: (Eq a) => String -> a -> a -> OneSpec () +assertEqual :: (Eq a) => String -> a -> a -> OneSpec conn () assertEqual msg a b = liftIO $ HUnit.assertBool msg (a == b) -- | Assert the last response status is as expected. @@ -341,24 +343,24 @@ addNonce :: RequestBuilder () addNonce = addNonce_ "" -- | Perform a POST request to url, using params -post :: BS8.ByteString -> RequestBuilder () -> OneSpec () +post :: BS8.ByteString -> RequestBuilder () -> OneSpec conn () post url paramsBuild = do doRequest "POST" url paramsBuild -- | Perform a POST request without params -post_ :: BS8.ByteString -> OneSpec () +post_ :: BS8.ByteString -> OneSpec conn () post_ = flip post $ return () -- | Perform a GET request to url, using params -get :: BS8.ByteString -> RequestBuilder () -> OneSpec () +get :: BS8.ByteString -> RequestBuilder () -> OneSpec conn () get url paramsBuild = doRequest "GET" url paramsBuild -- | Perform a GET request without params -get_ :: BS8.ByteString -> OneSpec () +get_ :: BS8.ByteString -> OneSpec conn () 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 :: H.Method -> BS8.ByteString -> RequestBuilder a -> OneSpec conn () doRequest method url paramsBuild = do OneSpecData app conn cookie mRes <- ST.get RequestBuilderData parts _ <- liftIO $ ST.execStateT paramsBuild $ RequestBuilderData [] mRes @@ -413,10 +415,13 @@ doRequest method url paramsBuild = do -- | Run a persistent db query. For asserting on the results of performed actions -- or setting up pre-conditions. At the moment this part is still very raw. -runDB :: SqlPersist IO a -> OneSpec a -runDB query = do +-- +-- It is intended that you parametize the first argument of this function for your backend +-- runDB = runDBRunnder SqlPersist +runDBRunner :: (MonadBaseControl IO m, MonadIO m) => (poolrunner m a -> Pool conn -> IO a) -> poolrunner m a -> OneSpec conn a +runDBRunner poolRunner query = do OneSpecData _ pool _ _ <- ST.get - liftIO $ runSqlPool query pool + liftIO $ poolRunner query pool -- Yes, just a shortcut failure :: (MonadIO a) => T.Text -> a b diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 2d6cfb6f..8cd89c01 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -33,6 +33,8 @@ library , html-conduit >= 0.1 && < 0.2 , blaze-html >= 0.5 && < 0.6 , blaze-markup >= 0.5.1 && < 0.6 + , pool-conduit + , monad-control exposed-modules: Yesod.Test Yesod.Test.CssQuery diff --git a/yesod/scaffold/config/mongoDB.yml.cg b/yesod/scaffold/config/mongoDB.yml.cg index a7ba4064..7b906909 100644 --- a/yesod/scaffold/config/mongoDB.yml.cg +++ b/yesod/scaffold/config/mongoDB.yml.cg @@ -2,9 +2,8 @@ Default: &defaults user: ~project~ password: ~project~ host: localhost - port: 27017 database: ~project~ - poolsize: 10 + connections: 10 Development: <<: *defaults @@ -15,10 +14,11 @@ Testing: Staging: database: ~project~_staging - poolsize: 100 + connections: 100 <<: *defaults Production: database: ~project~_production - poolsize: 100 + connections: 100 + host: localhost <<: *defaults