{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Syd.Def.Around where

import Control.Exception
import Control.Monad.Reader
import Control.Monad.Writer.Strict
import Data.Kind
import Test.QuickCheck.IO ()
import Test.Syd.Def.TestDefM
import Test.Syd.HList
import Test.Syd.Run
import Test.Syd.SpecDef

-- | Run a custom action before every spec item, to set up an inner resource 'inner'.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
before ::
  -- | The function to run before every test, to produce the inner resource
  IO inner ->
  TestDefM outers inner result ->
  TestDefM outers () result
before :: forall inner (outers :: [*]) result.
IO inner
-> TestDefM outers inner result -> TestDefM outers () result
before IO inner
action = forall (outers :: [*]) oldInner newInner result.
(oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith forall a b. (a -> b) -> a -> b
$ \() -> IO inner
action

-- | Run a custom action before every spec item without setting up any inner resources.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
before_ ::
  -- | The function to run before every test
  IO () ->
  TestDefM outers inner result ->
  TestDefM outers inner result
before_ :: forall (outers :: [*]) inner result.
IO ()
-> TestDefM outers inner result -> TestDefM outers inner result
before_ IO ()
action = forall (outers :: [*]) oldInner newInner result.
(oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith forall a b. (a -> b) -> a -> b
$ \inner
inner -> do
  IO ()
action
  forall (f :: * -> *) a. Applicative f => a -> f a
pure inner
inner

-- | Run a custom action before every spec item, to set up an inner resource 'newInner' using the previously set up resource 'oldInner'
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
beforeWith ::
  forall outers oldInner newInner result.
  (oldInner -> IO newInner) ->
  TestDefM outers newInner result ->
  TestDefM outers oldInner result
beforeWith :: forall (outers :: [*]) oldInner newInner result.
(oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith oldInner -> IO newInner
action = forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith' (\(HList outers
_ :: HList outers) -> oldInner -> IO newInner
action)

-- | Run a custom action before every spec item, to set up an inner resource 'newInner' using the previously set up resource 'oldInner' and potentially any of the outer resources
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
beforeWith' ::
  HContains outers outer =>
  (outer -> oldInner -> IO newInner) ->
  TestDefM outers newInner result ->
  TestDefM outers oldInner result
beforeWith' :: forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith' outer -> oldInner -> IO newInner
action = forall newInner oldInner outer result (outers :: [*]).
HContains outers outer =>
((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith' forall a b. (a -> b) -> a -> b
$ \outer -> newInner -> IO ()
func outer
outer oldInner
inner -> outer -> oldInner -> IO newInner
action outer
outer oldInner
inner forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= outer -> newInner -> IO ()
func outer
outer

-- | Run a custom action after every spec item, using the inner resource 'c'.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
after ::
  -- | The function to run after every test, using the inner resource
  (inner -> IO ()) ->
  TestDefM outers inner result ->
  TestDefM outers inner result
after :: forall inner (outers :: [*]) result.
(inner -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
after inner -> IO ()
action = forall newInner oldInner (outers :: [*]) result.
((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith forall a b. (a -> b) -> a -> b
$ \inner -> IO ()
e inner
x -> inner -> IO ()
e inner
x forall a b. IO a -> IO b -> IO a
`finally` inner -> IO ()
action inner
x

-- | Run a custom action after every spec item without using any inner resources.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
after_ ::
  -- | The function to run after every test
  IO () ->
  TestDefM outers inner result ->
  TestDefM outers inner result
after_ :: forall (outers :: [*]) inner result.
IO ()
-> TestDefM outers inner result -> TestDefM outers inner result
after_ IO ()
action = forall inner (outers :: [*]) result.
(inner -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
after forall a b. (a -> b) -> a -> b
$ \inner
_ -> IO ()
action

-- | Run a custom action before and/or after every spec item, to provide access to an inner resource 'c'.
--
-- See the @FOOTGUN@ note in the docs for 'around_'.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
around ::
  -- | The function to provide the inner resource around every test
  ((inner -> IO ()) -> IO ()) ->
  TestDefM outers inner result ->
  TestDefM outers () result
around :: forall inner (outers :: [*]) result.
((inner -> IO ()) -> IO ())
-> TestDefM outers inner result -> TestDefM outers () result
around (inner -> IO ()) -> IO ()
action = forall newInner oldInner (outers :: [*]) result.
((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith forall a b. (a -> b) -> a -> b
$ \inner -> IO ()
e () -> (inner -> IO ()) -> IO ()
action inner -> IO ()
e

-- | Run a custom action before and/or after every spec item without accessing any inner resources.
--
-- It is important that the wrapper function that you provide runs the action that it gets _exactly once_.
--
-- == __FOOTGUN__
--
-- This combinator gives the programmer a lot of power.
-- In fact, it gives the programmer enough power to break the test framework.
-- Indeed, you can provide a wrapper function that just _doesn't_ run the function like this:
--
-- > spec :: Spec
-- > spec = do
-- >    let don'tDo :: IO () -> IO ()
-- >        don'tDo _ = pure ()
-- >    around_ don'tDo $ do
-- >      it "should pass" True
--
-- During execution, you'll then get an error like this:
--
-- > thread blocked indefinitely in an MVar operation
--
-- The same problem exists when using 'Test.Syd.Def.Around.aroundAll_'.
--
-- The same thing will go wrong if you run the given action more than once like this:
--
-- > spec :: Spec
-- > spec = do
-- >    let doTwice :: IO () -> IO ()
-- >        doTwice f = f >> f
-- >    around_ doTwice $ do
-- >      it "should pass" True
--
--
-- Note: If you're interested in fixing this, talk to me, but only after GHC has gotten impredicative types because that will likely be a requirement.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
around_ ::
  -- | The function to wrap every test with
  (IO () -> IO ()) ->
  TestDefM outers inner result ->
  TestDefM outers inner result
around_ :: forall (outers :: [*]) inner result.
(IO () -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
around_ IO () -> IO ()
action = forall newInner oldInner (outers :: [*]) result.
((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith forall a b. (a -> b) -> a -> b
$ \inner -> IO ()
e inner
a -> IO () -> IO ()
action (inner -> IO ()
e inner
a)

-- | Run a custom action before and/or after every spec item, to provide access to an inner resource 'c' while using the inner resource 'd'.
--
-- See the @FOOTGUN@ note in the docs for 'around_'.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
aroundWith ::
  forall newInner oldInner outers result.
  ((newInner -> IO ()) -> (oldInner -> IO ())) ->
  TestDefM outers newInner result ->
  TestDefM outers oldInner result
aroundWith :: forall newInner oldInner (outers :: [*]) result.
((newInner -> IO ()) -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith (newInner -> IO ()) -> oldInner -> IO ()
func =
  forall newInner oldInner outer result (outers :: [*]).
HContains outers outer =>
((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith' forall a b. (a -> b) -> a -> b
$
    \(HList outers -> newInner -> IO ()
takeAC :: HList outers -> newInner -> IO ()) -- Just to make sure the 'a' is not ambiguous.
     HList outers
a
     oldInner
d ->
        (newInner -> IO ()) -> oldInner -> IO ()
func (\newInner
c -> HList outers -> newInner -> IO ()
takeAC HList outers
a newInner
c) oldInner
d

-- | Run a custom action around every spec item, to provide access to an inner resource 'newInner' while using the inner resource 'oldInner' and any outer resource available.
--
-- Note that this function turns off shrinking.
-- See https://github.com/nick8325/quickcheck/issues/331
aroundWith' ::
  forall newInner oldInner outer result (outers :: [Type]).
  HContains outers outer =>
  -- | The function that provides the new inner resource using the old resource.
  -- It can also use and modify the outer resource
  ((outer -> newInner -> IO ()) -> (outer -> oldInner -> IO ())) ->
  TestDefM outers newInner result ->
  TestDefM outers oldInner result
aroundWith' :: forall newInner oldInner outer result (outers :: [*]).
HContains outers outer =>
((outer -> newInner -> IO ()) -> outer -> oldInner -> IO ())
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
aroundWith' (outer -> newInner -> IO ()) -> outer -> oldInner -> IO ()
func (TestDefM WriterT (TestForest outers newInner) (ReaderT TestDefEnv IO) result
rwst) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\TestDefEnv
tde -> TestDefEnv
tde {testDefEnvTestRunSettings :: TestRunSettings
testDefEnvTestRunSettings = (TestDefEnv -> TestRunSettings
testDefEnvTestRunSettings TestDefEnv
tde) {testRunSettingMaxShrinks :: Int
testRunSettingMaxShrinks = Int
0}}) forall a b. (a -> b) -> a -> b
$
    forall (outers :: [*]) inner result.
WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
-> TestDefM outers inner result
TestDefM forall a b. (a -> b) -> a -> b
$
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT WriterT (TestForest outers newInner) (ReaderT TestDefEnv IO) result
rwst forall a b. (a -> b) -> a -> b
$ \ReaderT TestDefEnv IO (result, TestForest outers newInner)
inner -> do
        (result
res, TestForest outers newInner
forest) <- ReaderT TestDefEnv IO (result, TestForest outers newInner)
inner
        -- a: outers
        -- c: newInner
        -- d: oldInner
        let modifyVal ::
              forall x.
              HContains x outer =>
              (ProgressReporter -> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult) ->
              ProgressReporter ->
              ((HList x -> oldInner -> IO ()) -> IO ()) ->
              IO TestRunResult
            modifyVal :: forall (x :: [*]).
HContains x outer =>
(ProgressReporter
 -> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult)
-> ProgressReporter
-> ((HList x -> oldInner -> IO ()) -> IO ())
-> IO TestRunResult
modifyVal ProgressReporter
-> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult
takeSupplyXC ProgressReporter
progressReporter (HList x -> oldInner -> IO ()) -> IO ()
supplyXD =
              let supplyXC :: (HList x -> newInner -> IO ()) -> IO ()
                  supplyXC :: (HList x -> newInner -> IO ()) -> IO ()
supplyXC HList x -> newInner -> IO ()
takeXC =
                    let takeXD :: HList x -> oldInner -> IO ()
                        takeXD :: HList x -> oldInner -> IO ()
takeXD HList x
x oldInner
d =
                          let takeAC :: outer -> newInner -> IO ()
takeAC outer
_ newInner
c = HList x -> newInner -> IO ()
takeXC HList x
x newInner
c
                           in (outer -> newInner -> IO ()) -> outer -> oldInner -> IO ()
func outer -> newInner -> IO ()
takeAC (forall (l :: [*]) a. HContains l a => HList l -> a
getElem HList x
x) oldInner
d
                     in (HList x -> oldInner -> IO ()) -> IO ()
supplyXD HList x -> oldInner -> IO ()
takeXD
               in ProgressReporter
-> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult
takeSupplyXC ProgressReporter
progressReporter (HList x -> newInner -> IO ()) -> IO ()
supplyXC

            -- For this function to work recursively, the first parameter of the input and the output types must be the same
            modifyTree ::
              forall x extra. HContains x outer => SpecDefTree x newInner extra -> SpecDefTree x oldInner extra
            modifyTree :: forall (x :: [*]) extra.
HContains x outer =>
SpecDefTree x newInner extra -> SpecDefTree x oldInner extra
modifyTree = \case
              DefDescribeNode Text
t SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
Text
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefDescribeNode Text
t forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefPendingNode Text
t Maybe Text
mr -> forall (outers :: [*]) inner extra.
Text -> Maybe Text -> SpecDefTree outers inner extra
DefPendingNode Text
t Maybe Text
mr
              DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult)
td extra
e -> forall (outers :: [*]) inner extra.
Text
-> TDef
     (ProgressReporter
      -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t (forall (x :: [*]).
HContains x outer =>
(ProgressReporter
 -> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult)
-> ProgressReporter
-> ((HList x -> oldInner -> IO ()) -> IO ())
-> IO TestRunResult
modifyVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TDef
  (ProgressReporter
   -> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult)
td) extra
e
              DefSetupNode IO ()
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
IO ()
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefSetupNode IO ()
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefBeforeAllNode IO outer
f SpecDefForest (outer : x) newInner extra
sdf -> forall newOuter (otherOuters :: [*]) inner extra.
IO newOuter
-> SpecDefForest (newOuter : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefBeforeAllNode IO outer
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest (outer : x) newInner extra
sdf
              DefBeforeAllWithNode oldOuter -> IO newOuter
f SpecDefForest (newOuter : oldOuter : otherOuters) newInner extra
sdf -> forall newOuter oldOuter (otherOuters :: [*]) inner extra.
(newOuter -> IO oldOuter)
-> SpecDefForest (oldOuter : newOuter : otherOuters) inner extra
-> SpecDefTree (newOuter : otherOuters) inner extra
DefBeforeAllWithNode oldOuter -> IO newOuter
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest (newOuter : oldOuter : otherOuters) newInner extra
sdf
              DefWrapNode IO () -> IO ()
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefAroundAllNode (outer -> IO ()) -> IO ()
f SpecDefForest (outer : x) newInner extra
sdf -> forall newOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> IO ())
-> SpecDefForest (newOuter : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest (outer : x) newInner extra
sdf
              DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
f SpecDefForest (newOuter : oldOuter : otherOuters) newInner extra
sdf -> forall newOuter oldOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest (newOuter : oldOuter : otherOuters) newInner extra
sdf
              DefAfterAllNode HList x -> IO ()
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList x -> IO ()
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefParallelismNode Parallelism
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefRandomisationNode ExecutionOrderRandomisation
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefRetriesNode Word -> Word
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
(Word -> Word)
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRetriesNode Word -> Word
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefFlakinessNode FlakinessMode
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
              DefExpectationNode ExpectationMode
f SpecDefForest x newInner extra
sdf -> forall (outers :: [*]) inner extra.
ExpectationMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefExpectationNode ExpectationMode
f forall a b. (a -> b) -> a -> b
$ forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest SpecDefForest x newInner extra
sdf
            modifyForest ::
              forall x extra.
              HContains x outer =>
              SpecDefForest x newInner extra ->
              SpecDefForest x oldInner extra
            modifyForest :: forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest = forall a b. (a -> b) -> [a] -> [b]
map forall (x :: [*]) extra.
HContains x outer =>
SpecDefTree x newInner extra -> SpecDefTree x oldInner extra
modifyTree
        let forest' :: SpecDefForest outers oldInner ()
            forest' :: TestForest outers oldInner
forest' = forall (x :: [*]) extra.
HContains x outer =>
SpecDefForest x newInner extra -> SpecDefForest x oldInner extra
modifyForest TestForest outers newInner
forest
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (result
res, TestForest outers oldInner
forest')