{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-- | A @tasty@ command-line option for enabling nightly tests
module Test.Util.TestEnv (
    TestEnv (..)
  , adjustQuickCheckMaxSize
  , adjustQuickCheckTests
  , askTestEnv
  , defaultMainWithTestEnv
  , defaultTestEnvConfig
  ) where

import           Cardano.Crypto.Init (cryptoInit)
import           Data.Proxy (Proxy (..))
import           Main.Utf8 (withStdTerminalHandles)
import           Options.Applicative (metavar)
import           Test.Tasty
import           Test.Tasty.Ingredients
import           Test.Tasty.Ingredients.Rerun
import           Test.Tasty.Options
import           Test.Tasty.QuickCheck

-- | 'defaultMain' extended with 'iohkTestEnvIngredient' and setting the
-- terminal handles to UTF-8.
defaultMainWithTestEnv :: TestEnvConfig -> TestTree -> IO ()
defaultMainWithTestEnv :: TestEnvConfig -> TestTree -> IO ()
defaultMainWithTestEnv TestEnvConfig
testConfig TestTree
testTree = do
    IO ()
cryptoInit
    IO () -> IO ()
forall (m :: * -> *) r. (MonadIO m, MonadMask m) => m r -> m r
withStdTerminalHandles (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Ingredient] -> TestTree -> IO ()
defaultMainWithIngredients
        [[Ingredient] -> Ingredient
rerunningTests (Ingredient
testEnvIngredient Ingredient -> [Ingredient] -> [Ingredient]
forall a. a -> [a] -> [a]
: [Ingredient]
defaultIngredients)]
        ( TestEnvConfig -> TestTree -> TestTree
withTestEnv TestEnvConfig
testConfig TestTree
testTree )
    where
      testEnvIngredient :: Ingredient
      testEnvIngredient :: Ingredient
testEnvIngredient = [OptionDescription] -> Ingredient
includingOptions [Proxy TestEnv -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy TestEnv
forall {k} (t :: k). Proxy t
Proxy :: Proxy TestEnv)]

