{-# OPTIONS_GHC -Wno-orphans #-}
-- | Tasty integration
--
-- This are the internal guts of the integration. Publicly visible API lives in
-- "Test.Tasty.Falsify".
module Test.Falsify.Internal.Driver.Tasty (
    -- * Test property
    testProperty
    -- * Configure test behaviour
  , TestOptions(..)
  , Verbose(..)
  , ExpectFailure(..)
  , testPropertyWith
  ) where

import Prelude hiding (log)

import Data.Default
import Data.Maybe
import Data.Proxy
import Data.Tagged
import Test.Tasty
import Test.Tasty.Options (IsOption(..), OptionSet)
import Test.Tasty.Providers (IsTest(..))

import qualified Test.Tasty.Options as Tasty

import Test.Falsify.Internal.Driver
import Test.Falsify.Internal.Driver.ReplaySeed
import Test.Falsify.Internal.Property

import qualified Options.Applicative  as Opts
import qualified Test.Tasty.Providers as Tasty

{-------------------------------------------------------------------------------
  Tasty integration
-------------------------------------------------------------------------------}

data Test = Test TestOptions (Property' String ())

data TestOptions = TestOptions {
      -- | Do we expect this test to fail?
      TestOptions -> ExpectFailure
expectFailure :: ExpectFailure

      -- | Override verbose mode for this test
    , TestOptions -> Maybe Verbose
overrideVerbose :: Maybe Verbose

      -- | Override the maximum number of shrink steps for this test
    , TestOptions -> Maybe Word
overrideMaxShrinks :: Maybe Word

      -- | Override the number of tests
    , TestOptions -> Maybe Word
overrideNumTests :: Maybe Word

      -- | Override how many tests can be discarded per successful test
    , TestOptions -> Maybe Word
overrideMaxRatio :: Maybe Word
    }

instance Default TestOptions where
  def :: TestOptions
def = TestOptions {
        expectFailure :: ExpectFailure
expectFailure      = ExpectFailure
DontExpectFailure
      , overrideVerbose :: Maybe Verbose
overrideVerbose    = forall a. Maybe a
Nothing
      , overrideMaxShrinks :: Maybe Word
overrideMaxShrinks = forall a. Maybe a
Nothing
      , overrideNumTests :: Maybe Word
overrideNumTests   = forall a. Maybe a
Nothing
      , overrideMaxRatio :: Maybe Word
overrideMaxRatio   = forall a. Maybe a
Nothing
      }

instance IsTest Test where
  -- @tasty@ docs (1.4.3) explicitly say to ignore the @reportProgress@ argument
  run :: OptionSet -> Test -> (Progress -> IO ()) -> IO Result
run OptionSet
opts (Test TestOptions
testOpts Property' String ()
prop) Progress -> IO ()
_reportProgress =
      RenderedTestResult -> Result
toTastyResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbose
-> ExpectFailure
-> (ReplaySeed, [Success ()], TotalDiscarded,
    Maybe (Failure String))
-> RenderedTestResult
renderTestResult Verbose
verbose (TestOptions -> ExpectFailure
expectFailure TestOptions
testOpts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall e a.
Options
-> Property' e a
-> IO (ReplaySeed, [Success a], TotalDiscarded, Maybe (Failure e))
falsify Options
driverOpts Property' String ()
prop
    where
      verbose :: Verbose
      verbose :: Verbose
verbose = forall a. a -> Maybe a -> a
fromMaybe (forall v. IsOption v => OptionSet -> v
Tasty.lookupOption OptionSet
opts) (TestOptions -> Maybe Verbose
overrideVerbose TestOptions
testOpts)

      driverOpts :: Options
      driverOpts :: Options
driverOpts =
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id
              (\Word
x Options
o -> Options
o{maxShrinks :: Maybe Word
maxShrinks = forall a. a -> Maybe a
Just Word
x})
              (TestOptions -> Maybe Word
overrideMaxShrinks TestOptions
testOpts)
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id
              (\Word
x Options
o -> Options
o{tests :: Word
tests = Word
x})
              (TestOptions -> Maybe Word
overrideNumTests TestOptions
testOpts)
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id
              (\Word
x Options
o -> Options
o{maxRatio :: Word
maxRatio = Word
x})
              (TestOptions -> Maybe Word
overrideMaxRatio TestOptions
testOpts)
          forall a b. (a -> b) -> a -> b
$ OptionSet -> Options
driverOptions OptionSet
opts

  testOptions :: Tagged Test [OptionDescription]
testOptions = forall {k} (s :: k) b. b -> Tagged s b
Tagged [
        forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @Verbose
      , forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @Tests
      , forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @MaxShrinks
      , forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @Replay
      , forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @MaxRatio
      ]

toTastyResult :: RenderedTestResult -> Tasty.Result
toTastyResult :: RenderedTestResult -> Result
toTastyResult RenderedTestResult{Bool
testPassed :: RenderedTestResult -> Bool
testPassed :: Bool
testPassed, String
testOutput :: RenderedTestResult -> String
testOutput :: String
testOutput}
  | Bool
testPassed = String -> Result
Tasty.testPassed String
testOutput
  | Bool
otherwise  = String -> Result
Tasty.testFailed String
testOutput

{-------------------------------------------------------------------------------
  User API
-------------------------------------------------------------------------------}

-- | Generalization of 'testPropertyWith' using default options
testProperty :: TestName -> Property' String () -> TestTree
testProperty :: String -> Property' String () -> TestTree
testProperty = TestOptions -> String -> Property' String () -> TestTree
testPropertyWith forall a. Default a => a
def

testPropertyWith :: TestOptions -> TestName -> Property' String () -> TestTree
testPropertyWith :: TestOptions -> String -> Property' String () -> TestTree
testPropertyWith TestOptions
testOpts String
name = forall t. IsTest t => String -> t -> TestTree
Tasty.singleTest String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestOptions -> Property' String () -> Test
Test TestOptions
testOpts

{-------------------------------------------------------------------------------
  Options specific to the tasty test runner

  Not all of these options are command line options; some are set on a
  test-by-test basis, such as 'ExpectFailure'.
-------------------------------------------------------------------------------}

instance IsOption Verbose where
  defaultValue :: Verbose
defaultValue   = Verbose
NotVerbose
  parseValue :: String -> Maybe Verbose
parseValue     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
b -> if Bool
b then Verbose
Verbose else Verbose
NotVerbose)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
Tasty.safeReadBool
  optionName :: Tagged Verbose String
optionName     = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ String
"falsify-verbose"
  optionHelp :: Tagged Verbose String
optionHelp     = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ String
"Show the generated test cases"
  optionCLParser :: Parser Verbose
optionCLParser = forall v. IsOption v => Mod FlagFields v -> v -> Parser v
Tasty.mkFlagCLParser forall a. Monoid a => a
mempty Verbose
Verbose

{-------------------------------------------------------------------------------
  Options

  NOTE: If we add another option here, we must also add it in 'testOptions'.
-------------------------------------------------------------------------------}

newtype Tests      = Tests      { Tests -> Word
getTests      :: Word             }
newtype MaxShrinks = MaxShrinks { MaxShrinks -> Maybe Word
getMaxShrinks :: Maybe Word       }
newtype Replay     = Replay     { Replay -> Maybe ReplaySeed
getReplay     :: Maybe ReplaySeed }
newtype MaxRatio   = MaxRatio   { MaxRatio -> Word
getMaxRatio   :: Word             }

instance IsOption Tests where
  defaultValue :: Tests
defaultValue   = Word -> Tests
Tests (Options -> Word
tests forall a. Default a => a
def)
  parseValue :: String -> Maybe Tests
parseValue     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Tests
Tests forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Tasty.safeRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'_')
  optionName :: Tagged Tests String
optionName     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"falsify-tests"
  optionHelp :: Tagged Tests String
optionHelp     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"Number of test cases to generate"

instance IsOption MaxShrinks where
  defaultValue :: MaxShrinks
defaultValue   = Maybe Word -> MaxShrinks
MaxShrinks (Options -> Maybe Word
maxShrinks forall a. Default a => a
def)
  parseValue :: String -> Maybe MaxShrinks
parseValue     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Word -> MaxShrinks
MaxShrinks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Tasty.safeRead
  optionName :: Tagged MaxShrinks String
optionName     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"falsify-shrinks"
  optionHelp :: Tagged MaxShrinks String
optionHelp     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"Random seed to use for replaying a previous test run"

instance IsOption Replay where
  defaultValue :: Replay
defaultValue   = Maybe ReplaySeed -> Replay
Replay (Options -> Maybe ReplaySeed
replay forall a. Default a => a
def)
  parseValue :: String -> Maybe Replay
parseValue     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe ReplaySeed -> Replay
Replay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe ReplaySeed
safeReadReplaySeed
  optionName :: Tagged Replay String
optionName     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"falsify-replay"
  optionHelp :: Tagged Replay String
optionHelp     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"Random seed to use for replaying test"
  optionCLParser :: Parser Replay
optionCLParser = forall a. ReadM a -> Mod OptionFields a -> Parser a
Opts.option ReadM Replay
readReplaySeed forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [
                       forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) b. Tagged s b -> b
untag forall a b. (a -> b) -> a -> b
$ forall v. IsOption v => Tagged v String
optionName @Replay
                     , forall (f :: * -> *) a. String -> Mod f a
Opts.help forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) b. Tagged s b -> b
untag forall a b. (a -> b) -> a -> b
$ forall v. IsOption v => Tagged v String
optionHelp @Replay
                     ]
    where
      readReplaySeed :: Opts.ReadM Replay
      readReplaySeed :: ReadM Replay
