{-# 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.
--
-- @
-- data ContainerPorts = ContainerPorts {
--   redisPort :: Int,
--   kafkaPort :: Int
-- }
--
-- containers :: MonadDocker m => m ContainerPorts
-- containers = do
--   redis <- TestContainers.run $ TestContainers.containerRequest TestContainers.redis
--   kafka <- TestContainers.run $ TestContainers.containerRequest TestContainers.kafka
--   pure ContainerPorts {
--     redisPort = TestContainers.containerPort redis "6379/tcp",
--     kafkaPort = TestContainers.containerPort kafka "9092/tcp"
--   }
--
-- example :: Spec
-- example =
--   around (withContainers containers) $ describe "Example tests"
--     it "some test that uses redis and kafka" $ \ContainerPorts{redisPort, kafkaPort} -> do
--       redisPort `shouldNotBe` kafkaPort
-- @
--
-- `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 = (((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 :: TestContainer b -> IO b
runC TestContainer b
action = do
      Config
config <- IO Config
determineConfig
      Config -> TestContainer b -> IO b
forall a. Config -> TestContainer a -> IO a
runTestContainer Config
config TestContainer b
action

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

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