{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

module Hedgehog.Extras.Test.Base
  ( propertyOnce

  , workspace
  , moduleWorkspace

  , note
  , note_
  , noteM
  , noteM_
  , noteIO
  , noteIO_

  , noteShow
  , noteShow_
  , noteShowM
  , noteShowM_
  , noteShowIO
  , noteShowIO_

  , noteEach
  , noteEach_
  , noteEachM
  , noteEachM_
  , noteEachIO
  , noteEachIO_

  , noteTempFile

  , failWithCustom
  , failMessage

  , assertByDeadlineM
  , assertByDeadlineIO
  , assertByDeadlineMFinally
  , assertByDeadlineIOFinally
  , assertM
  , assertIO

  , onFailure

  , Integration
  , release

  , runFinallies
  ) where

import           Control.Concurrent.STM as STM
import           Control.Monad
import           Control.Monad.Catch (MonadCatch)
import           Control.Monad.Morph (hoist)
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource (ReleaseKey, runResourceT)
import           Data.Bool
import           Data.Either (Either (..))
import           Data.Eq
import           Data.Foldable
import           Data.Function (($), (.))
import           Data.Maybe (Maybe (..), listToMaybe, maybe)
import           Data.Monoid (Monoid (..))
import           Data.Ord
import           Data.Semigroup (Semigroup (..))
import           Data.String (String)
import           Data.Time.Clock (UTCTime)
import           Data.Traversable
import           Data.Tuple
import           GHC.Stack (CallStack, HasCallStack)
import           Hedgehog (MonadTest)
import           Hedgehog.Extras.Internal.Test.Integration
import           Hedgehog.Extras.Stock.CallStack
import           Hedgehog.Extras.Stock.Monad
import           Hedgehog.Internal.Property (Diff, liftTest, mkTest)
import           Hedgehog.Internal.Source (getCaller)
import           System.IO (FilePath, IO)
import           Text.Show

import qualified Control.Concurrent as IO
import qualified Control.Monad.Trans.Resource as IO
import qualified Data.Time.Clock as DTC
import qualified GHC.Stack as GHC
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Test.MonadAssertion as H
import qualified Hedgehog.Internal.Property as H
import qualified System.Directory as IO
import qualified System.Info as IO
import qualified System.IO as IO
import qualified System.IO.Temp as IO

{- HLINT ignore "Reduce duplication" -}

-- | Run a property with only one test.  This is intended for allowing hedgehog
-- to run unit tests.
propertyOnce :: HasCallStack => Integration () -> H.Property
propertyOnce :: Integration () -> Property
propertyOnce = TestLimit -> Property -> Property
H.withTests TestLimit
1 (Property -> Property)
-> (Integration () -> Property) -> Integration () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
H.property (PropertyT IO () -> Property)
-> (Integration () -> PropertyT IO ())
-> Integration ()
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. ResourceT IO a -> IO a)
-> PropertyT (ResourceT IO) () -> PropertyT IO ()
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. ResourceT IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (PropertyT (ResourceT IO) () -> PropertyT IO ())
-> (Integration () -> PropertyT (ResourceT IO) ())
-> Integration ()
-> PropertyT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 ReaderT IntegrationState (ResourceT IO) a -> ResourceT IO a)
-> Integration () -> PropertyT (ResourceT IO) ()
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a.
ReaderT IntegrationState (ResourceT IO) a -> ResourceT IO a
forall (m :: * -> *) a.
MonadIO m =>
ReaderT IntegrationState m a -> m a
runIntegrationReaderT

-- | Takes a 'CallStack' so the error can be rendered at the appropriate call site.
failWithCustom :: MonadTest m => CallStack -> Maybe Diff -> String -> m a
failWithCustom :: CallStack -> Maybe Diff -> String -> m a
failWithCustom CallStack
cs Maybe Diff
mdiff String
msg = Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest (Test a -> m a) -> Test a -> m a
forall a b. (a -> b) -> a -> b
$ (Either Failure a, Journal) -> Test a
forall a. (Either Failure a, Journal) -> Test a
mkTest (Failure -> Either Failure a
forall a b. a -> Either a b
Left (Failure -> Either Failure a) -> Failure -> Either Failure a
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Maybe Diff -> Failure
H.Failure (CallStack -> Maybe Span
getCaller CallStack
cs) String
msg Maybe Diff
mdiff, Journal
forall a. Monoid a => a
mempty)

