{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module defines functions for declaring different test settings
module Test.Syd.Modify
  ( -- * Declaring different test settings
    modifyMaxSuccess,
    modifyMaxDiscardRatio,
    modifyMaxSize,
    modifyMaxShrinks,
    modifyRunSettings,
    TestRunSettings (..),

    -- * Declaring parallelism
    sequential,
    parallel,
    withParallelism,
    Parallelism (..),

    -- * Declaring randomisation order
    randomiseExecutionOrder,
    doNotRandomiseExecutionOrder,
    withExecutionOrderRandomisation,
    ExecutionOrderRandomisation (..),

    -- * Modifying timeouts
    modifyTimeout,
    withoutTimeout,
    withTimeout,

    -- * Modifying the number of retries
    modifyRetries,
    withoutRetries,
    withRetries,

    -- * Declaring flakiness
    flaky,
    flakyWith,
    notFlaky,
    potentiallyFlaky,
    potentiallyFlakyWith,
    withFlakiness,
    FlakinessMode (..),

    -- * Declaring expectations
    expectPassing,
    expectFailing,
    withExpectationMode,
    ExpectationMode (..),
  )
where

import Control.Monad.RWS.Strict
import Test.QuickCheck.IO ()
import Test.Syd.Def
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecDef

modifyRunSettings :: (TestRunSettings -> TestRunSettings) -> TestDefM a b c -> TestDefM a b c
modifyRunSettings :: forall (a :: [*]) b c.
(TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
modifyRunSettings TestRunSettings -> TestRunSettings
func = (TestDefEnv -> TestDefEnv) -> TestDefM a b c -> TestDefM a b c
forall a.
(TestDefEnv -> TestDefEnv) -> TestDefM a b a -> TestDefM a b a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\TestDefEnv
tde -> TestDefEnv
tde {testDefEnvTestRunSettings = func $ testDefEnvTestRunSettings tde})

modifyMaxSuccess :: (Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxSuccess :: forall (a :: [*]) b c.
(Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxSuccess Int -> Int
func = (TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
modifyRunSettings ((TestRunSettings -> TestRunSettings)
 -> TestDefM a b c -> TestDefM a b c)
-> (TestRunSettings -> TestRunSettings)
-> TestDefM a b c
-> TestDefM a b c
forall a b. (a -> b) -> a -> b
$ \TestRunSettings
trs -> TestRunSettings
trs {testRunSettingMaxSuccess = func (testRunSettingMaxSuccess trs)}

modifyMaxDiscardRatio :: (Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxDiscardRatio :: forall (a :: [*]) b c.
(Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxDiscardRatio Int -> Int
func = (TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
modifyRunSettings ((TestRunSettings -> TestRunSettings)
 -> TestDefM a b c -> TestDefM a b c)
-> (TestRunSettings -> TestRunSettings)
-> TestDefM a b c
-> TestDefM a b c
forall a b. (a -> b) -> a -> b
$ \TestRunSettings
trs -> TestRunSettings
trs {testRunSettingMaxDiscardRatio = func (testRunSettingMaxDiscardRatio trs)}

modifyMaxSize :: (Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxSize :: forall (a :: [*]) b c.
(Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxSize Int -> Int
func = (TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
modifyRunSettings ((TestRunSettings -> TestRunSettings)
 -> TestDefM a b c -> TestDefM a b c)
-> (TestRunSettings -> TestRunSettings)
-> TestDefM a b c
-> TestDefM a b c
forall a b. (a -> b) -> a -> b
$ \TestRunSettings
trs -> TestRunSettings
trs {testRunSettingMaxSize = func (testRunSettingMaxSize trs)}

modifyMaxShrinks :: (Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxShrinks :: forall (a :: [*]) b c.
(Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxShrinks Int -> Int
func = (TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(TestRunSettings -> TestRunSettings)
-> TestDefM a b c -> TestDefM a b c
modifyRunSettings ((TestRunSettings -> TestRunSettings)
 -> TestDefM a b c -> TestDefM a b c)
-> (TestRunSettings -> TestRunSettings)
-> TestDefM a b c
-> TestDefM a b c
forall a b. (a -> b) -> a -> b
$ \TestRunSettings
trs -> TestRunSettings
trs {testRunSettingMaxShrinks = func (testRunSettingMaxShrinks trs)}

-- | Declare that all tests below must be run sequentially
sequential :: TestDefM a b c -> TestDefM a b c
sequential :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
sequential = Parallelism -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
Parallelism -> TestDefM a b c -> TestDefM a b c
withParallelism Parallelism
Sequential

-- | Declare that all tests below may be run in parallel. (This is the default.)
parallel :: TestDefM a b c -> TestDefM a b c
parallel :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel = Parallelism -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
Parallelism -> TestDefM a b c -> TestDefM a b c
withParallelism Parallelism
Parallel

-- | Annotate a test group with 'Parallelism'.
withParallelism :: Parallelism -> TestDefM a b c -> TestDefM a b c
withParallelism :: forall (a :: [*]) b c.
Parallelism -> TestDefM a b c -> TestDefM a b c
withParallelism Parallelism
p = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b c -> TestDefM a b c
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parallelism -> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
p)

-- | Declare that the order of execution of all tests below must not be randomised.
doNotRandomiseExecutionOrder :: TestDefM a b c -> TestDefM a b c
doNotRandomiseExecutionOrder :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
doNotRandomiseExecutionOrder = ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c
withExecutionOrderRandomisation ExecutionOrderRandomisation
DoNotRandomiseExecutionOrder

-- | Declare that the order of execution of all tests below may be randomised.
randomiseExecutionOrder :: TestDefM a b c -> TestDefM a b c
randomiseExecutionOrder :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
randomiseExecutionOrder = ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c
withExecutionOrderRandomisation ExecutionOrderRandomisation
RandomiseExecutionOrder

-- | Annotate a test group with 'ExecutionOrderRandomisation'.
withExecutionOrderRandomisation :: ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c
withExecutionOrderRandomisation :: forall (a :: [*]) b c.
ExecutionOrderRandomisation -> TestDefM a b c -> TestDefM a b c
withExecutionOrderRandomisation ExecutionOrderRandomisation
p = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b c -> TestDefM a b c
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutionOrderRandomisation
-> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
p)

-- | Modify the test timeout
modifyTimeout :: (Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c
modifyTimeout :: forall (a :: [*]) b c.
(Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c
modifyTimeout Timeout -> Timeout
modTimeout = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b c -> TestDefM a b c
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timeout -> Timeout) -> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (outers :: [*]) inner extra.
(Timeout -> Timeout)
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefTimeoutNode Timeout -> Timeout
modTimeout)

-- | Turn off timeouts
withoutTimeout :: TestDefM a b c -> TestDefM a b c
withoutTimeout :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
withoutTimeout = (Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c
modifyTimeout (Timeout -> Timeout -> Timeout
forall a b. a -> b -> a
const Timeout
DoNotTimeout)

-- | Turn off timeouts
withTimeout :: Int -> TestDefM a b c -> TestDefM a b c
withTimeout :: forall (a :: [*]) b c. Int -> TestDefM a b c -> TestDefM a b c
withTimeout Int
i = (Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(Timeout -> Timeout) -> TestDefM a b c -> TestDefM a b c
modifyTimeout (Timeout -> Timeout -> Timeout
forall a b. a -> b -> a
const (Int -> Timeout
TimeoutAfterMicros Int
i))

-- | Modify the number of retries to use in flakiness diagnostics.
modifyRetries :: (Word -> Word) -> TestDefM a b c -> TestDefM a b c
modifyRetries :: forall (a :: [*]) b c.
(Word -> Word) -> TestDefM a b c -> TestDefM a b c
modifyRetries Word -> Word
modRetries = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b c -> TestDefM a b c
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word) -> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (outers :: [*]) inner extra.
(Word -> Word)
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRetriesNode Word -> Word
modRetries)

-- | Turn off retries
withoutRetries :: TestDefM a b c -> TestDefM a b c
withoutRetries :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
withoutRetries = (Word -> Word) -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(Word -> Word) -> TestDefM a b c -> TestDefM a b c
modifyRetries (Word -> Word -> Word
forall a b. a -> b -> a
const Word
0)

-- | Make the number of retries this constant
withRetries :: Word -> TestDefM a b c -> TestDefM a b c
withRetries :: forall (a :: [*]) b c. Word -> TestDefM a b c -> TestDefM a b c
withRetries Word
w = (Word -> Word) -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(Word -> Word) -> TestDefM a b c -> TestDefM a b c
modifyRetries (Word -> Word -> Word
forall a b. a -> b -> a
const Word
w)

-- | Mark a test suite as "potentially flaky" with a given number of retries.
--
-- This will retry any test in the given test group up to the given number of tries, and pass a test if it passes once.
-- The test output will show which tests were flaky.
--
-- WARNING: This is only a valid approach to dealing with test flakiness if it is true that tests never pass accidentally.
-- In other words: tests using flaky must be guaranteed to fail every time if
-- an error is introduced in the code, it should only be added to deal with
-- accidental failures, never accidental passes.
flaky :: Word -> TestDefM a b c -> TestDefM a b c
flaky :: forall (a :: [*]) b c. Word -> TestDefM a b c -> TestDefM a b c
flaky Word
i = Word -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c. Word -> TestDefM a b c -> TestDefM a b c
withRetries Word
i (TestDefM a b c -> TestDefM a b c)
-> (TestDefM a b c -> TestDefM a b c)
-> TestDefM a b c
-> TestDefM a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlakinessMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness (Maybe String -> FlakinessMode
MayBeFlaky Maybe String
forall a. Maybe a
Nothing)

-- | Like 'flaky', but also shows the given message to the user whenever the test is flaky.
--
-- You could use it like this:
--
-- >>> flakyWith 3 "Something sometimes goes wrong with the database, see issue 6346" ourTestSuite
flakyWith :: Word -> String -> TestDefM a b c -> TestDefM a b c
flakyWith :: forall (a :: [*]) b c.
Word -> String -> TestDefM a b c -> TestDefM a b c
flakyWith Word
i String
message = (Word -> Word) -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
(Word -> Word) -> TestDefM a b c -> TestDefM a b c
modifyRetries (Word -> Word -> Word
forall a b. a -> b -> a
const Word
i) (TestDefM a b c -> TestDefM a b c)
-> (TestDefM a b c -> TestDefM a b c)
-> TestDefM a b c
-> TestDefM a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlakinessMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness (Maybe String -> FlakinessMode
MayBeFlaky (String -> Maybe String
forall a. a -> Maybe a
Just String
message))

-- | Mark a test suite as "must not be flaky".
--
-- This is useful to have a subgroup of a group marked as 'flaky' that must not be flaky afteral.
notFlaky :: TestDefM a b c -> TestDefM a b c
notFlaky :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
notFlaky = FlakinessMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness FlakinessMode
MayNotBeFlaky

-- | Mark a test suite as 'potentially flaky', such that it will not fail if it is
-- flaky but passes at least once.
potentiallyFlaky :: TestDefM a b c -> TestDefM a b c
potentiallyFlaky :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
potentiallyFlaky = FlakinessMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness (Maybe String -> FlakinessMode
MayBeFlaky Maybe String
forall a. Maybe a
Nothing)

-- | Like 'potentiallyFlaky', but with a message.
potentiallyFlakyWith :: String -> TestDefM a b c -> TestDefM a b c
potentiallyFlakyWith :: forall (a :: [*]) b c. String -> TestDefM a b c -> TestDefM a b c
potentiallyFlakyWith String
message = FlakinessMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness (Maybe String -> FlakinessMode
MayBeFlaky (String -> Maybe String
forall a. a -> Maybe a
Just String
message))

-- | Annotate a test group with 'FlakinessMode'.
withFlakiness :: FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness :: forall (a :: [*]) b c.
FlakinessMode -> TestDefM a b c -> TestDefM a b c
withFlakiness FlakinessMode
f = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b c -> TestDefM a b c
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlakinessMode -> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
f)

-- | Mark a test suite as 'should pass'
expectPassing :: TestDefM a b c -> TestDefM a b c
expectPassing :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
expectPassing = ExpectationMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
ExpectationMode -> TestDefM a b c -> TestDefM a b c
withExpectationMode ExpectationMode
ExpectPassing

-- | Mark a test suite as 'should fail'
expectFailing :: TestDefM a b c -> TestDefM a b c
expectFailing :: forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
expectFailing = ExpectationMode -> TestDefM a b c -> TestDefM a b c
forall (a :: [*]) b c.
ExpectationMode -> TestDefM a b c -> TestDefM a b c
withExpectationMode ExpectationMode
ExpectFailing

-- | Annotate a test suite with 'ExpectationMode'
withExpectationMode :: ExpectationMode -> TestDefM a b c -> TestDefM a b c
withExpectationMode :: forall (a :: [*]) b c.
ExpectationMode -> TestDefM a b c -> TestDefM a b c
withExpectationMode ExpectationMode
em = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b c -> TestDefM a b c
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectationMode -> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (outers :: [*]) inner extra.
ExpectationMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefExpectationNode ExpectationMode
em)