diff --git a/yesod-bin/ChangeLog.md b/yesod-bin/ChangeLog.md index 5f6a5c5c..b52bab26 100644 --- a/yesod-bin/ChangeLog.md +++ b/yesod-bin/ChangeLog.md @@ -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 diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index a49d4f18..2d46d213 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -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); })(); } - \ - \ {-# 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." + diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index d72e8dd0..01409649 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -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); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index a99bef30..2ffd7fc7 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -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); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index d4d1fed6..7e536c61 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -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); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index e694909c..8777b75b 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -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); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index 303daa1e..a9888d02 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -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); })(); } - \ - \ {-# 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)