-- | Takes a 'CallStack' so the error can be rendered at the appropriate call site.
failMessage :: MonadTest m => CallStack -> String -> m a
failMessage :: CallStack -> String -> m a
failMessage CallStack
cs = CallStack -> Maybe Diff -> String -> m a
forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> String -> m a
failWithCustom CallStack
cs Maybe Diff
forall a. Maybe a
Nothing

-- | Create a workspace directory which will exist for at least the duration of
-- the supplied block.
--
-- The directory will have the supplied prefix but contain a generated random
-- suffix to prevent interference between tests
--
-- The directory will be deleted if the block succeeds, but left behind if
-- the block fails.
workspace :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (FilePath -> m ()) -> m ()
workspace :: String -> (String -> m ()) -> m ()
workspace String
prefixPath String -> m ()
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  String
systemTemp <- IO String -> m String
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO String
IO.getCanonicalTemporaryDirectory
  let systemPrefixPath :: String
systemPrefixPath = String
systemTemp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
prefixPath
  IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
IO.createDirectoryIfMissing Bool
True String
systemPrefixPath
  String
ws <- IO String -> m String
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> String -> IO String
IO.createTempDirectory String
systemPrefixPath String
"test"
  String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Workspace: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ws
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
IO.writeFile (String
ws String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/module") String
HasCallStack => String
callerModuleName
  String -> m ()
f String
ws
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
IO.os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"mingw32") (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
IO.removeDirectoryRecursive String
ws

-- | Create a workspace directory which will exist for at least the duration of
-- the supplied block.
--
-- The directory will have the prefix as "$prefixPath/$moduleName" but contain a generated random
-- suffix to prevent interference between tests
--
-- The directory will be deleted if the block succeeds, but left behind if
-- the block fails.
moduleWorkspace :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (FilePath -> m ()) -> m ()
moduleWorkspace :: String -> (String -> m ()) -> m ()
moduleWorkspace String
prefixPath String -> m ()
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  let srcModule :: String
srcModule = String
-> ((String, SrcLoc) -> String) -> Maybe (String, SrcLoc) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"UnknownModule" (SrcLoc -> String
GHC.srcLocModule (SrcLoc -> String)
-> ((String, SrcLoc) -> SrcLoc) -> (String, SrcLoc) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd) ([(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
GHC.getCallStack CallStack
HasCallStack => CallStack
GHC.callStack))
  String -> (String -> m ()) -> m ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> (String -> m ()) -> m ()
workspace (String
prefixPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcModule) String -> m ()
f

-- | Annotate the given string at the context supplied by the callstack.
noteWithCallstack :: MonadTest m => CallStack -> String -> m ()
noteWithCallstack :: CallStack -> String -> m ()
noteWithCallstack CallStack
cs String
a = Log -> m ()
forall (m :: * -> *). MonadTest m => Log -> m ()
H.writeLog (Log -> m ()) -> Log -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Log
H.Annotation (CallStack -> Maybe Span
getCaller CallStack
cs) String
a

-- | Annotate with the given string.
note :: (MonadTest m, HasCallStack) => String -> m String
note :: String -> m String
note String
a = (HasCallStack => m String) -> m String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m String) -> m String)
-> (HasCallStack => m String) -> m String
forall a b. (a -> b) -> a -> b
$ do
  !String
b <- String -> m String
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
H.eval String
a
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
b
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
b

-- | Annotate the given string returning unit.
note_ :: (MonadTest m, HasCallStack) => String -> m ()
note_ :: String -> m ()
note_ String
a = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
a

-- | Annotate the given string in a monadic context.
noteM :: (MonadTest m, MonadCatch m, HasCallStack) => m String -> m String
noteM :: m String -> m String
noteM m String
a = (HasCallStack => m String) -> m String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m String) -> m String)
-> (HasCallStack => m String) -> m String
forall a b. (a -> b) -> a -> b
$ do
  !String
b <- m String -> m String
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM m String
a
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
b
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
b

-- | Annotate the given string in a monadic context returning unit.
noteM_ :: (MonadTest m, MonadCatch m, HasCallStack) => m String -> m ()
noteM_ :: m String -> m ()
noteM_ m String
a = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  !String
b <- m String -> m String
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM m String
a
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
b
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the given string in IO.
noteIO :: (MonadTest m, MonadIO m, HasCallStack) => IO String -> m String
noteIO :: IO String -> m String
noteIO IO String
f = (HasCallStack => m String) -> m String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m String) -> m String)
-> (HasCallStack => m String) -> m String
forall a b. (a -> b) -> a -> b
$ do
  !String
