{-# 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
type Spec = SpecWith ()
type SpecWith inner = SpecM inner ()
type SpecM inner result = TestDefM '[] inner result
type TestDef outers inner = TestDefM outers inner ()
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'')
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
}