{-# LANGUAGE DeriveGeneric #-}

module Hedgehog.Extras.Internal.Test.Integration
  ( Integration
  , IntegrationState(..)
  , newIntegrationStateIO
  , newIntegrationStateM
  , runIntegrationReaderT
  ) where

import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad.Reader (ReaderT(runReaderT) )
import           Control.Monad.Trans.Resource (ResourceT)
import           Data.Functor ( (<$>) )
import           GHC.Generics (Generic)
import           System.IO (IO)

import qualified Control.Concurrent.STM as STM
import qualified Hedgehog as H

newtype IntegrationState = IntegrationState
  { IntegrationState -> TVar [Integration ()]
integrationStateFinals :: STM.TVar [Integration ()]
  } deriving (forall x. Rep IntegrationState x -> IntegrationState
forall x. IntegrationState -> Rep IntegrationState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IntegrationState x -> IntegrationState
$cfrom :: forall x. IntegrationState -> Rep IntegrationState x
Generic)

type Integration a = H.PropertyT (ReaderT IntegrationState (ResourceT IO)) a

newIntegrationStateIO :: IO IntegrationState
newIntegrationStateIO :: IO IntegrationState
newIntegrationStateIO = TVar [Integration ()] -> IntegrationState
IntegrationState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (TVar a)
STM.newTVarIO []

newIntegrationStateM :: MonadIO m => m IntegrationState
newIntegrationStateM :: forall (m :: * -> *). MonadIO m => m IntegrationState
newIntegrationStateM = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO IntegrationState
newIntegrationStateIO

runIntegrationReaderT :: MonadIO m => ReaderT IntegrationState m a -> m a
runIntegrationReaderT :: forall (m :: * -> *) a.
MonadIO m =>
ReaderT IntegrationState m a -> m a
runIntegrationReaderT ReaderT IntegrationState m a
f = do
  IntegrationState
s <- forall (m :: * -> *). MonadIO m => m IntegrationState
newIntegrationStateM
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT IntegrationState m a
f IntegrationState
s