a <- IO String -> m String
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO String
f
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
a
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
a

-- | Annotate the given string in IO returning unit.
noteIO_ :: (MonadTest m, MonadIO m, HasCallStack) => IO String -> m ()
noteIO_ :: IO String -> m ()
noteIO_ IO String
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  !String
a <- IO String -> m String
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO String
f
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
a
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the given value.
noteShow :: (MonadTest m, HasCallStack, Show a) => a -> m a
noteShow :: a -> m a
noteShow a
a = (HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$ do
  !a
b <- a -> m a
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
H.eval a
a
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
b)
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b

-- | Annotate the given value returning unit.
noteShow_ :: (MonadTest m, HasCallStack, Show a) => a -> m ()
noteShow_ :: a -> m ()
noteShow_ a
a = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
a)

-- | Annotate the given value in a monadic context.
noteShowM :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m a
noteShowM :: m a -> m a
noteShowM m a
a = (HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$ do
  !a
b <- m a -> m a
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM m a
a
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
b)
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b

-- | Annotate the given value in a monadic context returning unit.
noteShowM_ :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m ()
noteShowM_ :: m a -> m ()
noteShowM_ m a
a = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  !a
b <- m a -> m a
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
H.evalM m a
a
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
b)
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the given value in IO.
noteShowIO :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a
noteShowIO :: IO a -> m a
noteShowIO IO a
f = (HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$ do
  !a
a <- IO a -> m a
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO a
f
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
a)
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Annotate the given value in IO returning unit.
noteShowIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m ()
noteShowIO_ :: IO a -> m ()
noteShowIO_ IO a
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  !a
a <- IO a -> m a
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO a
f
  CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
a)
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the each value in the given traversable.
noteEach :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m (f a)
noteEach :: f a -> m (f a)
noteEach f a
as = (HasCallStack => m (f a)) -> m (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m (f a)) -> m (f a))
-> (HasCallStack => m (f a)) -> m (f a)
forall a b. (a -> b) -> a -> b
$ do
  f a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  f a -> m (f a)
forall (m :: * -> *) a. Monad m => a -> m a
return f a
as

-- | Annotate the each value in the given traversable returning unit.
noteEach_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m ()
noteEach_ :: f a -> m ()
noteEach_ f a
as = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ f a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Annotate the each value in the given traversable in a monadic context.
noteEachM :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m (f a)
noteEachM :: m (f a) -> m (f a)
noteEachM m (f a)
f = (HasCallStack => m (f a)) -> m (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m (f a)) -> m (f a))
-> (HasCallStack => m (f a)) -> m (f a)
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- m (f a)
f
  f a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  f a -> m (f a)
forall (m :: * -> *) a. Monad m => a -> m a
return f a
as

-- | Annotate the each value in the given traversable in a monadic context returning unit.
noteEachM_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m ()
noteEachM_ :: m (f a) -> m ()
noteEachM_ m (f a)
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- m (f a)
f
  f a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Annotate the each value in the given traversable in IO.
noteEachIO :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m (f a)
noteEachIO :: IO (f a) -> m (f a)
noteEachIO IO (f a)
f = (HasCallStack => m (f a)) -> m (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m (f a)) -> m (f a))
-> (HasCallStack => m (f a)) -> m (f a)
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- IO (f a) -> m (f a)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO (f a)
f
  f a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  f a -> m (f a)
forall (m :: * -> *) a. Monad m => a -> m a
return f a
as

-- | Annotate the each value in the given traversable in IO returning unit.
noteEachIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m ()
noteEachIO_ :: IO (f a) -> m ()
noteEachIO_ IO (f a)
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- IO (f a) -> m (f a)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO (f a)
f
  f a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> m ()
forall (m :: * -> *). MonadTest m => CallStack -> String -> m ()
noteWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Return the test file path after annotating it relative to the project root directory
noteTempFile :: (MonadTest m, HasCallStack) => FilePath -> FilePath -> m FilePath
noteTempFile :: String -> String -> m String
noteTempFile String
tempDir String
filePath = (HasCallStack => m String) -> m String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m String) -> m String)
-> (HasCallStack => m String) -> m String
forall a b. (a -> b) -> a -> b
$ do
  let relPath :: String
