{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Syd.Def.TestDefM where

import Control.Monad.Random
import Control.Monad.Reader
import Control.Monad.Writer.Strict
import Data.Kind
import Data.Text (Text)
import GHC.Generics (Generic)
import Test.QuickCheck.IO ()
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecDef

-- | A synonym for easy migration from hspec
type Spec = SpecWith ()

-- | A synonym for easy migration from hspec
type SpecWith inner = SpecM inner ()

-- | A synonym for easy migration from hspec
type SpecM inner result = TestDefM '[] inner result

-- | A synonym for a test suite definition
type TestDef outers inner = TestDefM outers inner ()

-- | The test definition monad
--
-- This type has three parameters:
--
-- * @outers@: A type-level list of the outer resources. These are resources that are prived once, around a group of tests. (This is the type of the results of `aroundAll`.)
-- * @inner@: The inner resource. This is a resource that is set up around every test, and even every example of a property test. (This is the type of the result of `around`.)
-- * @result@: The result ('TestDefM' is a monad.)
--
-- In practice, all of these three parameters should be '()' at the top level.
newtype TestDefM (outers :: [Type]) inner result = TestDefM
  { TestDefM outers inner result
-> WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
unTestDefM :: WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
  }
  deriving
    ( a -> TestDefM outers inner b -> TestDefM outers inner a
(a -> b) -> TestDefM outers inner a -> TestDefM outers inner b
(forall a b.
 (a -> b) -> TestDefM outers inner a -> TestDefM outers inner b)
-> (forall a b.
    a -> TestDefM outers inner b -> TestDefM outers inner a)
-> Functor (TestDefM outers inner)
forall (outers :: [*]) inner a b.
a -> TestDefM outers inner b -> TestDefM outers inner a
forall (outers :: [*]) inner a b.
(a -> b) -> TestDefM outers inner a -> TestDefM outers inner b
forall a b. a -> TestDefM outers inner b -> TestDefM outers inner a
forall a b.
(a -> b) -> TestDefM outers inner a -> TestDefM outers inner b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TestDefM outers inner b -> TestDefM outers inner a
$c<$ :: forall (outers :: [*]) inner a b.
a -> TestDefM outers inner b -> TestDefM outers inner a
fmap :: (a -> b) -> TestDefM outers inner a -> TestDefM outers inner b
$cfmap :: forall (outers :: [*]) inner a b.
(a -> b) -> TestDefM outers inner a -> TestDefM outers inner b
Functor,
      Functor (TestDefM outers inner)
a -> TestDefM outers inner a
Functor (TestDefM outers inner)
-> (forall a. a -> TestDefM outers inner a)
-> (forall a b.
    TestDefM outers inner (a -> b)
    -> TestDefM outers inner a -> TestDefM outers inner b)
-> (forall a b c.
    (a -> b -> c)
    -> TestDefM outers inner a
    -> TestDefM outers inner b
    -> TestDefM outers inner c)
-> (forall a b.
    TestDefM outers inner a
    -> TestDefM outers inner b -> TestDefM outers inner b)
-> (forall a b.
    TestDefM outers inner a
    -> TestDefM outers inner b -> TestDefM outers inner a)
-> Applicative (TestDefM outers inner)
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner a
TestDefM outers inner (a -> b)
-> TestDefM outers inner a -> TestDefM outers inner b
(a -> b -> c)
-> TestDefM outers inner a
-> TestDefM outers inner b
-> TestDefM outers inner c
forall (outers :: [*]) inner. Functor (TestDefM outers inner)
forall (outers :: [*]) inner a. a -> TestDefM outers inner a
forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner a
forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
forall (outers :: [*]) inner a b.
TestDefM outers inner (a -> b)
-> TestDefM outers inner a -> TestDefM outers inner b
forall (outers :: [*]) inner a b c.
(a -> b -> c)
-> TestDefM outers inner a
-> TestDefM outers inner b
-> TestDefM outers inner c
forall a. a -> TestDefM outers inner a
forall a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner a
forall a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
forall a b.
TestDefM outers inner (a -> b)
-> TestDefM outers inner a -> TestDefM outers inner b
forall a b c.
(a -> b -> c)
-> TestDefM outers inner a
-> TestDefM outers inner b
-> TestDefM outers inner c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner a
$c<* :: forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner a
*> :: TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
$c*> :: forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
liftA2 :: (a -> b -> c)
-> TestDefM outers inner a
-> TestDefM outers inner b
-> TestDefM outers inner c
$cliftA2 :: forall (outers :: [*]) inner a b c.
(a -> b -> c)
-> TestDefM outers inner a
-> TestDefM outers inner b
-> TestDefM outers inner c
<*> :: TestDefM outers inner (a -> b)
-> TestDefM outers inner a -> TestDefM outers inner b
$c<*> :: forall (outers :: [*]) inner a b.
TestDefM outers inner (a -> b)
-> TestDefM outers inner a -> TestDefM outers inner b
pure :: a -> TestDefM outers inner a
$cpure :: forall (outers :: [*]) inner a. a -> TestDefM outers inner a
$cp1Applicative :: forall (outers :: [*]) inner. Functor (TestDefM outers inner)
Applicative,
      Applicative (TestDefM outers inner)
a -> TestDefM outers inner a
Applicative (TestDefM outers inner)
-> (forall a b.
    TestDefM outers inner a
    -> (a -> TestDefM outers inner b) -> TestDefM outers inner b)
-> (forall a b.
    TestDefM outers inner a
    -> TestDefM outers inner b -> TestDefM outers inner b)
-> (forall a. a -> TestDefM outers inner a)
-> Monad (TestDefM outers inner)
TestDefM outers inner a
-> (a -> TestDefM outers inner b) -> TestDefM outers inner b
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
forall (outers :: [*]) inner. Applicative (TestDefM outers inner)
forall (outers :: [*]) inner a. a -> TestDefM outers inner a
forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> (a -> TestDefM outers inner b) -> TestDefM outers inner b
forall a. a -> TestDefM outers inner a
forall a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
forall a b.
TestDefM outers inner a
-> (a -> TestDefM outers inner b) -> TestDefM outers inner b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> TestDefM outers inner a
$creturn :: forall (outers :: [*]) inner a. a -> TestDefM outers inner a
>> :: TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
$c>> :: forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> TestDefM outers inner b -> TestDefM outers inner b
>>= :: TestDefM outers inner a
-> (a -> TestDefM outers inner b) -> TestDefM outers inner b
$c>>= :: forall (outers :: [*]) inner a b.
TestDefM outers inner a
-> (a -> TestDefM outers inner b) -> TestDefM outers inner b
$cp1Monad :: forall (outers :: [*]) inner. Applicative (TestDefM outers inner)
Monad,
      Monad (TestDefM outers inner)
Monad (TestDefM outers inner)
-> (forall a. IO a -> TestDefM outers inner a)
-> MonadIO (TestDefM outers inner)
IO a -> TestDefM outers inner a
forall (outers :: [*]) inner. Monad (TestDefM outers inner)
forall (outers :: [*]) inner a. IO a -> TestDefM outers inner a
forall a. IO a -> TestDefM outers inner a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> TestDefM outers inner a
$cliftIO :: forall (outers :: [*]) inner a. IO a -> TestDefM outers inner a
$cp1MonadIO :: forall (outers :: [*]) inner. Monad (TestDefM outers inner)
MonadIO,
      MonadReader TestDefEnv,
      MonadWriter (TestForest outers inner)
    )

data TestDefEnv = TestDefEnv
  { TestDefEnv -> [Text]
testDefEnvDescriptionPath :: ![Text],
    TestDefEnv -> TestRunSettings
testDefEnvTestRunSettings :: !TestRunSettings
  }
  deriving (Int -> TestDefEnv -> ShowS
[TestDefEnv] -> ShowS
TestDefEnv -> String
(Int -> TestDefEnv -> ShowS)
-> (TestDefEnv -> String)
-> ([TestDefEnv] -> ShowS)
-> Show TestDefEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestDefEnv] -> ShowS
$cshowList :: [TestDefEnv] -> ShowS
show :: TestDefEnv -> String
$cshow :: TestDefEnv -> String
showsPrec :: Int -> TestDefEnv -> ShowS
$cshowsPrec :: Int -> TestDefEnv -> ShowS
Show, TestDefEnv -> TestDefEnv -> Bool
(TestDefEnv -> TestDefEnv -> Bool)
-> (TestDefEnv -> TestDefEnv -> Bool) -> Eq TestDefEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestDefEnv -> TestDefEnv -> Bool
$c/= :: TestDefEnv -> TestDefEnv -> Bool
== :: TestDefEnv -> TestDefEnv -> Bool
$c== :: TestDefEnv -> TestDefEnv -> Bool
Eq, (forall x. TestDefEnv -> Rep TestDefEnv x)
-> (forall x. Rep TestDefEnv x -> TestDefEnv) -> Generic TestDefEnv
forall x. Rep TestDefEnv x -> TestDefEnv
forall x. TestDefEnv -> Rep TestDefEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestDefEnv x -> TestDefEnv
$cfrom :: forall x. TestDefEnv -> Rep TestDefEnv x
Generic)

