module Test.Hspec.DB where
import Control.Monad
import Data.Pool
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Transact
import qualified Database.Postgres.Temp as Temp
import Test.Hspec
data TestDB = TestDB
{ TestDB -> DB
tempDB :: Temp.DB
, TestDB -> Pool Connection
pool :: Pool Connection
}
setupDB :: (Connection -> IO ()) -> IO (Either Temp.StartError TestDB)
setupDB :: (Connection -> IO ()) -> IO (Either StartError TestDB)
setupDB = Config -> (Connection -> IO ()) -> IO (Either StartError TestDB)
setupDBWithConfig Config
Temp.defaultConfig
setupDBWithConfig :: Temp.Config
-> (Connection -> IO ())
-> IO (Either Temp.StartError TestDB)
setupDBWithConfig :: Config -> (Connection -> IO ()) -> IO (Either StartError TestDB)
setupDBWithConfig Config
c Connection -> IO ()
f =
(DB -> IO TestDB)
-> Either StartError DB -> IO (Either StartError TestDB)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Connection -> IO ()) -> DB -> IO TestDB
wrapCallback Connection -> IO ()
f) (Either StartError DB -> IO (Either StartError TestDB))
-> IO (Either StartError DB) -> IO (Either StartError TestDB)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Config -> IO (Either StartError DB)
Temp.startConfig Config
c
wrapCallback :: (Connection -> IO ()) -> Temp.DB -> IO TestDB
wrapCallback :: (Connection -> IO ()) -> DB -> IO TestDB
wrapCallback Connection -> IO ()
f DB
d = do
Pool Connection
p <- IO Connection
-> (Connection -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool Connection)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool
(ByteString -> IO Connection
connectPostgreSQL (ByteString -> IO Connection) -> ByteString -> IO Connection
forall a b. (a -> b) -> a -> b
$ DB -> ByteString
Temp.toConnectionString DB
d)
Connection -> IO ()
close
Int
1
NominalDiffTime
100000000
Int
50
Pool Connection -> (Connection -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool Connection
p Connection -> IO ()
f
TestDB -> IO TestDB
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestDB -> IO TestDB) -> TestDB -> IO TestDB
forall a b. (a -> b) -> a -> b
$ DB -> Pool Connection -> TestDB
TestDB DB
d Pool Connection
p
teardownDB :: TestDB -> IO ()
teardownDB :: TestDB -> IO ()
teardownDB (TestDB DB
d Pool Connection
p) = do
Pool Connection -> IO ()
forall a. Pool a -> IO ()
destroyAllResources Pool Connection
p
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DB -> IO ()
Temp.stop DB
d
withPool :: TestDB -> (Connection -> IO a) -> IO a
withPool :: TestDB -> (Connection -> IO a) -> IO a
withPool TestDB
testDB = Pool Connection -> (Connection -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource (TestDB -> Pool Connection
pool TestDB
testDB)
withDB :: DB a -> TestDB -> IO a
withDB :: DB a -> TestDB -> IO a
withDB DB a
action TestDB
testDB =
Pool Connection -> (Connection -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource (TestDB -> Pool Connection
pool TestDB
testDB) (DB a -> Connection -> IO a
forall (m :: * -> *) a.
MonadBaseControl IO m =>
DBT m a -> Connection -> m a
runDBTSerializable DB a
action)
runDB :: TestDB -> DB a -> IO a
runDB :: TestDB -> DB a -> IO a
runDB = (DB a -> TestDB -> IO a) -> TestDB -> DB a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DB a -> TestDB -> IO a
forall a. DB a -> TestDB -> IO a
withDB
itDB :: String -> DB a -> SpecWith TestDB
itDB :: String -> DB a -> SpecWith TestDB
itDB String
msg DB a
action = String -> (TestDB -> IO ()) -> SpecWith (Arg (TestDB -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
msg ((TestDB -> IO ()) -> SpecWith (Arg (TestDB -> IO ())))
-> (TestDB -> IO ()) -> SpecWith (Arg (TestDB -> IO ()))
forall a b. (a -> b) -> a -> b
$ IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> (TestDB -> IO a) -> TestDB -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DB a -> TestDB -> IO a
forall a. DB a -> TestDB -> IO a
withDB DB a
action
describeDB :: (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDB :: (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDB = Config
-> (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDBWithConfig Config
Temp.defaultConfig
describeDBWithConfig :: Temp.Config -> (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDBWithConfig :: Config
-> (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDBWithConfig Config
c Connection -> IO ()
f String
s =
IO TestDB -> SpecWith TestDB -> Spec
forall a. IO a -> SpecWith a -> Spec
beforeAll (Either StartError TestDB -> IO TestDB
catch (Either StartError TestDB -> IO TestDB)
-> IO (Either StartError TestDB) -> IO TestDB
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Config -> (Connection -> IO ()) -> IO (Either StartError TestDB)
setupDBWithConfig Config
c Connection -> IO ()
f) (SpecWith TestDB -> Spec)
-> (SpecWith TestDB -> SpecWith TestDB) -> SpecWith TestDB -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestDB -> IO ()) -> SpecWith TestDB -> SpecWith TestDB
forall a. HasCallStack => ActionWith a -> SpecWith a -> SpecWith a
afterAll TestDB -> IO ()
teardownDB (SpecWith TestDB -> SpecWith TestDB)
-> (SpecWith TestDB -> SpecWith TestDB)
-> SpecWith TestDB
-> SpecWith TestDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SpecWith TestDB -> SpecWith TestDB
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
s
where
catch :: Either Temp.StartError TestDB -> IO TestDB
catch :: Either StartError TestDB -> IO TestDB
catch Either StartError TestDB
r = case Either StartError TestDB
r of
Left StartError
x -> String -> IO TestDB
forall a. HasCallStack => String -> a
error (StartError -> String
forall a. Show a => a -> String
show StartError
x)
Right TestDB
db -> TestDB -> IO TestDB
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestDB
db