relPath = String
tempDir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filePath
  String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.annotate String
relPath
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
relPath

-- | Run the operation 'f' once a second until it returns 'True' or the deadline expires.
--
-- Expiration of the deadline results in an assertion failure
assertByDeadlineIO :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m ()
assertByDeadlineIO :: UTCTime -> IO Bool -> m ()
assertByDeadlineIO UTCTime
deadline IO Bool
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
success <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
f
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
currentTime <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
DTC.getCurrentTime
    if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
deadline
      then do
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay Int
1000000
        UTCTime -> IO Bool -> m ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
UTCTime -> IO Bool -> m ()
assertByDeadlineIO UTCTime
deadline IO Bool
f
      else do
        UTCTime -> m ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
H.annotateShow UTCTime
currentTime
        CallStack -> String -> m ()
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Condition not met by deadline"

-- | Run the operation 'f' once a second until it returns 'True' or the deadline expires.
--
-- Expiration of the deadline results in an assertion failure
assertByDeadlineM :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m ()
assertByDeadlineM :: UTCTime -> m Bool -> m ()
assertByDeadlineM UTCTime
deadline m Bool
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
success <- m Bool
f
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
currentTime <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
DTC.getCurrentTime
    if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
deadline
      then do
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay Int
1000000
        UTCTime -> m Bool -> m ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
UTCTime -> m Bool -> m ()
assertByDeadlineM UTCTime
deadline m Bool
f
      else do
        UTCTime -> m ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
H.annotateShow UTCTime
currentTime
        CallStack -> String -> m ()
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Condition not met by deadline"

-- | Run the operation 'f' once a second until it returns 'True' or the deadline expires.
--
-- The action 'g' is run after expiration of the deadline, but before failure allowing for
-- additional annotations to be presented.
--
-- Expiration of the deadline results in an assertion failure
assertByDeadlineIOFinally :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () -> m ()
assertByDeadlineIOFinally :: UTCTime -> IO Bool -> m () -> m ()
assertByDeadlineIOFinally UTCTime
deadline IO Bool
f m ()
g = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
success <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
f
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
currentTime <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
DTC.getCurrentTime
    if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
deadline
      then do
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay Int
1000000
        UTCTime -> IO Bool -> m () -> m ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
UTCTime -> IO Bool -> m () -> m ()
assertByDeadlineIOFinally UTCTime
deadline IO Bool
f m ()
g
      else do
        UTCTime -> m ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
H.annotateShow UTCTime
currentTime
        m ()
g
        CallStack -> String -> m ()
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Condition not met by deadline"

-- | Run the operation 'f' once a second until it returns 'True' or the deadline expires.
--
-- The action 'g' is run after expiration of the deadline, but before failure allowing for
-- additional annotations to be presented.
--
-- Expiration of the deadline results in an assertion failure
assertByDeadlineMFinally :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () -> m ()
assertByDeadlineMFinally :: UTCTime -> m Bool -> m () -> m ()
assertByDeadlineMFinally UTCTime
deadline m Bool
f m ()
g = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
success <- m Bool
f
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
currentTime <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
DTC.getCurrentTime
    if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
deadline
      then do
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay Int
1000000
        UTCTime -> m Bool -> m () -> m ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
UTCTime -> m Bool -> m () -> m ()
assertByDeadlineMFinally UTCTime
deadline m Bool
f m ()
g
      else do
        UTCTime -> m ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
H.annotateShow UTCTime
currentTime
        m ()
g
        CallStack -> String -> m ()
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Condition not met by deadline"

-- | Run the monadic action 'f' and assert the return value is 'True'.
assertM :: (MonadTest m, HasCallStack) => m Bool -> m ()
assertM :: m Bool -> m ()
assertM m Bool
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m Bool
f m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert

-- | Run the IO action 'f' and assert the return value is 'True'.
assertIO :: (MonadTest m, MonadIO m, HasCallStack) => IO Bool -> m ()
assertIO :: IO Bool -> m ()
assertIO IO Bool
f = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> m Bool
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO Bool -> IO Bool
forall (m :: * -> *) a. (Monad m, NFData a) => m a -> m a
forceM IO Bool
f) m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert

-- | Release the given release key.
release :: (MonadTest m, MonadIO m) => ReleaseKey -> m ()
release :: ReleaseKey -> m ()
release ReleaseKey
k = m () -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
IO.release ReleaseKey
k

