50 lines
1.4 KiB
Haskell
50 lines
1.4 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
module TestUtil where
|
|
|
|
import Control.Exception
|
|
import Control.Monad
|
|
import qualified Data.ByteString.Char8 as BSC
|
|
import Data.Pool
|
|
import qualified Database.Postgres.Temp as Temp
|
|
import Database.PostgreSQL.Simple
|
|
import Database.PostgreSQL.Transact
|
|
import Test.Hspec
|
|
|
|
describeDB :: (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
|
|
describeDB migrate str =
|
|
beforeAll (setupDB migrate) . afterAll teardownDB . describe str
|
|
|
|
setupDB :: (Connection -> IO ()) -> IO TestDB
|
|
setupDB migrate = do
|
|
tempDB <- either throwIO return =<< Temp.start
|
|
putStrLn $ BSC.unpack $ Temp.toConnectionString tempDB
|
|
pool <- createPool
|
|
(connectPostgreSQL (Temp.toConnectionString tempDB))
|
|
close
|
|
1
|
|
100000000
|
|
50
|
|
withResource pool migrate
|
|
return TestDB {..}
|
|
|
|
teardownDB :: TestDB -> IO ()
|
|
teardownDB TestDB {..} = do
|
|
destroyAllResources pool
|
|
void $ Temp.stop tempDB
|
|
|
|
withPool :: TestDB -> (Connection -> IO a) -> IO a
|
|
withPool testDB = withResource (pool testDB)
|
|
|
|
itDB :: String -> DB a -> SpecWith TestDB
|
|
itDB msg action = it msg $ void . withDB action
|
|
|
|
withDB :: DB a -> TestDB -> IO a
|
|
withDB action testDB =
|
|
withResource (pool testDB) (runDBTSerializable action)
|
|
|
|
data TestDB = TestDB
|
|
{ tempDB :: Temp.DB
|
|
-- ^ Handle for temporary @postgres@ process
|
|
, pool :: Pool Connection
|
|
-- ^ Pool of 50 connections to the temporary @postgres@
|
|
}
|