readReplaySeed = forall s. IsString s => ReadM s
Opts.str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe ReplaySeed -> Replay
Replay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => String -> m ReplaySeed
parseReplaySeed

instance IsOption MaxRatio where
  defaultValue :: MaxRatio
defaultValue   = Word -> MaxRatio
MaxRatio (Options -> Word
maxRatio forall a. Default a => a
def)
  parseValue :: String -> Maybe MaxRatio
parseValue     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> MaxRatio
MaxRatio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Tasty.safeRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'_')
  optionName :: Tagged MaxRatio String
optionName     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"falsify-max-ratio"
  optionHelp :: Tagged MaxRatio String
optionHelp     = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"Maximum number of discarded tests per successful test"

driverOptions :: OptionSet -> Options
driverOptions :: OptionSet -> Options
driverOptions OptionSet
opts = Options {
      tests :: Word
tests         = Tests -> Word
getTests      forall a b. (a -> b) -> a -> b
$ forall v. IsOption v => OptionSet -> v
Tasty.lookupOption OptionSet
opts
    , maxShrinks :: Maybe Word
maxShrinks    = MaxShrinks -> Maybe Word
getMaxShrinks forall a b. (a -> b) -> a -> b
$ forall v. IsOption v => OptionSet -> v
Tasty.lookupOption OptionSet
opts
    , replay :: Maybe ReplaySeed
replay        = Replay -> Maybe ReplaySeed
getReplay     forall a b. (a -> b) -> a -> b
$ forall v. IsOption v => OptionSet -> v
Tasty.lookupOption OptionSet
opts
    , maxRatio :: Word
maxRatio      = MaxRatio -> Word
getMaxRatio   forall a b. (a -> b) -> a -> b
$ forall v. IsOption v => OptionSet -> v
Tasty.lookupOption OptionSet
opts
    }