2 Helpers for creating database tests with hspec and squeal, inspired by Jonathan Fischoff's
3 [hspec-pg-transact](http://hackage.haskell.org/package/hspec-pg-transact).
5 This uses @tmp-postgres@ to automatically and connect to a temporary instance of postgres on a random port.
7 Tests can be written with 'itDB' which is wrapper around 'it' that uses the passed in 'TestDB' to run a db transaction automatically for the test.
9 The libary also provides a few other functions for more fine grained control over running transactions in tests.
11 {-# LANGUAGE DataKinds #-}
12 {-# LANGUAGE FlexibleContexts #-}
13 {-# LANGUAGE MonoLocalBinds #-}
14 {-# LANGUAGE RankNTypes #-}
15 {-# LANGUAGE RecordWildCards #-}
16 {-# LANGUAGE TypeInType #-}
17 {-# LANGUAGE TypeOperators #-}
18 module Squeal.PostgreSQL.Hspec
21 import Control.Exception
23 import Control.Monad.Base (liftBase)
24 import qualified Data.ByteString.Char8 as BSC
25 import qualified Database.Postgres.Temp as Temp
26 import Generics.SOP (K)
27 import Squeal.PostgreSQL
28 import Squeal.PostgreSQL.Pool
31 data TestDB a = TestDB
33 -- ^ Handle for temporary @postgres@ process
35 -- ^ Pool of 50 connections to the temporary @postgres@
38 type Fixtures schema = (Pool (K Connection schema) -> IO ())
39 type Actions schema a = PoolPQ schema IO a
40 type SquealContext schema = TestDB (K Connection schema)
42 -- | Start a temporary @postgres@ process and create a pool of connections to it
44 :: AlignedList (Migration (Terminally PQ IO)) schema0 schema
46 -> IO (SquealContext schema)
47 setupDB migration fixtures = do
48 tempDB <- either throwIO return =<< Temp.startAndLogToTmp []
49 let connectionString = BSC.pack (Temp.connectionString tempDB)
50 putStrLn $ Temp.connectionString tempDB
52 keepConnectionForOneHour = 3600
54 pool <- createConnectionPool
57 keepConnectionForOneHour
59 withConnection connectionString (migrateUp migration)
63 -- | Drop all the connections and shutdown the @postgres@ process
64 teardownDB :: TestDB a -> IO ()
65 teardownDB TestDB {..} = do
66 destroyAllResources pool
67 void $ Temp.stop tempDB
69 -- | Run an 'IO' action with a connection from the pool
70 withPool :: TestDB (K Connection schema) -> Actions schema a -> IO a
71 withPool testDB = liftBase . flip runPoolPQ (pool testDB)
73 -- | Run an 'DB' transaction, using 'transactionally_'
74 withDB :: Actions schema a -> TestDB (K Connection schema) -> IO a
75 withDB action testDB =
76 runPoolPQ (transactionally_ action) (pool testDB)
78 -- | Flipped version of 'withDB'
79 runDB :: TestDB (K Connection schema) -> Actions schema a -> IO a
82 -- | Helper for writing tests. Wrapper around 'it' that uses the passed
83 -- in 'TestDB' to run a db transaction automatically for the test.
84 itDB :: String -> Actions schema a -> SpecWith (TestDB (K Connection schema))
85 itDB msg action = it msg $ void . withDB action
87 -- | Wraps 'describe' with a
90 -- 'beforeAll' ('setupDB' migrate)
93 -- hook for creating a db and a
96 -- 'afterAll' 'teardownDB'
99 -- hook for stopping a db.
101 :: AlignedList (Migration (Terminally PQ IO)) schema0 schema
104 -> SpecWith (SquealContext schema)
106 describeDB migrate fixture str =
107 beforeAll (setupDB migrate fixture) . afterAll teardownDB . describe str