{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Falsify.Internal.Driver.Tasty (
testProperty
, 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
data Test = Test TestOptions (Property' String ())
data TestOptions = TestOptions {
TestOptions -> ExpectFailure
expectFailure :: ExpectFailure
, TestOptions -> Maybe Verbose
overrideVerbose :: Maybe Verbose
, TestOptions -> Maybe Word
overrideMaxShrinks :: Maybe Word
, TestOptions -> Maybe Word
overrideNumTests :: Maybe Word
, 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
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
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
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
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
}