onFailure :: Integration () -> Integration ()
onFailure :: Integration () -> Integration ()
onFailure Integration ()
f = do
  IntegrationState
s <- PropertyT
  (ReaderT IntegrationState (ResourceT IO)) IntegrationState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Integration ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Integration ())
-> (STM () -> IO ()) -> STM () -> Integration ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> Integration ()) -> STM () -> Integration ()
forall a b. (a -> b) -> a -> b
$ TVar [Integration ()]
-> ([Integration ()] -> [Integration ()]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar (IntegrationState -> TVar [Integration ()]
integrationStateFinals IntegrationState
s) (Integration ()
fIntegration () -> [Integration ()] -> [Integration ()]
forall a. a -> [a] -> [a]
:)

reportFinally :: Integration () -> Integration ()
reportFinally :: Integration () -> Integration ()
reportFinally Integration ()
f = do
  Either Failure ()
result <- PropertyT
  (ReaderT IntegrationState (ResourceT IO)) (Either Failure ())
-> (Failure
    -> PropertyT
         (ReaderT IntegrationState (ResourceT IO)) (Either Failure ()))
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure ())
forall (m :: * -> *) a.
MonadAssertion m =>
m a -> (Failure -> m a) -> m a
H.catchAssertion ((() -> Either Failure ())
-> Integration ()
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either Failure ()
forall a b. b -> Either a b
Right Integration ()
f) (Either Failure ()
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Failure ()
 -> PropertyT
      (ReaderT IntegrationState (ResourceT IO)) (Either Failure ()))
-> (Failure -> Either Failure ())
-> Failure
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure ()
forall a b. a -> Either a b
Left)

  case Either Failure ()
result of
    Right () -> () -> Integration ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left Failure
a -> String -> Integration ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
note_ (String -> Integration ()) -> String -> Integration ()
forall a b. (a -> b) -> a -> b
$ String
"Unable to run finally: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Failure -> String
forall a. Show a => a -> String
show Failure
a

runFinallies :: Integration a -> Integration a
runFinallies :: Integration a -> Integration a
runFinallies Integration a
f = do
  Either Failure a
result <- PropertyT
  (ReaderT IntegrationState (ResourceT IO)) (Either Failure a)
-> (Failure
    -> PropertyT
         (ReaderT IntegrationState (ResourceT IO)) (Either Failure a))
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure a)
forall (m :: * -> *) a.
MonadAssertion m =>
m a -> (Failure -> m a) -> m a
H.catchAssertion ((a -> Either Failure a)
-> Integration a
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Failure a
forall a b. b -> Either a b
Right Integration a
f) (Either Failure a
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Failure a
 -> PropertyT
      (ReaderT IntegrationState (ResourceT IO)) (Either Failure a))
-> (Failure -> Either Failure a)
-> Failure
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) (Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure a
forall a b. a -> Either a b
Left)

  case Either Failure a
result of
    Right a
a -> a -> Integration a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Left Failure
assertion -> do
      IntegrationState
s <- PropertyT
  (ReaderT IntegrationState (ResourceT IO)) IntegrationState
forall r (m :: * -> *). MonadReader r m => m r
ask
      [Integration ()]
finals <- IO [Integration ()]
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) [Integration ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Integration ()]
 -> PropertyT
      (ReaderT IntegrationState (ResourceT IO)) [Integration ()])
-> (STM [Integration ()] -> IO [Integration ()])
-> STM [Integration ()]
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) [Integration ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM [Integration ()] -> IO [Integration ()]
forall a. STM a -> IO a
STM.atomically (STM [Integration ()]
 -> PropertyT
      (ReaderT IntegrationState (ResourceT IO)) [Integration ()])
-> STM [Integration ()]
-> PropertyT
     (ReaderT IntegrationState (ResourceT IO)) [Integration ()]
forall a b. (a -> b) -> a -> b
$ TVar [Integration ()] -> [Integration ()] -> STM [Integration ()]
forall a. TVar a -> a -> STM a
STM.swapTVar (IntegrationState -> TVar [Integration ()]
integrationStateFinals IntegrationState
s) []
      (Integration () -> Integration ())
-> [Integration ()] -> Integration ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Integration () -> Integration ()
reportFinally [Integration ()]
finals
      Failure -> Integration a
forall (m :: * -> *) a. MonadAssertion m => Failure -> m a
H.throwAssertion Failure
assertion