{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module TestContainers.Hspec
  (
    -- * Running containers for tests
    withContainers

    -- * Re-exports for convenience
  , module Reexports
  ) where

import           Control.Exception                     (bracket)
import           Control.Monad.IO.Class                (liftIO)
import           Control.Monad.Reader                  (runReaderT)
import           Control.Monad.Trans.Resource          (InternalState,
                                                        getInternalState)
import           Control.Monad.Trans.Resource.Internal (stateAlloc,
                                                        stateCleanup)
import           Data.Acquire                          (ReleaseType (ReleaseNormal))

import           TestContainers                        as Reexports


-- | Allow `Hspec.Spec` to depend on Docker containers. Hspec takes care of
-- initialization and de-initialization of the containers.
--
-- @
--
-- containers :: MonadDocker m => m Boolean
-- containers = do
--   _redis <- TestContainers.run $ TestContainers.containerRequest TestContainers.redis
--   _kafka <- TestContainers.run $ TestContainers.containerRequest TestContainers.kafka
--   pure True
--
-- example :: Spec
-- example =
--   around (withContainers containers) $ describe "Example tests"
--     it "first test" $ \\isBoolean -> do
--       isBoolean `shouldBe` True
-- @
--
-- `withContainers` allows you naturally scope the handling of containers for your tests.
withContainers
  :: forall a
  .  (forall m. MonadDocker m => m a)
  -> (a -> IO ())
  -> IO ()
withContainers :: (forall (m :: * -> *). MonadDocker m => m a)
-> (a -> IO ()) -> IO ()
withContainers forall (m :: * -> *). MonadDocker m => m a
startContainers = (((a, InternalState) -> IO ()) -> IO ()) -> (a -> IO ()) -> IO ()
forall b c. (((a, b) -> c) -> c) -> (a -> c) -> c
dropState ((((a, InternalState) -> IO ()) -> IO ()) -> (a -> IO ()) -> IO ())
-> (((a, InternalState) -> IO ()) -> IO ())
-> (a -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ IO (a, InternalState)
-> ((a, InternalState) -> IO ())
-> ((a, InternalState) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (a, InternalState)
acquire (a, InternalState) -> IO ()
release
  where
    runC :: ResourceT (ReaderT Config IO) b -> IO b
runC ResourceT (ReaderT Config IO) b
action = do
      Config
config <- IO Config
determineConfig
      ReaderT Config IO b -> Config -> IO b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ResourceT (ReaderT Config IO) b -> ReaderT Config IO b
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (ReaderT Config IO) b
action) Config
config

    acquire :: IO (a, InternalState)
    acquire :: IO (a, InternalState)
acquire = ResourceT (ReaderT Config IO) (a, InternalState)
-> IO (a, InternalState)
forall b. ResourceT (ReaderT Config IO) b -> IO b
runC (ResourceT (ReaderT Config IO) (a, InternalState)
 -> IO (a, InternalState))
-> ResourceT (ReaderT Config IO) (a, InternalState)
-> IO (a, InternalState)
forall a b. (a -> b) -> a -> b
$ do
        a
result     <- ResourceT (ReaderT Config IO) a
forall (m :: * -> *). MonadDocker m => m a
startContainers
        InternalState
releaseMap <- ResourceT (ReaderT Config IO) InternalState
forall (m :: * -> *). Monad m => ResourceT m InternalState
getInternalState

        IO () -> ResourceT (ReaderT Config IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT (ReaderT Config IO) ())
-> IO () -> ResourceT (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ InternalState -> IO ()
stateAlloc InternalState
releaseMap
        (a, InternalState)
-> ResourceT (ReaderT Config IO) (a, InternalState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
result, InternalState
releaseMap)

    release :: (a, InternalState) -> IO ()
    release :: (a, InternalState) -> IO ()
release (a
_, InternalState
internalState) =
      ReleaseType -> InternalState -> IO ()
stateCleanup ReleaseType
ReleaseNormal InternalState
internalState

    dropState :: (((a, b) -> c) -> c) -> (a -> c) -> c
    dropState :: (((a, b) -> c) -> c) -> (a -> c) -> c
dropState = ((((a, b) -> c) -> c) -> ((a -> c) -> (a, b) -> c) -> (a -> c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> c) -> ((a, b) -> a) -> (a, b) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst))