    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ConstraintKinds #-}
    -- | Stability: provisional
    module Test.Hspec.Core.Hooks (
    -- * Types
      Spec
    , SpecWith
    , ActionWith
    -- * Hooks
    , before
    , before_
    , beforeWith
    , beforeAll
    , beforeAll_
    , beforeAllWith
    , after
    , after_
    , afterAll
    , afterAll_
    , around
    , around_
    , aroundWith
    , aroundAll
    , aroundAll_
    , aroundAllWith

    , mapSubject
    , ignoreSubject

    #ifdef TEST
    , decompose
    #endif
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat

    import           Control.Concurrent

    import           Test.Hspec.Core.Example
    import           Test.Hspec.Core.Tree
    import           Test.Hspec.Core.Spec.Monad

    -- | Run a custom action before every spec item.
    before :: IO a -> SpecWith a -> Spec
    before :: forall a. IO a -> SpecWith a -> Spec
    before IO a
    action = (ActionWith a -> IO ()) -> SpecWith a -> Spec
    forall a. (ActionWith a -> IO ()) -> SpecWith a -> Spec
    around (IO a
    action IO a -> ActionWith a -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=)

    -- | Run a custom action before every spec item.
    before_ :: IO () -> SpecWith a -> SpecWith a
    before_ :: forall a. IO () -> SpecWith a -> SpecWith a
    before_ IO ()
    action = (IO () -> IO ()) -> SpecWith a -> SpecWith a
    forall a. (IO () -> IO ()) -> SpecWith a -> SpecWith a
    around_ (IO ()
    action IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>)

    -- | Run a custom action before every spec item.
    beforeWith :: (b -> IO a) -> SpecWith a -> SpecWith b
    beforeWith :: forall b a. (b -> IO a) -> SpecWith a -> SpecWith b
    beforeWith b -> IO a
    action = (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    forall a b.
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith ((ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b)
    -> (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    forall a b. (a -> b) -> a -> b
    $ \ActionWith a
    e b
    x -> b -> IO a
    action b
    x IO a -> ActionWith a -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ActionWith a
    e

    -- | Run a custom action before the first spec item.
    beforeAll :: HasCallStack => IO a -> SpecWith a -> Spec
    beforeAll :: forall a. HasCallStack => IO a -> SpecWith a -> Spec
    beforeAll IO a
    action SpecWith a
    spec = do
      mvar <- IO (MVar (Memoized a)) -> SpecM () (MVar (Memoized a))
    forall r a. IO r -> SpecM a r
    runIO (Memoized a -> IO (MVar (Memoized a))
    forall a. a -> IO (MVar a)
    newMVar Memoized a
    forall a. Memoized a
    Empty)
      before (memoize mvar action) spec

    -- | Run a custom action before the first spec item.
    beforeAll_ :: HasCallStack => IO () -> SpecWith a -> SpecWith a
    beforeAll_ :: forall a. HasCallStack => IO () -> SpecWith a -> SpecWith a
    beforeAll_ IO ()
    action SpecWith a
    spec = do
      mvar <- IO (MVar (Memoized ())) -> SpecM a (MVar (Memoized ()))
    forall r a. IO r -> SpecM a r
    runIO (Memoized () -> IO (MVar (Memoized ()))
    forall a. a -> IO (MVar a)
    newMVar Memoized ()
    forall a. Memoized a
    Empty)
      before_ (memoize mvar action) spec

    -- | Run a custom action with an argument before the first spec item.
    beforeAllWith :: HasCallStack => (b -> IO a) -> SpecWith a -> SpecWith b
    beforeAllWith :: forall b a. HasCallStack => (b -> IO a) -> SpecWith a -> SpecWith b
    beforeAllWith b -> IO a
    action SpecWith a
    spec = do
      mvar <- IO (MVar (Memoized a)) -> SpecM b (MVar (Memoized a))
    forall r a. IO r -> SpecM a r
    runIO (Memoized a -> IO (MVar (Memoized a))
    forall a. a -> IO (MVar a)
    newMVar Memoized a
    forall a. Memoized a
    Empty)
      beforeWith (memoize mvar . action) spec

    data Memoized a =
        Empty
      | Memoized a
      | Failed SomeException

    memoize :: HasCallStack => MVar (Memoized a) -> IO a -> IO a
    memoize :: forall a. HasCallStack => MVar (Memoized a) -> IO a -> IO a
    memoize MVar (Memoized a)
    mvar IO a
    action = do
      result <- MVar (Memoized a)
    -> (Memoized a -> IO (Memoized a, Either SomeException a))
    -> IO (Either SomeException a)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (Memoized a)
    mvar ((Memoized a -> IO (Memoized a, Either SomeException a))
     -> IO (Either SomeException a))
    -> (Memoized a -> IO (Memoized a, Either SomeException a))
    -> IO (Either SomeException a)
    forall a b. (a -> b) -> a -> b
    $ \Memoized a
    ma -> case Memoized a
    ma of
        Memoized a
    Empty -> do
          a <- IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO a
    action
          return (either Failed Memoized a, a)
        Memoized a
    a -> (Memoized a, Either SomeException a)
    -> IO (Memoized a, Either SomeException a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Memoized a
    ma, a -> Either SomeException a
    forall a b. b -> Either a b
    Right a
    a)
        Failed SomeException
    _ -> ResultStatus -> IO (Memoized a, Either SomeException a)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (Maybe Location -> Maybe String -> ResultStatus
    Pending Maybe Location
    forall a. Maybe a
    Nothing (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String
    "exception in " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    -> ((String, Location) -> String)
    -> Maybe (String, Location)
    -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "beforeAll" (String, Location) -> String
    forall a b. (a, b) -> a
    fst Maybe (String, Location)
    HasCallStack => Maybe (String, Location)
    callSite String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "-hook (see previous failure)"))
      either throwIO return result

    -- | Run a custom action after every spec item.
    after :: ActionWith a -> SpecWith a -> SpecWith a
    after :: forall a. ActionWith a -> SpecWith a -> SpecWith a
    after ActionWith a
    action = (ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a
    forall a b.
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith ((ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a)
    -> (ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a
    forall a b. (a -> b) -> a -> b
    $ \ActionWith a
    e a
    x -> ActionWith a
    e a
    x IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO a
    `finally` ActionWith a
    action a
    x

    -- | Run a custom action after every spec item.
    after_ :: IO () -> SpecWith a -> SpecWith a
    after_ :: forall a. IO () -> SpecWith a -> SpecWith a
    after_ IO ()
    action = ActionWith a -> SpecWith a -> SpecWith a
    forall a. ActionWith a -> SpecWith a -> SpecWith a
    after (ActionWith a -> SpecWith a -> SpecWith a)
    -> ActionWith a -> SpecWith a -> SpecWith a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ -> IO ()
    action

    -- | Run a custom action before and/or after every spec item, supplying it with
    -- an argument obtained via IO.
    --
    -- This is useful for tasks like creating a file handle or similar resource
    -- before a test and destroying it after the test.
    around
      :: (ActionWith a -> IO ())
      -- ^ Function provided with an action to run the spec item as argument. It
      -- should return the action to actually execute the item.
      -> SpecWith a
      -- ^ Spec to modify
      -> Spec
    around :: forall a. (ActionWith a -> IO ()) -> SpecWith a -> Spec
    around ActionWith a -> IO ()
    action = (ActionWith a -> ActionWith ()) -> SpecWith a -> Spec
    forall a b.
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith ((ActionWith a -> ActionWith ()) -> SpecWith a -> Spec)
    -> (ActionWith a -> ActionWith ()) -> SpecWith a -> Spec
    forall a b. (a -> b) -> a -> b
    $ \ActionWith a
    e () -> ActionWith a -> IO ()
    action ActionWith a
    e

    -- | Run a custom action after the last spec item.
    afterAll :: HasCallStack => ActionWith a -> SpecWith a -> SpecWith a
    afterAll :: forall a. HasCallStack => ActionWith a -> SpecWith a -> SpecWith a
    afterAll ActionWith a
    action = (ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a
    forall a b.
    HasCallStack =>
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundAllWith (\ ActionWith a
    hook a
    a -> ActionWith a
    hook a
    a IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ActionWith a
    action a
    a)

    -- | Run a custom action after the last spec item.
    afterAll_ :: HasCallStack => IO () -> SpecWith a -> SpecWith a
    afterAll_ :: forall a. HasCallStack => IO () -> SpecWith a -> SpecWith a
    afterAll_ IO ()
    action = ([SpecTree a] -> [SpecTree a]) -> SpecM a () -> SpecM a ()
    forall a b r.
    ([SpecTree a] -> [SpecTree b]) -> SpecM a r -> SpecM b r
    mapSpecForest (SpecTree a -> [SpecTree a]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SpecTree a -> [SpecTree a])
    -> ([SpecTree a] -> SpecTree a) -> [SpecTree a] -> [SpecTree a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (String, Location) -> IO () -> [SpecTree a] -> SpecTree a
    forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
    NodeWithCleanup Maybe (String, Location)
    HasCallStack => Maybe (String, Location)
    callSite IO ()
    action)

    -- | Run a custom action before and/or after every spec item.
    around_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a
    around_ :: forall a. (IO () -> IO ()) -> SpecWith a -> SpecWith a
    around_ IO () -> IO ()
    action = (ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a
    forall a b.
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith ((ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a)
    -> (ActionWith a -> ActionWith a) -> SpecWith a -> SpecWith a
    forall a b. (a -> b) -> a -> b
    $ \ActionWith a
    e a
    a -> IO () -> IO ()
    action (ActionWith a
    e a
    a)

    -- | Run a custom action before and/or after every spec item.
    aroundWith :: (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith :: forall a b.
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith = (Item a -> Item b) -> SpecWith a -> SpecWith b
    forall a b. (Item a -> Item b) -> SpecWith a -> SpecWith b
    mapSpecItem_ ((Item a -> Item b) -> SpecWith a -> SpecWith b)
    -> ((ActionWith a -> ActionWith b) -> Item a -> Item b)
    -> (ActionWith a -> ActionWith b)
    -> SpecWith a
    -> SpecWith b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActionWith a -> ActionWith b) -> Item a -> Item b
    forall a b. (ActionWith a -> ActionWith b) -> Item a -> Item b
    modifyHook

    modifyHook :: (ActionWith a -> ActionWith b) -> Item a -> Item b
    modifyHook :: forall a b. (ActionWith a -> ActionWith b) -> Item a -> Item b
    modifyHook ActionWith a -> ActionWith b
    action Item a
    item = Item a
    item {
        itemExample = \ Params
    params ActionWith b -> IO ()
    hook -> Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    forall a.
    Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    itemExample Item a
    item Params
    params (ActionWith b -> IO ()
    hook (ActionWith b -> IO ())
    -> (ActionWith a -> ActionWith b) -> ActionWith a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActionWith a -> ActionWith b
    action)
      }

    -- | Wrap an action around the given spec.
    aroundAll :: HasCallStack => (ActionWith a -> IO ()) -> SpecWith a -> Spec
    aroundAll :: forall a.
    HasCallStack =>
    (ActionWith a -> IO ()) -> SpecWith a -> Spec
    aroundAll ActionWith a -> IO ()
    action = (ActionWith a -> ActionWith ()) -> SpecWith a -> Spec
    forall a b.
    HasCallStack =>
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundAllWith ((ActionWith a -> ActionWith ()) -> SpecWith a -> Spec)
    -> (ActionWith a -> ActionWith ()) -> SpecWith a -> Spec
    forall a b. (a -> b) -> a -> b
    $ \ ActionWith a
    e () -> ActionWith a -> IO ()
    action ActionWith a
    e

    -- | Wrap an action around the given spec.
    aroundAll_ :: HasCallStack => (IO () -> IO ()) -> SpecWith a -> SpecWith a
    aroundAll_ :: forall a.
    HasCallStack =>
    (IO () -> IO ()) -> SpecWith a -> SpecWith a
    aroundAll_ IO () -> IO ()
    action SpecWith a
    spec = do
      (acquire, release) <- IO (ActionWith (), IO ()) -> SpecM a (ActionWith (), IO ())
    forall r a. IO r -> SpecM a r
    runIO (IO (ActionWith (), IO ()) -> SpecM a (ActionWith (), IO ()))
    -> IO (ActionWith (), IO ()) -> SpecM a (ActionWith (), IO ())
    forall a b. (a -> b) -> a -> b
    $ (ActionWith () -> ActionWith ()) -> IO (ActionWith (), IO ())
    forall a b. ((a -> IO ()) -> b -> IO ()) -> IO (b -> IO a, IO ())
    decompose (IO () -> IO ()
    action (IO () -> IO ()) -> ActionWith () -> ActionWith ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .)
      beforeAll_ (acquire ()) $ afterAll_ release spec

    -- | Wrap an action around the given spec. Changes the arg type inside.
    aroundAllWith :: forall a b. HasCallStack => (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundAllWith :: forall a b.
    HasCallStack =>
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundAllWith ActionWith a -> ActionWith b
    action SpecWith a
    spec = do
      (acquire, release) <- IO (b -> IO a, IO ()) -> SpecM b (b -> IO a, IO ())
    forall r a. IO r -> SpecM a r
    runIO (IO (b -> IO a, IO ()) -> SpecM b (b -> IO a, IO ()))
    -> IO (b -> IO a, IO ()) -> SpecM b (b -> IO a, IO ())
    forall a b. (a -> b) -> a -> b
    $ (ActionWith a -> ActionWith b) -> IO (b -> IO a, IO ())
    forall a b. ((a -> IO ()) -> b -> IO ()) -> IO (b -> IO a, IO ())
    decompose ActionWith a -> ActionWith b
    action
      beforeAllWith acquire $ afterAll_ release spec

    data Acquired a = Acquired a | ExceptionDuringAcquire SomeException
    data Released   = Released   | ExceptionDuringRelease SomeException

    decompose :: forall a b. ((a -> IO ()) -> b -> IO ()) -> IO (b -> IO a, IO ())
    decompose :: forall a b. ((a -> IO ()) -> b -> IO ()) -> IO (b -> IO a, IO ())
    decompose (a -> IO ()) -> b -> IO ()
    action = do
      doCleanupNow <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
      acquired <- newEmptyMVar
      released <- newEmptyMVar

      let
        notify :: Either SomeException () -> IO ()
        -- `notify` is guaranteed to run without being interrupted by an async
        -- exception for the following reasons:
        --
        -- 1. `forkFinally` runs the final action within `mask`
        -- 2. `tryPutMVar` is guaranteed not to be interruptible
        -- 3. `putMVar` is guaranteed not to be interruptible on an empty `MVar`
        notify Either SomeException ()
    r = case Either SomeException ()
    r of
          Left SomeException
    err -> do
            exceptionDuringAcquire <- MVar (Acquired a) -> Acquired a -> IO Bool
    forall a. MVar a -> a -> IO Bool
    tryPutMVar MVar (Acquired a)
    acquired (SomeException -> Acquired a
    forall a. SomeException -> Acquired a
    ExceptionDuringAcquire SomeException
    err)
            putMVar released $ if exceptionDuringAcquire then Released else ExceptionDuringRelease err
          Right () -> do
            MVar Released -> Released -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar Released
    released Released
    Released

        forkWorker :: b -> IO ()
        forkWorker b
    b = IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IO () -> (Either SomeException () -> IO ()) -> IO ThreadId)
    -> (Either SomeException () -> IO ()) -> IO () -> IO ThreadId
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
    forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkFinally Either SomeException () -> IO ()
    notify (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
          ((a -> IO ()) -> b -> IO ()) -> b -> (a -> IO ()) -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (a -> IO ()) -> b -> IO ()
    action b
    b ((a -> IO ()) -> IO ()) -> (a -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ a
    a -> do
            MVar (Acquired a) -> Acquired a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar (Acquired a)
    acquired (a -> Acquired a
    forall a. a -> Acquired a
    Acquired a
    a)
            MVar () -> IO ()
    waitFor MVar ()
    doCleanupNow

        acquire :: b -> IO a
        acquire b
    b = do
          b -> IO ()
    forkWorker b
    b
          r <- MVar (Acquired a) -> IO (Acquired a)
    forall a. MVar a -> IO a
    readMVar MVar (Acquired a)
    acquired -- This does not work reliably with base < 4.7
          case r of
            Acquired a
    a -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
            ExceptionDuringAcquire SomeException
    err -> SomeException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    err

        release :: IO ()
        release = do
          acquireHasNotBeenCalled <- MVar (Acquired a) -> IO Bool
    forall a. MVar a -> IO Bool
    isEmptyMVar MVar (Acquired a)
    acquired -- NOTE: This can happen if an outer beforeAll fails
          unless acquireHasNotBeenCalled $ do
            signal doCleanupNow
            r <- takeMVar released
            case r of
              Released
    Released -> IO ()
    forall (m :: * -> *). Applicative m => m ()
    pass
              ExceptionDuringRelease SomeException
    err -> SomeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    err

      return (acquire, release)

    type BinarySemaphore = MVar ()

    signal :: BinarySemaphore -> IO ()
    signal :: MVar () -> IO ()
    signal = (MVar () -> ActionWith ()) -> () -> MVar () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip MVar () -> ActionWith ()
    forall a. MVar a -> a -> IO ()
    putMVar ()

    waitFor :: BinarySemaphore -> IO ()
    waitFor :: MVar () -> IO ()
    waitFor = MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar

    -- | Modify the subject under test.
    --
    -- Note that this resembles a contravariant functor on the first type parameter
    -- of `SpecM`.  This is because the subject is passed inwards, as an argument
    -- to the spec item.
    mapSubject :: (b -> a) -> SpecWith a -> SpecWith b
    mapSubject :: forall b a. (b -> a) -> SpecWith a -> SpecWith b
    mapSubject b -> a
    f = (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    forall a b.
    (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
    aroundWith (ActionWith a -> (b -> a) -> ActionWith b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    f)

    -- | Ignore the subject under test for a given spec.
    ignoreSubject :: SpecWith () -> SpecWith a
    ignoreSubject :: forall a. Spec -> SpecWith a
    ignoreSubject = (a -> ()) -> Spec -> SpecWith a
    forall b a. (b -> a) -> SpecWith a -> SpecWith b
    mapSubject (() -> a -> ()
    forall a b. a -> b -> a
    const ())