{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

-- | The 'SetupFunc' abstraction makes resource provider functions (of type @(a -> IO r) -> IO r@) composable.
module Test.Syd.Def.SetupFunc where

import Control.Exception
import Control.Monad.IO.Class
import Test.Syd.Def.Around
import Test.Syd.Def.AroundAll
import Test.Syd.Def.TestDefM
import Test.Syd.HList

-- * Creating 'SetupFunc's

-- | A function that can provide a 'resource'.
--
-- You can think of this as a potentially-resource-aware version of 'IO resource'.
-- In other words, it's like an 'IO resource' that can clean up after itself.
--
-- This type has a monad instance, which means you can now compose setup functions using regular do-notation.
-- This works together nicely with most supplier functions.
-- Some examples:
--
-- * [Network.Wai.Handler.Warp.testWithApplication](https://hackage.haskell.org/package/warp-3.3.13/docs/Network-Wai-Handler-Warp.html#v:testWithApplication)
-- * [Path.IO.withSystemTempDir](https://hackage.haskell.org/package/path-io-1.6.2/docs/Path-IO.html#v:withSystemTempDir)
--
-- Note that these examples already have functions defined for them in sydtest companion libraries.
newtype SetupFunc resource = SetupFunc
  { forall resource.
SetupFunc resource -> forall r. (resource -> IO r) -> IO r
unSetupFunc :: forall r. (resource -> IO r) -> IO r
  }

instance Functor SetupFunc where
  fmap :: forall a b. (a -> b) -> SetupFunc a -> SetupFunc b
fmap a -> b
f (SetupFunc forall r. (a -> IO r) -> IO r
provideA) = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB ->
    let takeA :: a -> IO r
takeA = \a
a -> b -> IO r
takeB forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
     in forall r. (a -> IO r) -> IO r
provideA a -> IO r
takeA

instance Applicative SetupFunc where
  pure :: forall a. a -> SetupFunc a
pure a
a = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \a -> IO r
aFunc -> a -> IO r
aFunc a
a
  (SetupFunc forall r. ((a -> b) -> IO r) -> IO r
provideF) <*> :: forall a b. SetupFunc (a -> b) -> SetupFunc a -> SetupFunc b
<*> (SetupFunc forall r. (a -> IO r) -> IO r
provideA) = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB ->
    forall r. ((a -> b) -> IO r) -> IO r
provideF
      ( \a -> b
f ->
          forall r. (a -> IO r) -> IO r
provideA
            ( \a
a ->
                b -> IO r
takeB (a -> b
f a
a)
            )
      )

instance Monad SetupFunc where
  (SetupFunc forall r. (a -> IO r) -> IO r
provideA) >>= :: forall a b. SetupFunc a -> (a -> SetupFunc b) -> SetupFunc b
>>= a -> SetupFunc b
m = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \b -> IO r
takeB ->
    forall r. (a -> IO r) -> IO r
provideA
      ( \a
a ->
          let (SetupFunc forall r. (b -> IO r) -> IO r
provideB) = a -> SetupFunc b
m a
a
           in forall r. (b -> IO r) -> IO r
provideB (\b
b -> b -> IO r
takeB b
b)
      )

instance MonadIO SetupFunc where
  liftIO :: forall a. IO a -> SetupFunc a
liftIO IO a
ioFunc = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \a -> IO r
takeA -> do
    IO a
ioFunc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO r
takeA

-- | Turn the arguments that you would normally give to 'bracket' into a 'SetupFunc'.
bracketSetupFunc :: IO resource -> (resource -> IO r) -> SetupFunc resource
bracketSetupFunc :: forall resource r.
IO resource -> (resource -> IO r) -> SetupFunc resource
bracketSetupFunc IO resource
acquire resource -> IO r
release = forall resource.
(forall r. (resource -> IO r) -> IO r) -> SetupFunc resource
SetupFunc forall a b. (a -> b) -> a -> b
$ \resource -> IO r
func -> forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO resource
acquire resource -> IO r
release resource -> IO r
func

-- * Using 'SetupFunc' to define your test suite

-- | Use 'around' with a 'SetupFunc'
setupAround ::
  SetupFunc inner ->
  TestDefM outers inner result ->
  TestDefM outers any result
setupAround :: forall inner (outers :: [*]) result any.
SetupFunc inner
-> TestDefM outers inner result -> TestDefM outers any result
setupAround SetupFunc inner
setupFunc = forall oldInner newInner (outers :: [*]) result.
(oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith forall a b. (a -> b) -> a -> b
$ \any
_ -> SetupFunc inner
setupFunc

-- | Use 'aroundWith' with a 'SetupFunc'
setupAroundWith ::
  (oldInner -> SetupFunc newInner) ->
  TestDefM outers newInner result ->
  TestDefM outers oldInner result
setupAroundWith :: forall oldInner newInner (outers :: [*]) result.
(oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith oldInner -> SetupFunc newInner
takeOldInner = 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
$ \newInner -> IO ()
takeNewInner oldInner
oldInner ->
  let SetupFunc forall r. (newInner -> IO r) -> IO r
provideNewInner = oldInner -> SetupFunc newInner
takeOldInner oldInner
oldInner
   in forall r. (newInner -> IO r) -> IO r
provideNewInner forall a b. (a -> b) -> a -> b
$ \newInner
newInner -> newInner -> IO ()
takeNewInner newInner
newInner

-- | Use 'aroundWith'' with a 'SetupFunc'
setupAroundWith' ::
  HContains outers outer =>
  (outer -> oldInner -> SetupFunc newInner) ->
  TestDefM outers newInner result ->
  TestDefM outers oldInner result
setupAroundWith' :: forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' outer -> oldInner -> SetupFunc newInner
f = 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 ()
takeBoth outer
outer oldInner
oldInner ->
  let SetupFunc forall r. (newInner -> IO r) -> IO r
provideNewInner = outer -> oldInner -> SetupFunc newInner
f outer
outer oldInner
oldInner
   in forall r. (newInner -> IO r) -> IO r
provideNewInner forall a b. (a -> b) -> a -> b
$ \newInner
newInner -> outer -> newInner -> IO ()
takeBoth outer
outer newInner
newInner

-- | Use 'aroundAll' with a 'SetupFunc'
setupAroundAll ::
  SetupFunc outer ->
  TestDefM (outer : outers) inner result ->
  TestDefM outers inner result
setupAroundAll :: forall outer (outers :: [*]) inner result.
SetupFunc outer
-> TestDefM (outer : outers) inner result
-> TestDefM outers inner result
setupAroundAll SetupFunc outer
sf = forall outer (otherOuters :: [*]) inner result.
((outer -> IO ()) -> IO ())
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
aroundAll forall a b. (a -> b) -> a -> b
$ \outer -> IO ()
func -> forall resource.
SetupFunc resource -> forall r. (resource -> IO r) -> IO r
unSetupFunc SetupFunc outer
sf outer -> IO ()
func

-- | Use 'aroundAllWith' with a 'SetupFunc'
setupAroundAllWith ::
  (oldOuter -> SetupFunc newOuter) ->
  TestDefM (newOuter ': oldOuter ': outers) inner result ->
  TestDefM (oldOuter ': outers) inner result
setupAroundAllWith :: forall oldOuter newOuter (outers :: [*]) inner result.
(oldOuter -> SetupFunc newOuter)
-> TestDefM (newOuter : oldOuter : outers) inner result
-> TestDefM (oldOuter : outers) inner result
setupAroundAllWith oldOuter -> SetupFunc newOuter
sf = forall newOuter oldOuter (otherOuters :: [*]) inner result.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> TestDefM (newOuter : oldOuter : otherOuters) inner result
-> TestDefM (oldOuter : otherOuters) inner result
aroundAllWith forall a b. (a -> b) -> a -> b
$ \newOuter -> IO ()
takeNewOuter oldOuter
oldOuter ->
  let SetupFunc forall r. (newOuter -> IO r) -> IO r
provideNewOuter = oldOuter -> SetupFunc newOuter
sf oldOuter
oldOuter
   in forall r. (newOuter -> IO r) -> IO r
provideNewOuter forall a b. (a -> b) -> a -> b
$ \newOuter
newOuter -> newOuter -> IO ()
takeNewOuter newOuter
newOuter