More scaffolding updates

This commit is contained in:
Michael Snoyman 2015-01-21 23:42:37 +02:00
parent b5648f8756
commit a6a8b3fa68
7 changed files with 81 additions and 47 deletions

View File

@ -5,6 +5,7 @@ Scaffolding updates:
* Improve `DevelMain` support
* Wipe out database during test runs
* Convenience `unsafeHandler` function
* Remove deprecated Chrome Frame code
## 1.4.3.3

View File

@ -565,9 +565,11 @@ test-suite test
, resourcet
, monad-logger
, transformers
, hspec
, hspec >= 2.0.0
, classy-prelude
, classy-prelude-yesod
, mongoDB
, monad-control
{-# START_FILE Settings.hs #-}
-- | Settings are centralized, as much as possible, into this file. This
@ -8965,12 +8967,6 @@ $newline never
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- 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]-->
{-# START_FILE templates/default-layout.hamlet #-}
$maybe msg <- mmsg
@ -9101,14 +9097,22 @@ import Settings (appDatabaseConf)
import Test.Hspec as X
import Yesod.Default.Config2 (ignoreEnv, loadAppSettings)
import Yesod.Test as X
-- Wiping the test database
import Database.MongoDB.Query (allCollections)
import Database.MongoDB.Admin (dropCollection)
import Control.Monad.Trans.Control (MonadBaseControl)
runDB :: Action IO a -> YesodExample App a
runDB action = do
master <- getTestYesod
liftIO $ runDBWithApp master action
runDBWithApp :: App -> Action IO a -> IO a
runDBWithApp app action = do
liftIO $ runMongoDBPool
(mgAccessMode $ appDatabaseConf $ appSettings master)
(mgAccessMode $ appDatabaseConf $ appSettings app)
action
(appConnPool master)
(appConnPool app)
withApp :: SpecWith App -> Spec
withApp = before $ do
@ -9116,5 +9120,19 @@ withApp = before $ do
["config/test-settings.yml", "config/settings.yml"]
[]
ignoreEnv
makeFoundation settings
app <- makeFoundation settings
wipeDB app
return app
-- This function will wipe your database.
-- 'withApp' calls it before each test, creating a clean environment for each
-- spec to run in.
wipeDB :: App -> IO ()
wipeDB app = void $ runDBWithApp app dropAllCollections
dropAllCollections :: (MonadIO m, MonadBaseControl IO m) => Action m [Bool]
dropAllCollections = allCollections >>= return . filter (not . isSystemCollection) >>= mapM dropCollection
where
isSystemCollection = isPrefixOf "system."

View File

@ -576,7 +576,7 @@ test-suite test
, resourcet
, monad-logger
, transformers
, hspec
, hspec >= 2.0.0
, classy-prelude
, classy-prelude-yesod
@ -8977,12 +8977,6 @@ $newline never
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- 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]-->
{-# START_FILE templates/default-layout.hamlet #-}
$maybe msg <- mmsg

View File

@ -620,7 +620,7 @@ test-suite test
, resourcet
, monad-logger
, transformers
, hspec
, hspec >= 2.0.0
, classy-prelude
, classy-prelude-yesod
@ -9092,12 +9092,6 @@ $newline never
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- 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]-->
{-# START_FILE templates/default-layout.hamlet #-}
$maybe msg <- mmsg

View File

@ -576,7 +576,7 @@ test-suite test
, resourcet
, monad-logger
, transformers
, hspec
, hspec >= 2.0.0
, classy-prelude
, classy-prelude-yesod
@ -8977,12 +8977,6 @@ $newline never
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- 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]-->
{-# START_FILE templates/default-layout.hamlet #-}
$maybe msg <- mmsg

View File

@ -484,7 +484,7 @@ test-suite test
, yesod-test >= 1.4.2 && < 1.5
, yesod-core
, yesod
, hspec
, hspec >= 2.0.0
, classy-prelude
, classy-prelude-yesod
@ -8858,12 +8858,6 @@ $newline never
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- 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]-->
{-# START_FILE templates/default-layout.hamlet #-}
$maybe msg <- mmsg

View File

@ -576,7 +576,7 @@ test-suite test
, resourcet
, monad-logger
, transformers
, hspec
, hspec >= 2.0.0
, classy-prelude
, classy-prelude-yesod
@ -8995,12 +8995,6 @@ $newline never
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- 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]-->
{-# START_FILE templates/default-layout.hamlet #-}
$maybe msg <- mmsg
@ -9124,13 +9118,20 @@ module TestImport
import Application (makeFoundation)
import ClassyPrelude as X
import Database.Persist as X hiding (get)
import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool)
import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName)
import Foundation as X
import Model as X
import Test.Hspec as X
import Yesod.Default.Config2 (ignoreEnv, loadAppSettings)
import Yesod.Test as X
-- Wiping the database
import Database.Persist.Sqlite (sqlDatabase, wrapConnection, createSqlPool)
import qualified Database.Sqlite as Sqlite
import Control.Monad.Logger (runLoggingT)
import Settings (appDatabaseConf)
import Yesod.Core (messageLoggerSource)
runDB :: SqlPersistM a -> YesodExample App a
runDB query = do
pool <- fmap appConnPool getTestYesod
@ -9142,5 +9143,43 @@ withApp = before $ do
["config/test-settings.yml", "config/settings.yml"]
[]
ignoreEnv
makeFoundation settings
foundation <- makeFoundation settings
wipeDB foundation
return foundation
-- This function will truncate all of the tables in your database.
-- 'withApp' calls it before each test, creating a clean environment for each
-- spec to run in.
wipeDB :: App -> IO ()
wipeDB app = do
-- In order to wipe the database, we need to temporarily disable foreign key checks.
-- Unfortunately, disabling FK checks in a transaction is a noop in SQLite.
-- Normal Persistent functions will wrap your SQL in a transaction,
-- so we create a raw SQLite connection to disable foreign keys.
-- Foreign key checks are per-connection, so this won't effect queries outside this function.
-- Aside: SQLite by default *does not enable foreign key checks*
-- (disabling foreign keys is only necessary for those who specifically enable them).
let settings = appSettings app
sqliteConn <- rawConnection (sqlDatabase $ appDatabaseConf settings)
disableForeignKeys sqliteConn
let logFunc = messageLoggerSource app (appLogger app)
pool <- runLoggingT (createSqlPool (wrapConnection sqliteConn) 1) logFunc
flip runSqlPersistMPool pool $ do
tables <- getTables
sqlBackend <- ask
let queries = map (\t -> "DELETE FROM " ++ (connEscapeName sqlBackend $ DBName t)) tables
forM_ queries (\q -> rawExecute q [])
rawConnection :: Text -> IO Sqlite.Connection
rawConnection t = Sqlite.open t
disableForeignKeys :: Sqlite.Connection -> IO ()
disableForeignKeys conn = Sqlite.prepare conn "PRAGMA foreign_keys = OFF;" >>= void . Sqlite.step
getTables :: MonadIO m => ReaderT SqlBackend m [Text]
getTables = do
tables <- rawSql "SELECT name FROM sqlite_master WHERE type = 'table';" []
return (fmap unSingle tables)