{-# 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.RWS.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 'c'.
before :: IO c -> TestDefM a c e -> TestDefM a () e
before :: IO c -> TestDefM a c e -> TestDefM a () e
before IO c
action = ((c -> IO ()) -> IO ()) -> TestDefM a c e -> TestDefM a () e
forall c (a :: [*]) e.
((c -> IO ()) -> IO ()) -> TestDefM a c e -> TestDefM a () e
around (IO c
action IO c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)

-- | Run a custom action before every spec item without setting up any inner resources.
before_ :: IO () -> TestDefM a c e -> TestDefM a c e
before_ :: IO () -> TestDefM a c e -> TestDefM a c e
before_ IO ()
action = (IO () -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall (a :: [*]) c e.
(IO () -> IO ()) -> TestDefM a c e -> TestDefM a c e
around_ (IO ()
action IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

-- | Run a custom action after every spec item, using the inner resource 'c'.
after :: (c -> IO ()) -> TestDefM a c e -> TestDefM a c e
after :: (c -> IO ()) -> TestDefM a c e -> TestDefM a c e
after c -> IO ()
action = ((c -> IO ()) -> c -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall (a :: [*]) c d r.
((c -> IO ()) -> d -> IO ()) -> TestDefM a c r -> TestDefM a d r
aroundWith (((c -> IO ()) -> c -> IO ()) -> TestDefM a c e -> TestDefM a c e)
-> ((c -> IO ()) -> c -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall a b. (a -> b) -> a -> b
$ \c -> IO ()
e c
x -> c -> IO ()
e c
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` c -> IO ()
action c
x

-- | Run a custom action after every spec item without using any inner resources.
after_ :: IO () -> TestDefM a c e -> TestDefM a c e
after_ :: IO () -> TestDefM a c e -> TestDefM a c e
after_ IO ()
action = (c -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall c (a :: [*]) e.
(c -> IO ()) -> TestDefM a c e -> TestDefM a c e
after ((c -> IO ()) -> TestDefM a c e -> TestDefM a c e)
-> (c -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall a b. (a -> b) -> a -> b
$ \c
_ -> 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_'.
around :: ((c -> IO ()) -> IO ()) -> TestDefM a c e -> TestDefM a () e
around :: ((c -> IO ()) -> IO ()) -> TestDefM a c e -> TestDefM a () e
around (c -> IO ()) -> IO ()
action = ((c -> IO ()) -> () -> IO ()) -> TestDefM a c e -> TestDefM a () e
forall (a :: [*]) c d r.
((c -> IO ()) -> d -> IO ()) -> TestDefM a c r -> TestDefM a d r
aroundWith (((c -> IO ()) -> () -> IO ())
 -> TestDefM a c e -> TestDefM a () e)
-> ((c -> IO ()) -> () -> IO ())
-> TestDefM a c e
-> TestDefM a () e
forall a b. (a -> b) -> a -> b
$ \c -> IO ()
e () -> (c -> IO ()) -> IO ()
action c -> 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.
around_ :: (IO () -> IO ()) -> TestDefM a c e -> TestDefM a c e
around_ :: (IO () -> IO ()) -> TestDefM a c e -> TestDefM a c e
around_ IO () -> IO ()
action = ((c -> IO ()) -> c -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall (a :: [*]) c d r.
((c -> IO ()) -> d -> IO ()) -> TestDefM a c r -> TestDefM a d r
aroundWith (((c -> IO ()) -> c -> IO ()) -> TestDefM a c e -> TestDefM a c e)
-> ((c -> IO ()) -> c -> IO ()) -> TestDefM a c e -> TestDefM a c e
forall a b. (a -> b) -> a -> b
$ \c -> IO ()
e c
a -> IO () -> IO ()
action (c -> IO ()
e c
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_'.
aroundWith :: forall a c d r. ((c -> IO ()) -> (d -> IO ())) -> TestDefM a c r -> TestDefM a d r
aroundWith :: ((c -> IO ()) -> d -> IO ()) -> TestDefM a c r -> TestDefM a d r
aroundWith (c -> IO ()) -> d -> IO ()
func =
  ((HList a -> c -> IO ()) -> HList a -> d -> IO ())
-> TestDefM a c r -> TestDefM a d r
forall a c d r (u :: [*]).
HContains u a =>
((a -> c -> IO ()) -> a -> d -> IO ())
-> TestDefM u c r -> TestDefM u d r
aroundWith' (((HList a -> c -> IO ()) -> HList a -> d -> IO ())
 -> TestDefM a c r -> TestDefM a d r)
-> ((HList a -> c -> IO ()) -> HList a -> d -> IO ())
-> TestDefM a c r
-> TestDefM a d r
forall a b. (a -> b) -> a -> b
$
    \(HList a -> c -> IO ()
takeAC :: HList a -> c -> IO ()) -- Just to make sure the 'a' is not ambiguous.
     HList a
a
     d
d ->
        (c -> IO ()) -> d -> IO ()
func (\c
c -> HList a -> c -> IO ()
takeAC HList a
a c
c) d
d

-- | 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' and any outer resource available.
aroundWith' :: forall a c d r (u :: [Type]). HContains u a => ((a -> c -> IO ()) -> (a -> d -> IO ())) -> TestDefM u c r -> TestDefM u d r
aroundWith' :: ((a -> c -> IO ()) -> a -> d -> IO ())
-> TestDefM u c r -> TestDefM u d r
aroundWith' (a -> c -> IO ()) -> a -> d -> IO ()
func (TestDefM RWST TestRunSettings (TestForest u c) () IO r
rwst) = RWST TestRunSettings (TestForest u d) () IO r -> TestDefM u d r
forall (a :: [*]) b c.
RWST TestRunSettings (TestForest a b) () IO c -> TestDefM a b c
TestDefM (RWST TestRunSettings (TestForest u d) () IO r -> TestDefM u d r)
-> RWST TestRunSettings (TestForest u d) () IO r -> TestDefM u d r
forall a b. (a -> b) -> a -> b
$
  ((IO (r, (), TestForest u c) -> IO (r, (), TestForest u d))
 -> RWST TestRunSettings (TestForest u c) () IO r
 -> RWST TestRunSettings (TestForest u d) () IO r)
-> RWST TestRunSettings (TestForest u c) () IO r
-> (IO (r, (), TestForest u c) -> IO (r, (), TestForest u d))
-> RWST TestRunSettings (TestForest u d) () IO r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IO (r, (), TestForest u c) -> IO (r, (), TestForest u d))
-> RWST TestRunSettings (TestForest u c) () IO r
-> RWST TestRunSettings (TestForest u d) () IO r
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST RWST TestRunSettings (TestForest u c) () IO r
rwst ((IO (r, (), TestForest u c) -> IO (r, (), TestForest u d))
 -> RWST TestRunSettings (TestForest u d) () IO r)
-> (IO (r, (), TestForest u c) -> IO (r, (), TestForest u d))
-> RWST TestRunSettings (TestForest u d) () IO r
forall a b. (a -> b) -> a -> b
$ \IO (r, (), TestForest u c)
inner -> do
    (r
res, ()
s, TestForest u c
forest) <- IO (r, (), TestForest u c)
inner
    let modifyVal ::
          forall x.
          HContains x a =>
          (((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult) ->
          ((HList x -> d -> IO ()) -> IO ()) ->
          IO TestRunResult
        modifyVal :: (((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> ((HList x -> d -> IO ()) -> IO ()) -> IO TestRunResult
modifyVal ((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult
takeSupplyXC (HList x -> d -> IO ()) -> IO ()
supplyXD =
          let supplyXC :: (HList x -> c -> IO ()) -> IO ()
              supplyXC :: (HList x -> c -> IO ()) -> IO ()
supplyXC HList x -> c -> IO ()
takeXC =
                let takeXD :: HList x -> d -> IO ()
                    takeXD :: HList x -> d -> IO ()
takeXD HList x
x d
d =
                      let takeAC :: a -> c -> IO ()
takeAC a
_ c
c = HList x -> c -> IO ()
takeXC HList x
x c
c
                       in (a -> c -> IO ()) -> a -> d -> IO ()
func a -> c -> IO ()
takeAC (HList x -> a
forall (l :: [*]) a. HContains l a => HList l -> a
getElem HList x
x) d
d
                 in (HList x -> d -> IO ()) -> IO ()
supplyXD HList x -> d -> IO ()
takeXD
           in ((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult
takeSupplyXC (HList x -> c -> 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 e. HContains x a => SpecDefTree x c e -> SpecDefTree x d e
        modifyTree :: SpecDefTree x c e -> SpecDefTree x d e
modifyTree = \case
          DefDescribeNode Text
t SpecDefForest x c e
sdf -> Text -> SpecDefForest x d e -> SpecDefTree x d e
forall (a :: [*]) c e.
Text -> SpecDefForest a c e -> SpecDefTree a c e
DefDescribeNode Text
t (SpecDefForest x d e -> SpecDefTree x d e)
-> SpecDefForest x d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest x c e -> SpecDefForest x d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest x c e
sdf
          DefPendingNode Text
t Maybe Text
mr -> Text -> Maybe Text -> SpecDefTree x d e
forall (a :: [*]) c e. Text -> Maybe Text -> SpecDefTree a c e
DefPendingNode Text
t Maybe Text
mr
          DefSpecifyNode Text
t TDef (((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td e
e -> Text
-> TDef (((HList x -> d -> IO ()) -> IO ()) -> IO TestRunResult)
-> e
-> SpecDefTree x d e
forall (a :: [*]) c e.
Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> e
-> SpecDefTree a c e
DefSpecifyNode Text
t ((((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> ((HList x -> d -> IO ()) -> IO ()) -> IO TestRunResult
forall (x :: [*]).
HContains x a =>
(((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> ((HList x -> d -> IO ()) -> IO ()) -> IO TestRunResult
modifyVal ((((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
 -> ((HList x -> d -> IO ()) -> IO ()) -> IO TestRunResult)
-> TDef (((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> TDef (((HList x -> d -> IO ()) -> IO ()) -> IO TestRunResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TDef (((HList x -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td) e
e
          DefWrapNode IO () -> IO ()
f SpecDefForest x c e
sdf -> (IO () -> IO ()) -> SpecDefForest x d e -> SpecDefTree x d e
forall (a :: [*]) c e.
(IO () -> IO ()) -> SpecDefForest a c e -> SpecDefTree a c e
DefWrapNode IO () -> IO ()
f (SpecDefForest x d e -> SpecDefTree x d e)
-> SpecDefForest x d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest x c e -> SpecDefForest x d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest x c e
sdf
          DefBeforeAllNode IO a
f SpecDefForest (a : x) c e
sdf -> IO a -> SpecDefForest (a : x) d e -> SpecDefTree x d e
forall a (l :: [*]) c e.
IO a -> SpecDefForest (a : l) c e -> SpecDefTree l c e
DefBeforeAllNode IO a
f (SpecDefForest (a : x) d e -> SpecDefTree x d e)
-> SpecDefForest (a : x) d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest (a : x) c e -> SpecDefForest (a : x) d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest (a : x) c e
sdf
          DefAroundAllNode (a -> IO ()) -> IO ()
f SpecDefForest (a : x) c e
sdf -> ((a -> IO ()) -> IO ())
-> SpecDefForest (a : x) d e -> SpecDefTree x d e
forall a (l :: [*]) c e.
((a -> IO ()) -> IO ())
-> SpecDefForest (a : l) c e -> SpecDefTree l c e
DefAroundAllNode (a -> IO ()) -> IO ()
f (SpecDefForest (a : x) d e -> SpecDefTree x d e)
-> SpecDefForest (a : x) d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest (a : x) c e -> SpecDefForest (a : x) d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest (a : x) c e
sdf
          DefAroundAllWithNode (b -> IO ()) -> a -> IO ()
f SpecDefForest (b : a : l) c e
sdf -> ((b -> IO ()) -> a -> IO ())
-> SpecDefForest (b : a : l) d e -> SpecDefTree (a : l) d e
forall b a (l :: [*]) c e.
((b -> IO ()) -> a -> IO ())
-> SpecDefForest (b : a : l) c e -> SpecDefTree (a : l) c e
DefAroundAllWithNode (b -> IO ()) -> a -> IO ()
f (SpecDefForest (b : a : l) d e -> SpecDefTree (a : l) d e)
-> SpecDefForest (b : a : l) d e -> SpecDefTree (a : l) d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest (b : a : l) c e -> SpecDefForest (b : a : l) d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest (b : a : l) c e
sdf
          DefAfterAllNode HList x -> IO ()
f SpecDefForest x c e
sdf -> (HList x -> IO ()) -> SpecDefForest x d e -> SpecDefTree x d e
forall (a :: [*]) c e.
(HList a -> IO ()) -> SpecDefForest a c e -> SpecDefTree a c e
DefAfterAllNode HList x -> IO ()
f (SpecDefForest x d e -> SpecDefTree x d e)
-> SpecDefForest x d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest x c e -> SpecDefForest x d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest x c e
sdf
          DefParallelismNode Parallelism
f SpecDefForest x c e
sdf -> Parallelism -> SpecDefForest x d e -> SpecDefTree x d e
forall (a :: [*]) c e.
Parallelism -> SpecDefForest a c e -> SpecDefTree a c e
DefParallelismNode Parallelism
f (SpecDefForest x d e -> SpecDefTree x d e)
-> SpecDefForest x d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest x c e -> SpecDefForest x d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest x c e
sdf
          DefRandomisationNode ExecutionOrderRandomisation
f SpecDefForest x c e
sdf -> ExecutionOrderRandomisation
-> SpecDefForest x d e -> SpecDefTree x d e
forall (a :: [*]) c e.
ExecutionOrderRandomisation
-> SpecDefForest a c e -> SpecDefTree a c e
DefRandomisationNode ExecutionOrderRandomisation
f (SpecDefForest x d e -> SpecDefTree x d e)
-> SpecDefForest x d e -> SpecDefTree x d e
forall a b. (a -> b) -> a -> b
$ SpecDefForest x c e -> SpecDefForest x d e
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest SpecDefForest x c e
sdf
        modifyForest :: forall x e. HContains x a => SpecDefForest x c e -> SpecDefForest x d e
        modifyForest :: SpecDefForest x c e -> SpecDefForest x d e
modifyForest = (SpecDefTree x c e -> SpecDefTree x d e)
-> SpecDefForest x c e -> SpecDefForest x d e
forall a b. (a -> b) -> [a] -> [b]
map SpecDefTree x c e -> SpecDefTree x d e
forall (x :: [*]) e.
HContains x a =>
SpecDefTree x c e -> SpecDefTree x d e
modifyTree
    let forest' :: SpecDefForest u d ()
        forest' :: TestForest u d
forest' = TestForest u c -> TestForest u d
forall (x :: [*]) e.
HContains x a =>
SpecDefForest x c e -> SpecDefForest x d e
modifyForest TestForest u c
forest
    (r, (), TestForest u d) -> IO (r, (), TestForest u d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r
res, ()
s, TestForest u d
forest')