{-# 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.Trans.Resource
  ( InternalState,
    getInternalState,
    liftResourceT,
  )
import Control.Monad.Trans.Resource.Internal
  ( stateAlloc,
    stateCleanup,
  )
import Data.Acquire (ReleaseType (ReleaseNormal))
import TestContainers as Reexports
import TestContainers.Monad (runTestContainer)

-- | 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.
  TestContainer a ->
  (a -> IO ()) ->
  IO ()
withContainers :: forall a. TestContainer a -> (a -> IO ()) -> IO ()
withContainers TestContainer a
startContainers = forall b c. (((a, b) -> c) -> c) -> (a -> c) -> c
dropState forall a b. (a -> b) -> a -> b
$ 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 :: TestContainer b -> IO b
runC TestContainer b
action = do
      Config
config <- IO Config
determineConfig
      forall a. Config -> TestContainer a -> IO a
runTestContainer Config
config TestContainer b
action

    acquire :: IO (a, InternalState)
    acquire :: IO (a, InternalState)
acquire = forall {b}. TestContainer b -> IO b
runC forall a b. (a -> b) -> a -> b
$ do
      a
result <- TestContainer a
startContainers
      InternalState
releaseMap <- forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT forall (m :: * -> *). Monad m => ResourceT m InternalState
getInternalState

      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ InternalState -> IO ()
stateAlloc InternalState
releaseMap
      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 :: forall b c. (((a, b) -> c) -> c) -> (a -> c) -> c
dropState = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))