]> Git — Sourcephile - comptalang.git/blob - web/test/TestImport.hs
Correction : rétro support de GHC 7.6.3 (Debian/jessie).
[comptalang.git] / 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)