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

-- | This module defines all the functions you will use to define your test suite.
module Test.Syd.Def.AroundAll where

import Control.Monad.RWS.Strict
import Test.QuickCheck.IO ()
import Test.Syd.Def.TestDefM
import Test.Syd.HList
import Test.Syd.SpecDef

-- | Run a custom action before all spec items in a group, to set up an outer resource 'a'.
beforeAll ::
  -- | The function to run (once), beforehand, to produce the outer resource.
  IO outer ->
  TestDefM (outer ': otherOuters) inner result ->
  TestDefM otherOuters inner result
beforeAll :: IO outer
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
beforeAll IO outer
action = (TestForest (outer : otherOuters) inner
 -> TestTree otherOuters inner)
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
forall (outers1 :: [*]) inner1 (outers2 :: [*]) inner2 result.
(TestForest outers1 inner1 -> TestTree outers2 inner2)
-> TestDefM outers1 inner1 result -> TestDefM outers2 inner2 result
wrapRWST ((TestForest (outer : otherOuters) inner
  -> TestTree otherOuters inner)
 -> TestDefM (outer : otherOuters) inner result
 -> TestDefM otherOuters inner result)
-> (TestForest (outer : otherOuters) inner
    -> TestTree otherOuters inner)
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
forall a b. (a -> b) -> a -> b
$ \TestForest (outer : otherOuters) inner
forest -> IO outer
-> TestForest (outer : otherOuters) inner
-> TestTree otherOuters inner
forall outer (otherOuters :: [*]) inner extra.
IO outer
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefBeforeAllNode IO outer
action TestForest (outer : otherOuters) inner
forest

-- | Run a custom action before all spec items in a group without setting up any outer resources.
beforeAll_ ::
  -- | The function to run (once), beforehand.
  IO () ->
  TestDefM outers inner result ->
  TestDefM outers inner result
beforeAll_ :: IO ()
-> TestDefM outers inner result -> TestDefM outers inner result
beforeAll_ IO ()
action = (IO () -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
forall (outers :: [*]) inner result.
(IO () -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
aroundAll_ (IO ()
action IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

-- | Run a custom action before all spec items in a group, to set up an outer resource 'b' by using the outer resource 'a'.
beforeAllWith ::
  -- | The function to run (once), beforehand, to produce a new outer resource while using a previous outer resource
  (previousOuter -> IO newOuter) ->
  TestDefM (newOuter ': previousOuter ': otherOuters) inner result ->
  TestDefM (previousOuter ': otherOuters) inner result
beforeAllWith :: (previousOuter -> IO newOuter)
-> TestDefM (newOuter : previousOuter : otherOuters) inner result
-> TestDefM (previousOuter : otherOuters) inner result
beforeAllWith previousOuter -> IO newOuter
action = ((newOuter -> IO ()) -> previousOuter -> IO ())
-> TestDefM (newOuter : previousOuter : otherOuters) inner result
-> TestDefM (previousOuter : otherOuters) inner result
forall newOuter oldOuter (otherOuters :: [*]) inner result.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> TestDefM (newOuter : oldOuter : otherOuters) inner result
-> TestDefM (oldOuter : otherOuters) inner result
aroundAllWith (((newOuter -> IO ()) -> previousOuter -> IO ())
 -> TestDefM (newOuter : previousOuter : otherOuters) inner result
 -> TestDefM (previousOuter : otherOuters) inner result)
-> ((newOuter -> IO ()) -> previousOuter -> IO ())
-> TestDefM (newOuter : previousOuter : otherOuters) inner result
-> TestDefM (previousOuter : otherOuters) inner result
forall a b. (a -> b) -> a -> b
$ \newOuter -> IO ()
func previousOuter
b -> do
  newOuter
a <- previousOuter -> IO newOuter
action previousOuter
b
  newOuter -> IO ()
func newOuter
a

-- | Run a custom action after all spec items, using the outer resource 'a'.
afterAll ::
  -- | The function to run (once), afterwards, using the outer resource.
  (outer -> IO ()) ->
  TestDefM (outer ': otherOuters) inner result ->
  TestDefM (outer ': otherOuters) inner result
afterAll :: (outer -> IO ())
-> TestDefM (outer : otherOuters) inner result
-> TestDefM (outer : otherOuters) inner result
afterAll outer -> IO ()
func = (HList (outer : otherOuters) -> IO ())
-> TestDefM (outer : otherOuters) inner result
-> TestDefM (outer : otherOuters) inner result
forall (outers :: [*]) inner result.
(HList outers -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
afterAll' ((HList (outer : otherOuters) -> IO ())
 -> TestDefM (outer : otherOuters) inner result
 -> TestDefM (outer : otherOuters) inner result)
-> (HList (outer : otherOuters) -> IO ())
-> TestDefM (outer : otherOuters) inner result
-> TestDefM (outer : otherOuters) inner result
forall a b. (a -> b) -> a -> b
$ \(HCons e
a HList l
_) -> outer -> IO ()
func outer
e
a

-- | Run a custom action after all spec items, using all the outer resources.
afterAll' ::
  -- | The function to run (once), afterwards, using all outer resources.
  (HList outers -> IO ()) ->
  TestDefM outers inner result ->
  TestDefM outers inner result
afterAll' :: (HList outers -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
afterAll' HList outers -> IO ()
func = (TestForest outers inner -> TestTree outers inner)
-> TestDefM outers inner result -> TestDefM outers inner result
forall (outers1 :: [*]) inner1 (outers2 :: [*]) inner2 result.
(TestForest outers1 inner1 -> TestTree outers2 inner2)
-> TestDefM outers1 inner1 result -> TestDefM outers2 inner2 result
wrapRWST ((TestForest outers inner -> TestTree outers inner)
 -> TestDefM outers inner result -> TestDefM outers inner result)
-> (TestForest outers inner -> TestTree outers inner)
-> TestDefM outers inner result
-> TestDefM outers inner result
forall a b. (a -> b) -> a -> b
$ \TestForest outers inner
forest -> (HList outers -> IO ())
-> TestForest outers inner -> TestTree outers inner
forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList outers -> IO ()
func TestForest outers inner
forest

-- | Run a custom action after all spec items without using any outer resources.
afterAll_ ::
  -- | The function to run (once), afterwards.
  IO () ->
  TestDefM outers inner result ->
  TestDefM outers inner result
afterAll_ :: IO ()
-> TestDefM outers inner result -> TestDefM outers inner result
afterAll_ IO ()
action = (HList outers -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
forall (outers :: [*]) inner result.
(HList outers -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
afterAll' ((HList outers -> IO ())
 -> TestDefM outers inner result -> TestDefM outers inner result)
-> (HList outers -> IO ())
-> TestDefM outers inner result
-> TestDefM outers inner result
forall a b. (a -> b) -> a -> b
$ \HList outers
_ -> IO ()
action

-- | Run a custom action before and/or after all spec items in group, to provide access to a resource 'a'.
--
-- See the @FOOTGUN@ note in the docs for 'around_'.
aroundAll ::
  -- | The function that provides the outer resource (once), around the tests.
  ((outer -> IO ()) -> IO ()) ->
  TestDefM (outer ': otherOuters) inner result ->
  TestDefM otherOuters inner result
aroundAll :: ((outer -> IO ()) -> IO ())
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
aroundAll (outer -> IO ()) -> IO ()
func = (TestForest (outer : otherOuters) inner
 -> TestTree otherOuters inner)
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
forall (outers1 :: [*]) inner1 (outers2 :: [*]) inner2 result.
(TestForest outers1 inner1 -> TestTree outers2 inner2)
-> TestDefM outers1 inner1 result -> TestDefM outers2 inner2 result
wrapRWST ((TestForest (outer : otherOuters) inner
  -> TestTree otherOuters inner)
 -> TestDefM (outer : otherOuters) inner result
 -> TestDefM otherOuters inner result)
-> (TestForest (outer : otherOuters) inner
    -> TestTree otherOuters inner)
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
forall a b. (a -> b) -> a -> b
$ \TestForest (outer : otherOuters) inner
forest -> ((outer -> IO ()) -> IO ())
-> TestForest (outer : otherOuters) inner
-> TestTree otherOuters inner
forall outer (otherOuters :: [*]) inner extra.
((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
func TestForest (outer : otherOuters) inner
forest

-- | Run a custom action before and/or after all spec items in a group without accessing any resources.
--
-- == __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 ()
-- >    aroundAll_ 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.around_'.
--
-- Something even more pernicious goes wrong when you run the given action more than once like this:
--
-- > spec :: Spec
-- > spec = do
-- >    let doTwice :: IO () -> IO ()
-- >        doTwice f = f >> f
-- >    aroundAll_ doTwice $ do
-- >      it "should pass" True
--
-- In this case, the test will "just work", but it will be executed twice even if the output reports that it only passed once.
--
-- 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.
aroundAll_ ::
  -- | The function that wraps running the tests.
  (IO () -> IO ()) ->
  TestDefM outers inner result ->
  TestDefM outers inner result
aroundAll_ :: (IO () -> IO ())
-> TestDefM outers inner result -> TestDefM outers inner result
aroundAll_ IO () -> IO ()
func = (TestForest outers inner -> TestTree outers inner)
-> TestDefM outers inner result -> TestDefM outers inner result
forall (outers1 :: [*]) inner1 (outers2 :: [*]) inner2 result.
(TestForest outers1 inner1 -> TestTree outers2 inner2)
-> TestDefM outers1 inner1 result -> TestDefM outers2 inner2 result
wrapRWST ((TestForest outers inner -> TestTree outers inner)
 -> TestDefM outers inner result -> TestDefM outers inner result)
-> (TestForest outers inner -> TestTree outers inner)
-> TestDefM outers inner result
-> TestDefM outers inner result
forall a b. (a -> b) -> a -> b
$ \TestForest outers inner
forest -> (IO () -> IO ())
-> TestForest outers inner -> TestTree outers inner
forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
func TestForest outers inner
forest

-- | Run a custom action before and/or after all spec items in a group to provide access to a resource 'a' while using a resource 'b'
--
-- See the @FOOTGUN@ note in the docs for 'around_'.
aroundAllWith ::
  forall newOuter oldOuter otherOuters inner result.
  -- | The function that provides the new outer resource (once), using the old outer resource.
  ((newOuter -> IO ()) -> (oldOuter -> IO ())) ->
  TestDefM (newOuter ': oldOuter ': otherOuters) inner result ->
  TestDefM (oldOuter ': otherOuters) inner result
aroundAllWith :: ((newOuter -> IO ()) -> oldOuter -> IO ())
-> TestDefM (newOuter : oldOuter : otherOuters) inner result
-> TestDefM (oldOuter : otherOuters) inner result
aroundAllWith (newOuter -> IO ()) -> oldOuter -> IO ()
func = (TestForest (newOuter : oldOuter : otherOuters) inner
 -> TestTree (oldOuter : otherOuters) inner)
-> TestDefM (newOuter : oldOuter : otherOuters) inner result
-> TestDefM (oldOuter : otherOuters) inner result
forall (outers1 :: [*]) inner1 (outers2 :: [*]) inner2 result.
(TestForest outers1 inner1 -> TestTree outers2 inner2)
-> TestDefM outers1 inner1 result -> TestDefM outers2 inner2 result
wrapRWST ((TestForest (newOuter : oldOuter : otherOuters) inner
  -> TestTree (oldOuter : otherOuters) inner)
 -> TestDefM (newOuter : oldOuter : otherOuters) inner result
 -> TestDefM (oldOuter : otherOuters) inner result)
-> (TestForest (newOuter : oldOuter : otherOuters) inner
    -> TestTree (oldOuter : otherOuters) inner)
-> TestDefM (newOuter : oldOuter : otherOuters) inner result
-> TestDefM (oldOuter : otherOuters) inner result
forall a b. (a -> b) -> a -> b
$ \TestForest (newOuter : oldOuter : otherOuters) inner
forest -> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> TestForest (newOuter : oldOuter : otherOuters) inner
-> TestTree (oldOuter : otherOuters) inner
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 ()
func TestForest (newOuter : oldOuter : otherOuters) inner
forest

-- | Declare a node in the spec def forest
wrapRWST ::
  -- | The wrapper node
  (TestForest outers1 inner1 -> TestTree outers2 inner2) ->
  TestDefM outers1 inner1 result ->
  TestDefM outers2 inner2 result
wrapRWST :: (TestForest outers1 inner1 -> TestTree outers2 inner2)
-> TestDefM outers1 inner1 result -> TestDefM outers2 inner2 result
wrapRWST TestForest outers1 inner1 -> TestTree outers2 inner2
func (TestDefM RWST TestRunSettings (TestForest outers1 inner1) () IO result
rwst) = RWST TestRunSettings (TestForest outers2 inner2) () IO result
-> TestDefM outers2 inner2 result
forall (outers :: [*]) inner result.
RWST TestRunSettings (TestForest outers inner) () IO result
-> TestDefM outers inner result
TestDefM (RWST TestRunSettings (TestForest outers2 inner2) () IO result
 -> TestDefM outers2 inner2 result)
-> RWST TestRunSettings (TestForest outers2 inner2) () IO result
-> TestDefM outers2 inner2 result
forall a b. (a -> b) -> a -> b
$
  ((IO (result, (), TestForest outers1 inner1)
  -> IO (result, (), TestForest outers2 inner2))
 -> RWST TestRunSettings (TestForest outers1 inner1) () IO result
 -> RWST TestRunSettings (TestForest outers2 inner2) () IO result)
-> RWST TestRunSettings (TestForest outers1 inner1) () IO result
-> (IO (result, (), TestForest outers1 inner1)
    -> IO (result, (), TestForest outers2 inner2))
-> RWST TestRunSettings (TestForest outers2 inner2) () IO result
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IO (result, (), TestForest outers1 inner1)
 -> IO (result, (), TestForest outers2 inner2))
-> RWST TestRunSettings (TestForest outers1 inner1) () IO result
-> RWST TestRunSettings (TestForest outers2 inner2) () IO result
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 outers1 inner1) () IO result
rwst ((IO (result, (), TestForest outers1 inner1)
  -> IO (result, (), TestForest outers2 inner2))
 -> RWST TestRunSettings (TestForest outers2 inner2) () IO result)
-> (IO (result, (), TestForest outers1 inner1)
    -> IO (result, (), TestForest outers2 inner2))
-> RWST TestRunSettings (TestForest outers2 inner2) () IO result
forall a b. (a -> b) -> a -> b
$ \IO (result, (), TestForest outers1 inner1)
inner -> do
    (result
res, ()
s, TestForest outers1 inner1
forest) <- IO (result, (), TestForest outers1 inner1)
inner
    let forest' :: TestForest outers2 inner2
forest' = [TestForest outers1 inner1 -> TestTree outers2 inner2
func TestForest outers1 inner1
forest]
    (result, (), TestForest outers2 inner2)
-> IO (result, (), TestForest outers2 inner2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (result
res, ()
s, TestForest outers2 inner2
forest')