execTestDefM :: Settings -> TestDefM outers inner result -> IO (TestForest outers inner)
execTestDefM :: Settings
-> TestDefM outers inner result -> IO (TestForest outers inner)
execTestDefM Settings
sets = ((result, TestForest outers inner) -> TestForest outers inner)
-> IO (result, TestForest outers inner)
-> IO (TestForest outers inner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (result, TestForest outers inner) -> TestForest outers inner
forall a b. (a, b) -> b
snd (IO (result, TestForest outers inner)
 -> IO (TestForest outers inner))
-> (TestDefM outers inner result
    -> IO (result, TestForest outers inner))
-> TestDefM outers inner result
-> IO (TestForest outers inner)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings
-> TestDefM outers inner result
-> IO (result, TestForest outers inner)
forall (outers :: [*]) inner result.
Settings
-> TestDefM outers inner result
-> IO (result, TestForest outers inner)
runTestDefM Settings
sets

runTestDefM :: Settings -> TestDefM outers inner result -> IO (result, TestForest outers inner)
runTestDefM :: Settings
-> TestDefM outers inner result
-> IO (result, TestForest outers inner)
runTestDefM Settings
sets TestDefM outers inner result
defFunc = do
  let func :: WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
func = TestDefM outers inner result
-> WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
forall (outers :: [*]) inner result.
TestDefM outers inner result
-> WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
unTestDefM TestDefM outers inner result
defFunc
  let testDefEnv :: TestDefEnv
testDefEnv =
        TestDefEnv :: [Text] -> TestRunSettings -> TestDefEnv
TestDefEnv
          { testDefEnvDescriptionPath :: [Text]
testDefEnvDescriptionPath = [],
            testDefEnvTestRunSettings :: TestRunSettings
testDefEnvTestRunSettings = Settings -> TestRunSettings
toTestRunSettings Settings
sets
          }
  (result
a, TestForest outers inner
testForest) <- ReaderT TestDefEnv IO (result, TestForest outers inner)
-> TestDefEnv -> IO (result, TestForest outers inner)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
-> ReaderT TestDefEnv IO (result, TestForest outers inner)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result
func) TestDefEnv
testDefEnv
  let testForest' :: TestForest outers inner
