aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Squeal
diff options
context:
space:
mode:
Diffstat (limited to 'src/Squeal')
-rw-r--r--src/Squeal/PostgreSQL/Hspec.hs114
1 files changed, 114 insertions, 0 deletions
diff --git a/src/Squeal/PostgreSQL/Hspec.hs b/src/Squeal/PostgreSQL/Hspec.hs
new file mode 100644
index 0000000..44011b7
--- /dev/null
+++ b/src/Squeal/PostgreSQL/Hspec.hs
@@ -0,0 +1,114 @@
1{-|
2Helpers 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).
4
5This uses @tmp-postgres@ to automatically and connect to a temporary instance of postgres on a random port.
6
7Tests 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.
8
9The libary also provides a few other functions for more fine grained control over running transactions in tests.
10-}
11{-# LANGUAGE DataKinds #-}
12{-# LANGUAGE FlexibleContexts #-}
13{-# LANGUAGE KindSignatures #-}
14{-# LANGUAGE MonoLocalBinds #-}
15{-# LANGUAGE RankNTypes #-}
16{-# LANGUAGE RecordWildCards #-}
17{-# LANGUAGE TypeInType #-}
18{-# LANGUAGE TypeOperators #-}
19module Squeal.PostgreSQL.Hspec
20where
21
22import Control.Exception
23import Control.Monad
24import Control.Monad.Base (liftBase)
25import Control.Monad.Trans.Control (MonadBaseControl)
26import qualified Data.ByteString.Char8 as BSC
27import qualified Database.Postgres.Temp as Temp
28import Generics.SOP (K)
29import Squeal.PostgreSQL
30import Squeal.PostgreSQL.Migration
31import Squeal.PostgreSQL.Pool
32import Test.Hspec
33
34data TestDB a = TestDB
35 { tempDB :: Temp.DB
36 -- ^ Handle for temporary @postgres@ process
37 , pool :: Pool a
38 -- ^ Pool of 50 connections to the temporary @postgres@
39 }
40
41type Migrations schema m a = (MonadBaseControl IO m) =>
42 PQ (("schema_migrations" ::: Table MigrationsTable) ': '[])
43 (("schema_migrations" ::: Table MigrationsTable) ': schema) m a
44
45type Fixtures schema = (Pool (K Connection schema) -> IO ())
46type Actions schema a = PoolPQ schema IO a
47type SquealContext (schema :: SchemaType) = TestDB (K Connection schema)
48
49-- | Start a temporary @postgres@ process and create a pool of connections to it
50setupDB
51 :: Migrations schema IO a
52 -> Fixtures schema
53 -> IO (SquealContext schema)
54setupDB migration fixtures = do
55 tempDB <- either throwIO return =<< Temp.startAndLogToTmp []
56 let connectionString = BSC.pack (Temp.connectionString tempDB)
57 putStrLn $ Temp.connectionString tempDB
58 let singleStripe = 1
59 keepConnectionForOneHour = 3600
60 poolSizeOfFifty = 50
61 pool <- createConnectionPool
62 connectionString
63 singleStripe
64 keepConnectionForOneHour
65 poolSizeOfFifty
66 withConnection connectionString migration
67 fixtures pool
68 pure TestDB {..}
69
70-- | Drop all the connections and shutdown the @postgres@ process
71teardownDB :: TestDB a -> IO ()
72teardownDB TestDB {..} = do
73 destroyAllResources pool
74 void $ Temp.stop tempDB
75
76-- | Run an 'IO' action with a connection from the pool
77withPool :: TestDB (K Connection schema) -> Actions schema a -> IO a
78withPool testDB = liftBase . flip runPoolPQ (pool testDB)
79
80-- | Run an 'DB' transaction, using 'transactionally_'
81withDB :: Actions schema a -> TestDB (K Connection schema) -> IO a
82withDB action testDB =
83 runPoolPQ (transactionally_ action) (pool testDB)
84
85-- | Flipped version of 'withDB'
86runDB :: TestDB (K Connection schema) -> Actions schema a -> IO a
87runDB = flip withDB
88
89-- | Helper for writing tests. Wrapper around 'it' that uses the passed
90-- in 'TestDB' to run a db transaction automatically for the test.
91itDB :: String -> Actions schema a -> SpecWith (TestDB (K Connection schema))
92itDB msg action = it msg $ void . withDB action
93
94-- | Wraps 'describe' with a
95--
96-- @
97-- 'beforeAll' ('setupDB' migrate)
98-- @
99--
100-- hook for creating a db and a
101--
102-- @
103-- 'afterAll' 'teardownDB'
104-- @
105--
106-- hook for stopping a db.
107describeDB
108 :: Migrations schema IO a
109 -> Fixtures schema
110 -> String
111 -> SpecWith (SquealContext schema)
112 -> Spec
113describeDB migrate fixture str =
114 beforeAll (setupDB migrate fixture) . afterAll teardownDB . describe str