-- | Set the appropriate options for the test environment
withTestEnv :: TestEnvConfig -> TestTree -> TestTree
withTestEnv :: TestEnvConfig -> TestTree -> TestTree
withTestEnv TestEnvConfig{Int
nightly :: Int
ci :: Int
nightly :: TestEnvConfig -> Int
ci :: TestEnvConfig -> Int
..} TestTree
testTree = (TestEnv -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
askOption ((TestEnv -> TestTree) -> TestTree)
-> (TestEnv -> TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$ \case
      TestEnv
Nightly -> QuickCheckTests -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
localOption (Int -> QuickCheckTests
QuickCheckTests Int
nightly) TestTree
testTree
      TestEnv
CI      -> QuickCheckTests -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
localOption (Int -> QuickCheckTests
QuickCheckTests Int
ci) TestTree
testTree
      TestEnv
Dev     -> TestTree
testTree

-- | Query and adjust options for `TestEnv`
askTestEnv :: (TestEnv -> TestTree) -> TestTree
askTestEnv :: (TestEnv -> TestTree) -> TestTree
askTestEnv = (TestEnv -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
askOption

-- | Test configurations for test environment
data TestEnvConfig = TestEnvConfig { TestEnvConfig -> Int
nightly :: Int, TestEnvConfig -> Int
ci :: Int }

-- | Default set of tests for each environment
defaultTestEnvConfig :: TestEnvConfig
defaultTestEnvConfig :: TestEnvConfig
defaultTestEnvConfig = TestEnvConfig { nightly :: Int
nightly = Int
100000, ci :: Int
ci = Int
10000 }

-- | An 'Option' that indicates the environment in which to run tests.
data TestEnv = Nightly | CI | Dev

safeReadTestEnv :: String -> Maybe TestEnv
safeReadTestEnv :: String -> Maybe TestEnv
safeReadTestEnv String
"nightly" = TestEnv -> Maybe TestEnv
forall a. a -> Maybe a
Just TestEnv
Nightly
safeReadTestEnv String
"ci"      = TestEnv -> Maybe TestEnv
forall a. a -> Maybe a
Just TestEnv
CI
safeReadTestEnv String
"dev"     = TestEnv -> Maybe TestEnv
forall a. a -> Maybe a
Just TestEnv
Dev
safeReadTestEnv String
_         = Maybe TestEnv
forall a. Maybe a
Nothing

instance IsOption TestEnv where
  defaultValue :: TestEnv
defaultValue = TestEnv
Dev
  parseValue :: String -> Maybe TestEnv
parseValue = String -> Maybe TestEnv
safeReadTestEnv
  optionName :: Tagged TestEnv String
optionName = String -> Tagged TestEnv String
forall a. a -> Tagged TestEnv a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"test-env"
  optionHelp :: Tagged TestEnv String
optionHelp = String -> Tagged TestEnv String
forall a. a -> Tagged TestEnv a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Enable a test mode. \
      \ The 'dev' env sets the default number of quickcheck tests to 100, \
      \ 'nightly' env sets it to 100_000 quickcheck tests, and \
      \ 'ci' env sets it to 10_000 quickcheck tests. \
      \ Individual tests are adjusted to run a number of tests proportional to the value above depending \
      \ on the time it takes to run them."

  -- Set of choices for test environment
  optionCLParser :: Parser TestEnv
optionCLParser = Mod OptionFields TestEnv -> Parser TestEnv
forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (Mod OptionFields TestEnv -> Parser TestEnv)
-> Mod OptionFields TestEnv -> Parser TestEnv
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields TestEnv
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"nightly|ci|dev"

-- | Locally adjust the number of QuickCheck tests for the given test subtree.
-- Unless the previous number of tests was exactly '0', the result will always
-- be at least '1'. For instance:
--
-- > adjustQuickCheckTests (`div` 10)
--
-- will reduce the default number of tests by 10.
--
-- This matters in particular with tests that take a long time; in that case, we
-- settle for running fewer tests, while still scaling with the different test
-- environments (nightly, ci, dev). This function should almost always be
-- preferred to @localOption (QuickCheckTests ...)@ which sets the number of
-- tests regarless of the test environment.
adjustQuickCheckTests :: (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests :: (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests Int -> Int
f =
  (QuickCheckTests -> QuickCheckTests) -> TestTree -> TestTree
forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption ((QuickCheckTests -> QuickCheckTests) -> TestTree -> TestTree)
-> (QuickCheckTests -> QuickCheckTests) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ \(QuickCheckTests Int
n) ->
    Int -> QuickCheckTests
QuickCheckTests (Int -> QuickCheckTests) -> Int -> QuickCheckTests
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int
f Int
n)

-- | Locally adjust the maximum size parameter of QuickCheck tests for the given
-- test subtree, similar to 'adjustQuickCheckTests'.
--
-- The size parameter is varied across test runs from 0 to @maxSize - 1@
-- cyclically, influencing the result of generators that make use of it, like
-- those that call 'Test.QuickCheck.sized'.
--
-- The default is 100.
adjustQuickCheckMaxSize :: (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckMaxSize :: (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckMaxSize Int -> Int
f =
  (QuickCheckMaxSize -> QuickCheckMaxSize) -> TestTree -> TestTree
forall v. IsOption v => (v -> v) -> TestTree -> TestTree
adjustOption ((QuickCheckMaxSize -> QuickCheckMaxSize) -> TestTree -> TestTree)
-> (QuickCheckMaxSize -> QuickCheckMaxSize) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ \(QuickCheckMaxSize Int
n) ->
    Int -> QuickCheckMaxSize
QuickCheckMaxSize (Int -> QuickCheckMaxSize) -> Int -> QuickCheckMaxSize
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int
f Int
n)