complete backend independent yesod-test
This commit is contained in:
parent
25d7c2287d
commit
840fa09e5b
@ -24,7 +24,7 @@ backend pre-conditions, or to assert that your session is having the desired eff
|
|||||||
|
|
||||||
module Yesod.Test (
|
module Yesod.Test (
|
||||||
-- * Declaring and running your test suite
|
-- * Declaring and running your test suite
|
||||||
runTests, describe, it, Specs, OneSpec,
|
runTests, describe, it, SpecsConn, OneSpec,
|
||||||
|
|
||||||
-- * Making requests
|
-- * Making requests
|
||||||
-- | To make a request you need to point to an url and pass in some parameters.
|
-- | To make a request you need to point to an url and pass in some parameters.
|
||||||
@ -98,7 +98,9 @@ import Control.Monad.Trans.Control (MonadBaseControl)
|
|||||||
data SpecsData conn = SpecsData Application (Pool conn) [Core.Spec]
|
data SpecsData conn = SpecsData Application (Pool conn) [Core.Spec]
|
||||||
|
|
||||||
-- | The specs state monad is where 'describe' runs.
|
-- | The specs state monad is where 'describe' runs.
|
||||||
type Specs conn = ST.StateT (SpecsData conn) IO ()
|
-- parameterized by a database connection.
|
||||||
|
-- You should create type Specs = SpecsConn MyDBConnection
|
||||||
|
type SpecsConn conn = ST.StateT (SpecsData conn) IO ()
|
||||||
|
|
||||||
-- | The state used in a single test case defined using 'it'
|
-- | The state used in a single test case defined using 'it'
|
||||||
data OneSpecData conn = OneSpecData Application (Pool conn) CookieValue (Maybe SResponse)
|
data OneSpecData conn = OneSpecData Application (Pool conn) CookieValue (Maybe SResponse)
|
||||||
@ -138,21 +140,21 @@ type CookieValue = ByteString
|
|||||||
--
|
--
|
||||||
-- Look at the examples directory on this package to get an idea of the (small) amount of
|
-- 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.
|
-- boilerplate code you'll need to write before calling this.
|
||||||
runTests :: Application -> Pool conn -> Specs conn -> IO ()
|
runTests :: Application -> Pool conn -> SpecsConn conn -> IO ()
|
||||||
runTests app connection specsDef = do
|
runTests app connection specsDef = do
|
||||||
(SpecsData _ _ specs) <- ST.execStateT specsDef (SpecsData app connection [])
|
(SpecsData _ _ specs) <- ST.execStateT specsDef (SpecsData app connection [])
|
||||||
Runner.hspec specs
|
Runner.hspec specs
|
||||||
|
|
||||||
-- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
|
-- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
|
||||||
-- and 'ConnectionPool'
|
-- and 'ConnectionPool'
|
||||||
describe :: String -> Specs conn -> Specs conn
|
describe :: String -> SpecsConn conn -> SpecsConn conn
|
||||||
describe label action = do
|
describe label action = do
|
||||||
sData <- ST.get
|
sData <- ST.get
|
||||||
SpecsData app conn specs <- liftIO $ ST.execStateT action sData
|
SpecsData app conn specs <- liftIO $ ST.execStateT action sData
|
||||||
ST.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.
|
-- | Describe a single test that keeps cookies, and a reference to the last response.
|
||||||
it :: String -> OneSpec conn () -> Specs conn
|
it :: String -> OneSpec conn () -> SpecsConn conn
|
||||||
it label action = do
|
it label action = do
|
||||||
SpecsData app conn specs <- ST.get
|
SpecsData app conn specs <- ST.get
|
||||||
let spec = Core.it label $ do
|
let spec = Core.it label $ do
|
||||||
|
|||||||
@ -72,6 +72,10 @@ scaffold = do
|
|||||||
backendLower = uncapitalize $ show backend
|
backendLower = uncapitalize $ show backend
|
||||||
upper = show backend
|
upper = show backend
|
||||||
|
|
||||||
|
poolRunner = case backend of
|
||||||
|
MongoDB -> "runMongoDBPoolDef"
|
||||||
|
_ -> "runSqlPool"
|
||||||
|
|
||||||
let runMigration =
|
let runMigration =
|
||||||
case backend of
|
case backend of
|
||||||
MongoDB -> ""
|
MongoDB -> ""
|
||||||
@ -189,6 +193,7 @@ scaffold = do
|
|||||||
mkDir "tests"
|
mkDir "tests"
|
||||||
writeFile' "tests/main.hs" $(codegen "tests/main.hs")
|
writeFile' "tests/main.hs" $(codegen "tests/main.hs")
|
||||||
writeFile' "tests/HomeTest.hs" $(codegen "tests/HomeTest.hs")
|
writeFile' "tests/HomeTest.hs" $(codegen "tests/HomeTest.hs")
|
||||||
|
writeFile' "tests/TestImport.hs" $(codegen "tests/TestImport.hs")
|
||||||
|
|
||||||
S.writeFile (dir ++ "/config/favicon.ico")
|
S.writeFile (dir ++ "/config/favicon.ico")
|
||||||
$(runIO (S.readFile "scaffold/config/favicon.ico.cg") >>= \bs -> do
|
$(runIO (S.readFile "scaffold/config/favicon.ico.cg") >>= \bs -> do
|
||||||
|
|||||||
@ -1,8 +1,5 @@
|
|||||||
runConnectionPool :: MonadControlIO m => Action m a -> ConnectionPool -> m a
|
|
||||||
runConnectionPool = runMongoDBConn (ConfirmWrites [u"j" =: True])
|
|
||||||
|
|
||||||
withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig DefaultEnv -> (ConnectionPool -> m b) -> m b
|
withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig DefaultEnv -> (ConnectionPool -> m b) -> m b
|
||||||
withConnectionPool conf f = do
|
withConnectionPool conf f = do
|
||||||
dbConf <- liftIO $ loadMongo (appEnv conf)
|
dbConf <- liftIO $ loadMongo (appEnv conf)
|
||||||
withMongoDBPool (u $ mgDatabase dbConf) (mgHost dbConf) (mgPoolSize dbConf) f
|
withMongoDBPool (mgDatabase dbConf) (mgHost dbConf) (mgPoolSize dbConf) f
|
||||||
|
|
||||||
|
|||||||
@ -1,6 +1,3 @@
|
|||||||
runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
|
|
||||||
runConnectionPool = runSqlPool
|
|
||||||
|
|
||||||
withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a
|
withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a
|
||||||
withConnectionPool conf f = do
|
withConnectionPool conf f = do
|
||||||
dbConf <- liftIO $ load~upper~ (appEnv conf)
|
dbConf <- liftIO $ load~upper~ (appEnv conf)
|
||||||
|
|||||||
@ -100,3 +100,4 @@ test-suite test
|
|||||||
, yesod-test
|
, yesod-test
|
||||||
, yesod-default
|
, yesod-default
|
||||||
, yesod-core
|
, yesod-core
|
||||||
|
, persistent-~backendLower~ >= 1.0 && < 1.1
|
||||||
|
|||||||
@ -1,6 +1,3 @@
|
|||||||
runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
|
|
||||||
runConnectionPool = runSqlPool
|
|
||||||
|
|
||||||
withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a
|
withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a
|
||||||
withConnectionPool conf f = do
|
withConnectionPool conf f = do
|
||||||
dbConf <- liftIO $ load~upper~ (appEnv conf)
|
dbConf <- liftIO $ load~upper~ (appEnv conf)
|
||||||
|
|||||||
@ -3,7 +3,7 @@ module HomeTest
|
|||||||
( homeSpecs
|
( homeSpecs
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Yesod.Test
|
import TestImport
|
||||||
|
|
||||||
homeSpecs :: Specs
|
homeSpecs :: Specs
|
||||||
homeSpecs =
|
homeSpecs =
|
||||||
|
|||||||
14
yesod/scaffold/tests/TestImport.hs.cg
Normal file
14
yesod/scaffold/tests/TestImport.hs.cg
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module TestImport
|
||||||
|
( module Yesod.Test
|
||||||
|
, runDB
|
||||||
|
, Specs
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Yesod.Test
|
||||||
|
import Database.Persist.~importGenericDB~
|
||||||
|
|
||||||
|
type Specs = SpecsConn Connection
|
||||||
|
|
||||||
|
runDB :: ~dbMonad~ IO a -> OneSpec Connection a
|
||||||
|
runDB = runDBRunner ~poolRunner~
|
||||||
@ -31,6 +31,7 @@ extra-source-files:
|
|||||||
scaffold/.ghci.cg
|
scaffold/.ghci.cg
|
||||||
scaffold/tests/main.hs.cg
|
scaffold/tests/main.hs.cg
|
||||||
scaffold/tests/HomeTest.hs.cg
|
scaffold/tests/HomeTest.hs.cg
|
||||||
|
scaffold/tests/TestImport.hs.cg
|
||||||
scaffold/Settings.hs.cg
|
scaffold/Settings.hs.cg
|
||||||
scaffold/Settings/Development.hs.cg
|
scaffold/Settings/Development.hs.cg
|
||||||
scaffold/Settings/StaticFiles.hs.cg
|
scaffold/Settings/StaticFiles.hs.cg
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user