module Test.Syd.Def.Env where

import Control.Monad.Reader
import GHC.Stack
import Test.Syd.Def.Specify
import Test.Syd.Def.TestDefM

-- | For defining a part of a test suite in 'ReaderT IO' instead of in 'IO'.
--
-- This way you can write this:
--
-- > spec :: Spec
-- > spec = around withConnectionPool $
-- >   it "can read what it writes" $ \pool ->
-- >     let person = Person { name = "Dave", age = 25 }
-- >     i <- runSqlPool (insert person) pool
-- >     person' <- runSqlPool (get i) pool
-- >     person' `shouldBe` person
--
-- like this instead:
--
-- > spec :: Spec
-- > spec = around withConnectionPool $
-- >   eit "can read what it writes" $ do
-- >     let person = Person { name = "Dave", age = 25 }
-- >     i <- runDB $ insert person
-- >     person' <- runDB $ get i
-- >     liftIO $ person' `shouldBe` person
-- >
-- > runDB :: ReaderT ConnectionPool IO a -> IO a
--
-- Note that you use `eit` with a property test. In that case you would have to write it like this:
--
-- > spec :: Spec
-- > spec = around withConnectionPool $
-- >   it "can read what it writes" $ \pool -> do
-- >     forAllValid $ \person -> withTestEnv pool $ do
-- >       i <- runDB $ insert person
-- >       person' <- runDB $ get i
-- >       liftIO $ person' `shouldBe` person
eit :: HasCallStack => String -> ReaderT env IO () -> TestDef l env
eit :: String -> ReaderT env IO () -> TestDef l env
eit String
s ReaderT env IO ()
f = String -> (env -> IO ()) -> TestDefM l (Arg2 (env -> IO ())) ()
forall (outers :: [*]) test.
(HasCallStack, IsTest test, Arg1 test ~ ()) =>
String -> test -> TestDefM outers (Arg2 test) ()
it String
s (\env
env -> ReaderT env IO () -> env -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT env IO ()
f env
env)

-- | Helper function to run a property test with an 'env'.
--
-- > withTestEnv = flip runReaderT
withTestEnv :: env -> ReaderT env IO a -> IO a
withTestEnv :: env -> ReaderT env IO a -> IO a
withTestEnv = (ReaderT env IO a -> env -> IO a)
-> env -> ReaderT env IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT env IO a -> env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT