make yesod-test work with mongo

depends on resource-pool branch of persistent

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

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

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