testForest' = Maybe Text -> TestForest outers inner -> TestForest outers inner
forall (outers :: [*]) inner result.
Maybe Text
-> SpecDefForest outers inner result
-> SpecDefForest outers inner result
filterTestForest (Settings -> Maybe Text
settingFilter Settings
sets) TestForest outers inner
testForest
  StdGen
stdgen <- case Settings -> SeedSetting
settingSeed Settings
sets of
    FixedSeed Int
seed -> StdGen -> IO StdGen
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StdGen -> IO StdGen) -> StdGen -> IO StdGen
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
seed
    SeedSetting
RandomSeed -> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  let testForest'' :: TestForest outers inner
testForest'' =
        if Settings -> Bool
settingRandomiseExecutionOrder Settings
sets
          then Rand StdGen (TestForest outers inner)
-> StdGen -> TestForest outers inner
forall g a. Rand g a -> g -> a
evalRand (TestForest outers inner -> Rand StdGen (TestForest outers inner)
forall (m :: * -> *) (outers :: [*]) inner result.
MonadRandom m =>
SpecDefForest outers inner result
-> m (SpecDefForest outers inner result)
randomiseTestForest TestForest outers inner
testForest') StdGen
stdgen
          else TestForest outers inner
testForest'
  (result, TestForest outers inner)
-> IO (result, TestForest outers inner)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (result
a, TestForest outers inner
testForest'')

-- | Get the path of 'describe' strings upwards.
--
-- Note that using this function makes tests less movable, depending on what
-- you do with these strings.
-- For example, if you use these strings to define the path to a golden test
-- file, then that path will change if you move the tests somewhere else.
-- This combines unfortunately with the way @sydtest-discover@ makes the module
-- name part of this path.
-- Indeed: moving your tests to another module will change their path as well,
-- if you use @sydtest-discover@.
-- Also note that while test forests can be randomised, their description path
-- upwards will not, because of how trees are structured.
getTestDescriptionPath :: TestDefM outers inner [Text]
getTestDescriptionPath :: TestDefM outers inner [Text]
getTestDescriptionPath = (TestDefEnv -> [Text]) -> TestDefM outers inner [Text]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TestDefEnv -> [Text]
testDefEnvDescriptionPath

toTestRunSettings :: Settings -> TestRunSettings
toTestRunSettings :: Settings -> TestRunSettings
toTestRunSettings Settings {Bool
Int
Maybe Bool
Maybe Text
SeedSetting
ReportProgress
Iterations
Threads
settingDebug :: Settings -> Bool
settingReportProgress :: Settings -> ReportProgress
settingFailOnFlaky :: Settings -> Bool
settingIterations :: Settings -> Iterations
settingFailFast :: Settings -> Bool
settingColour :: Settings -> Maybe Bool
settingGoldenReset :: Settings -> Bool
settingGoldenStart :: Settings -> Bool
settingMaxShrinks :: Settings -> Int
settingMaxDiscard :: Settings -> Int
settingMaxSize :: Settings -> Int
settingMaxSuccess :: Settings -> Int
settingThreads :: Settings -> Threads
settingDebug :: Bool
settingReportProgress :: ReportProgress
settingFailOnFlaky :: Bool
settingIterations :: Iterations
settingFailFast :: Bool
settingFilter :: Maybe Text
settingColour :: Maybe Bool
settingGoldenReset :: Bool
settingGoldenStart :: Bool
settingMaxShrinks :: Int
settingMaxDiscard :: Int
settingMaxSize :: Int
settingMaxSuccess :: Int
settingThreads :: Threads
settingRandomiseExecutionOrder :: Bool
settingSeed :: SeedSetting
settingRandomiseExecutionOrder :: Settings -> Bool
settingSeed :: Settings -> SeedSetting
settingFilter :: Settings -> Maybe Text
..} =
  TestRunSettings :: SeedSetting
-> Int -> Int -> Int -> Int -> Bool -> Bool -> TestRunSettings
TestRunSettings
    { testRunSettingSeed :: SeedSetting
testRunSettingSeed = SeedSetting
settingSeed,
      testRunSettingMaxSuccess :: Int
testRunSettingMaxSuccess = Int
settingMaxSuccess,
      testRunSettingMaxSize :: Int
testRunSettingMaxSize = Int
settingMaxSize,
      testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxDiscardRatio = Int
settingMaxDiscard,
      testRunSettingMaxShrinks :: Int
testRunSettingMaxShrinks = Int
settingMaxShrinks,
      testRunSettingGoldenStart :: Bool
testRunSettingGoldenStart = Bool
settingGoldenStart,
      testRunSettingGoldenReset :: Bool
testRunSettingGoldenReset = Bool
settingGoldenReset
    }