web/test/TestImport.hs

   1 module TestImport
   2     ( module TestImport
   3     , module X
   4     ) where
   5
   6 import Application           (makeFoundation)
   7 import ClassyPrelude         as X
   8 import Database.Persist      as X hiding (get)
   9 import Database.Persist.Sql  (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName)
  10 import Foundation            as X
  11 import Model                 as X
  12 import Test.Hspec            as X
  13 import Text.Shakespeare.Text (st)
  14 import Yesod.Default.Config2 (ignoreEnv, loadAppSettings)
  15 import Yesod.Test            as X
  16
  17 -- Wiping the database
  18 import Database.Persist.Sqlite              (sqlDatabase, wrapConnection, createSqlPool)
  19 import qualified Database.Sqlite as Sqlite
  20 import Control.Monad.Logger                 (runLoggingT)
  21 import Settings (appDatabaseConf)
  22 import Yesod.Core (messageLoggerSource)
  23
  24 runDB :: SqlPersistM a -> YesodExample App a
  25 runDB query = do
  26     pool <- fmap appConnPool getTestYesod
  27     liftIO $ runSqlPersistMPool query pool
  28
  29 withApp :: SpecWith App -> Spec
  30 withApp = before $ do
  31     settings <- loadAppSettings
  32         ["config/test-settings.yml", "config/settings.yml"]
  33         []
  34         ignoreEnv
  35     foundation <- makeFoundation settings
  36     wipeDB foundation
  37     return foundation
  38
  39 -- This function will truncate all of the tables in your database.
  40 -- 'withApp' calls it before each test, creating a clean environment for each
  41 -- spec to run in.
  42 wipeDB :: App -> IO ()
  43 wipeDB app = do
  44     -- In order to wipe the database, we need to temporarily disable foreign key checks.
  45     -- Unfortunately, disabling FK checks in a transaction is a noop in SQLite.
  46     -- Normal Persistent functions will wrap your SQL in a transaction,
  47     -- so we create a raw SQLite connection to disable foreign keys.
  48     -- Foreign key checks are per-connection, so this won't effect queries outside this function.
  49
  50     -- Aside: SQLite by default *does not enable foreign key checks*
  51     -- (disabling foreign keys is only necessary for those who specifically enable them).
  52     let settings = appSettings app
  53     sqliteConn <- rawConnection (sqlDatabase $ appDatabaseConf settings)
  54     disableForeignKeys sqliteConn
  55
  56     let logFunc = messageLoggerSource app (appLogger app)
  57     pool <- runLoggingT (createSqlPool (wrapConnection sqliteConn) 1) logFunc
  58
  59     flip runSqlPersistMPool pool $ do
  60         tables <- getTables
  61         sqlBackend <- ask
  62         let queries = map (\t -> "DELETE FROM " ++ (connEscapeName sqlBackend $ DBName t)) tables
  63         forM_ queries (\q -> rawExecute q [])
  64
  65 rawConnection :: Text -> IO Sqlite.Connection
  66 rawConnection t = Sqlite.open t
  67
  68 disableForeignKeys :: Sqlite.Connection -> IO ()
  69 disableForeignKeys conn = Sqlite.prepare conn "PRAGMA foreign_keys = OFF;" >>= void . Sqlite.step
  70
  71 getTables :: MonadIO m => ReaderT SqlBackend m [Text]
  72 getTables = do
  73     tables <- rawSql "SELECT name FROM sqlite_master WHERE type = 'table';" []
  74     return (fmap unSingle tables)