{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | This module defines the 'IsTest' class and the different instances for it.
module Test.Syd.Run where

import Autodocodec
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Typeable
import Data.Word
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Generics (Generic)
import Test.QuickCheck
import Test.QuickCheck.Gen
import Test.QuickCheck.IO ()
import Test.QuickCheck.Property hiding (Result (..))
import qualified Test.QuickCheck.Property as QCP
import Test.QuickCheck.Random
import Text.Printf

class IsTest e where
  -- | The argument from 'aroundAll'
  type Arg1 e

  -- | The argument from 'around'
  type Arg2 e

  -- | Running the test, safely
  runTest ::
    e ->
    TestRunSettings ->
    ProgressReporter ->
    ((Arg1 e -> Arg2 e -> IO ()) -> IO ()) ->
    IO TestRunResult

instance IsTest Bool where
  type Arg1 Bool = ()
  type Arg2 Bool = ()
  runTest :: Bool
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 Bool -> Arg2 Bool -> IO ()) -> IO ())
-> IO TestRunResult
runTest Bool
func = (() -> () -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> () -> Bool) -> Arg2 (() -> () -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() () -> Bool
func)

instance IsTest (arg -> Bool) where
  type Arg1 (arg -> Bool) = ()
  type Arg2 (arg -> Bool) = arg
  runTest :: (arg -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (arg -> Bool) -> Arg2 (arg -> Bool) -> IO ()) -> IO ())
-> IO TestRunResult
runTest arg -> Bool
func = (() -> arg -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> arg -> Bool) -> Arg2 (() -> arg -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() arg
arg -> arg -> Bool
func arg
arg)

instance IsTest (outerArgs -> innerArg -> Bool) where
  type Arg1 (outerArgs -> innerArg -> Bool) = outerArgs
  type Arg2 (outerArgs -> innerArg -> Bool) = innerArg
  runTest :: (outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> Bool)
     -> Arg2 (outerArgs -> innerArg -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> Bool)
     -> Arg2 (outerArgs -> innerArg -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg.
(outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPureTestWithArg

runPureTestWithArg ::
  (outerArgs -> innerArg -> Bool) ->
  TestRunSettings ->
  ProgressReporter ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runPureTestWithArg :: (outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPureTestWithArg outerArgs -> innerArg -> Bool
computeBool TestRunSettings {} ProgressReporter
progressReporter (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  let report :: ProgressReporter
report = ProgressReporter -> ProgressReporter
reportProgress ProgressReporter
progressReporter
  let testRunResultNumTests :: Maybe a
testRunResultNumTests = Maybe a
forall a. Maybe a
Nothing
  let testRunResultRetries :: Maybe a
testRunResultRetries = Maybe a
forall a. Maybe a
Nothing
  ProgressReporter
report Progress
ProgressTestStarting
  Either SomeException Bool
resultBool <-
    ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO Bool)
-> IO (Either SomeException Bool)
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r) -> IO (Either SomeException r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO Bool)
 -> IO (Either SomeException Bool))
-> (outerArgs -> innerArg -> IO Bool)
-> IO (Either SomeException Bool)
forall a b. (a -> b) -> a -> b
$
      \outerArgs
outerArgs innerArg
innerArg -> Bool -> IO Bool
forall a. a -> IO a
evaluate (outerArgs -> innerArg -> Bool
computeBool outerArgs
outerArgs innerArg
innerArg)
  ProgressReporter
report Progress
ProgressTestDone
  let (TestStatus
testRunResultStatus, Maybe SomeException
testRunResultException) = case Either SomeException Bool
resultBool of
        Left SomeException
ex -> (TestStatus
TestFailed, SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex)
        Right Bool
bool -> (if Bool
bool then TestStatus
TestPassed else TestStatus
TestFailed, Maybe SomeException
forall a. Maybe a
Nothing)
  let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
  let testRunResultGoldenCase :: Maybe a
testRunResultGoldenCase = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
  let testRunResultExtraInfo :: Maybe a
testRunResultExtraInfo = Maybe a
forall a. Maybe a
Nothing
  let testRunResultLabels :: Maybe a
testRunResultLabels = Maybe a
forall a. Maybe a
Nothing
  let testRunResultClasses :: Maybe a
testRunResultClasses = Maybe a
forall a. Maybe a
Nothing
  let testRunResultTables :: Maybe a
testRunResultTables = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFlakinessMessage :: Maybe a
testRunResultFlakinessMessage = Maybe a
forall a. Maybe a
Nothing
  TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultExtraInfo :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultGoldenCase :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultException :: Maybe SomeException
testRunResultStatus :: TestStatus
testRunResultRetries :: forall a. Maybe a
testRunResultNumTests :: forall a. Maybe a
..}

applyWrapper2 ::
  forall r outerArgs innerArg.
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  (outerArgs -> innerArg -> IO r) ->
  IO (Either SomeException r)
applyWrapper2 :: ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r) -> IO (Either SomeException r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper outerArgs -> innerArg -> IO r
func = do
  MVar (Either SomeException r)
var <- IO (MVar (Either SomeException r))
-> IO (MVar (Either SomeException r))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar (Either SomeException r))
forall a. IO (MVar a)
newEmptyMVar
  Either SomeException ()
r <- (IO (Either SomeException ())
-> [Handler (Either SomeException ())]
-> IO (Either SomeException ())
forall a. IO a -> [Handler a] -> IO a
`catches` [Handler (Either SomeException ())]
forall a. [Handler (Either SomeException a)]
exceptionHandlers) (IO (Either SomeException ()) -> IO (Either SomeException ()))
-> IO (Either SomeException ()) -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
    (() -> Either SomeException ())
-> IO () -> IO (Either SomeException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either SomeException ()
forall a b. b -> Either a b
Right (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
      (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \outerArgs
outerArgs innerArg
innerArg -> do
        Either SomeException r
res <- (r -> Either SomeException r
forall a b. b -> Either a b
Right (r -> Either SomeException r)
-> IO r -> IO (Either SomeException r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (outerArgs -> innerArg -> IO r
func outerArgs
outerArgs innerArg
innerArg IO r -> (r -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> IO r
forall a. a -> IO a
evaluate)) IO (Either SomeException r)
-> [Handler (Either SomeException r)]
-> IO (Either SomeException r)
forall a. IO a -> [Handler a] -> IO a
`catches` [Handler (Either SomeException r)]
forall a. [Handler (Either SomeException a)]
exceptionHandlers
        IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar (Either SomeException r) -> Either SomeException r -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException r)
var Either SomeException r
res
  case Either SomeException ()
r of
    Right () -> IO (Either SomeException r) -> IO (Either SomeException r)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException r) -> IO (Either SomeException r))
-> IO (Either SomeException r) -> IO (Either SomeException r)
forall a b. (a -> b) -> a -> b
$ MVar (Either SomeException r) -> IO (Either SomeException r)
forall a. MVar a -> IO a
readMVar MVar (Either SomeException r)
var
    Left SomeException
e -> Either SomeException r -> IO (Either SomeException r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException -> Either SomeException r
forall a b. a -> Either a b
Left SomeException
e :: Either SomeException r)

instance IsTest (IO ()) where
  type Arg1 (IO ()) = ()
  type Arg2 (IO ()) = ()
  runTest :: IO ()
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (IO ()) -> Arg2 (IO ()) -> IO ()) -> IO ())
-> IO TestRunResult
runTest IO ()
func = (() -> () -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> () -> IO ()) -> Arg2 (() -> () -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() () -> IO ()
func)

instance IsTest (arg -> IO ()) where
  type Arg1 (arg -> IO ()) = ()
  type Arg2 (arg -> IO ()) = arg
  runTest :: (arg -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (arg -> IO ()) -> Arg2 (arg -> IO ()) -> IO ()) -> IO ())
-> IO TestRunResult
runTest arg -> IO ()
func = (() -> arg -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> arg -> IO ())
     -> Arg2 (() -> arg -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> arg -> IO ()
func)

instance IsTest (outerArgs -> innerArg -> IO ()) where
  type Arg1 (outerArgs -> innerArg -> IO ()) = outerArgs
  type Arg2 (outerArgs -> innerArg -> IO ()) = innerArg
  runTest :: (outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> IO ())
     -> Arg2 (outerArgs -> innerArg -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> IO ())
     -> Arg2 (outerArgs -> innerArg -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg.
(outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runIOTestWithArg

instance IsTest (ReaderT env IO ()) where
  type Arg1 (ReaderT env IO ()) = ()
  type Arg2 (ReaderT env IO ()) = env
  runTest :: ReaderT env IO ()
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (ReaderT env IO ()) -> Arg2 (ReaderT env IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest ReaderT env IO ()
func = (() -> ReaderT env IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> ReaderT env IO ())
     -> Arg2 (() -> ReaderT env IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> ReaderT env IO ()
func)

instance IsTest (outerArgs -> ReaderT env IO ()) where
  type Arg1 (outerArgs -> ReaderT env IO ()) = outerArgs
  type Arg2 (outerArgs -> ReaderT env IO ()) = env
  runTest :: (outerArgs -> ReaderT env IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> ReaderT env IO ())
     -> Arg2 (outerArgs -> ReaderT env IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest outerArgs -> ReaderT env IO ()
func = (outerArgs -> env -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> env -> IO ())
     -> Arg2 (outerArgs -> env -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\outerArgs
outerArgs env
env -> ReaderT env IO () -> env -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (outerArgs -> ReaderT env IO ()
func outerArgs
outerArgs) env
env)

runIOTestWithArg ::
  (outerArgs -> innerArg -> IO ()) ->
  TestRunSettings ->
  ProgressReporter ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runIOTestWithArg :: (outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runIOTestWithArg outerArgs -> innerArg -> IO ()
func TestRunSettings {} ProgressReporter
progressReporter (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  let report :: ProgressReporter
report = ProgressReporter -> ProgressReporter
reportProgress ProgressReporter
progressReporter

  let testRunResultNumTests :: Maybe a
testRunResultNumTests = Maybe a
forall a. Maybe a
Nothing
  let testRunResultRetries :: Maybe a
testRunResultRetries = Maybe a
forall a. Maybe a
Nothing

  ProgressReporter
report Progress
ProgressTestStarting
  Either SomeException ()
result <- IO (Either SomeException ()) -> IO (Either SomeException ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException ()) -> IO (Either SomeException ()))
-> IO (Either SomeException ()) -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
    ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO ()) -> IO (Either SomeException ())
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r) -> IO (Either SomeException r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO ()) -> IO (Either SomeException ()))
-> (outerArgs -> innerArg -> IO ()) -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
      \outerArgs
outerArgs innerArg
innerArg ->
        outerArgs -> innerArg -> IO ()
func outerArgs
outerArgs innerArg
innerArg IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= () -> IO ()
forall a. a -> IO a
evaluate
  ProgressReporter
report Progress
ProgressTestDone

  let (TestStatus
testRunResultStatus, Maybe SomeException
testRunResultException) = case Either SomeException ()
result of
        Left SomeException
ex -> (TestStatus
TestFailed, SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex)
        Right () -> (TestStatus
TestPassed, Maybe SomeException
forall a. Maybe a
Nothing)
  let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
  let testRunResultGoldenCase :: Maybe a
testRunResultGoldenCase = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
  let testRunResultExtraInfo :: Maybe a
testRunResultExtraInfo = Maybe a
forall a. Maybe a
Nothing
  let testRunResultLabels :: Maybe a
testRunResultLabels = Maybe a
forall a. Maybe a
Nothing
  let testRunResultClasses :: Maybe a
testRunResultClasses = Maybe a
forall a. Maybe a
Nothing
  let testRunResultTables :: Maybe a
testRunResultTables = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFlakinessMessage :: Maybe a
testRunResultFlakinessMessage = Maybe a
forall a. Maybe a
Nothing
  TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultExtraInfo :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultGoldenCase :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultException :: Maybe SomeException
testRunResultStatus :: TestStatus
testRunResultRetries :: forall a. Maybe a
testRunResultNumTests :: forall a. Maybe a
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..}

instance IsTest Property where
  type Arg1 Property = ()
  type Arg2 Property = ()
  runTest :: Property
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 Property -> Arg2 Property -> IO ()) -> IO ())
-> IO TestRunResult
runTest Property
func = (() -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> Property) -> Arg2 (() -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> Property
func)

instance IsTest (arg -> Property) where
  type Arg1 (arg -> Property) = ()
  type Arg2 (arg -> Property) = arg
  runTest :: (arg -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (arg -> Property) -> Arg2 (arg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest arg -> Property
func = (() -> arg -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> arg -> Property)
     -> Arg2 (() -> arg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> arg -> Property
func)

instance IsTest (outerArgs -> innerArg -> Property) where
  type Arg1 (outerArgs -> innerArg -> Property) = outerArgs
  type Arg2 (outerArgs -> innerArg -> Property) = innerArg
  runTest :: (outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> Property)
     -> Arg2 (outerArgs -> innerArg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> Property)
     -> Arg2 (outerArgs -> innerArg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg.
(outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPropertyTestWithArg

makeQuickCheckArgs :: TestRunSettings -> Args
makeQuickCheckArgs :: TestRunSettings -> Args
makeQuickCheckArgs TestRunSettings {Bool
Int
SeedSetting
testRunSettingGoldenReset :: TestRunSettings -> Bool
testRunSettingGoldenStart :: TestRunSettings -> Bool
testRunSettingMaxShrinks :: TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: TestRunSettings -> Int
testRunSettingMaxSize :: TestRunSettings -> Int
testRunSettingMaxSuccess :: TestRunSettings -> Int
testRunSettingSeed :: TestRunSettings -> SeedSetting
testRunSettingGoldenReset :: Bool
testRunSettingGoldenStart :: Bool
testRunSettingMaxShrinks :: Int
testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxSize :: Int
testRunSettingMaxSuccess :: Int
testRunSettingSeed :: SeedSetting
..} =
  Args
stdArgs
    { replay :: Maybe (QCGen, Int)
replay = case SeedSetting
testRunSettingSeed of
        SeedSetting
RandomSeed -> Maybe (QCGen, Int)
forall a. Maybe a
Nothing
        FixedSeed Int
s -> (QCGen, Int) -> Maybe (QCGen, Int)
forall a. a -> Maybe a
Just (Int -> QCGen
mkQCGen Int
s, Int
0),
      chatty :: Bool
chatty = Bool
False,
      maxSuccess :: Int
maxSuccess = Int
testRunSettingMaxSuccess,
      maxDiscardRatio :: Int
maxDiscardRatio = Int
testRunSettingMaxDiscardRatio,
      maxSize :: Int
maxSize = Int
testRunSettingMaxSize,
      maxShrinks :: Int
maxShrinks = Int
testRunSettingMaxShrinks
    }

runPropertyTestWithArg ::
  forall outerArgs innerArg.
  (outerArgs -> innerArg -> Property) ->
  TestRunSettings ->
  ProgressReporter ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runPropertyTestWithArg :: (outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPropertyTestWithArg outerArgs -> innerArg -> Property
p TestRunSettings
trs ProgressReporter
progressReporter (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  let report :: ProgressReporter
report = ProgressReporter -> ProgressReporter
reportProgress ProgressReporter
progressReporter
  let qcargs :: Args
qcargs = TestRunSettings -> Args
makeQuickCheckArgs TestRunSettings
trs

  TVar Word
exampleCounter <- Word -> IO (TVar Word)
forall a. a -> IO (TVar a)
newTVarIO Word
1
  let totalExamples :: Word
totalExamples = (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word) (Args -> Int
maxSuccess Args
qcargs)
  let wrapperWithProgress :: (outerArgs -> innerArg -> IO ()) -> IO ()
      wrapperWithProgress :: (outerArgs -> innerArg -> IO ()) -> IO ()
wrapperWithProgress outerArgs -> innerArg -> IO ()
func = (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \outerArgs
outers innerArg
inner -> do
        Word
exampleNr <- TVar Word -> IO Word
forall a. TVar a -> IO a
readTVarIO TVar Word
exampleCounter
        ProgressReporter
report ProgressReporter -> ProgressReporter
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Progress
ProgressExampleStarting Word
totalExamples Word
exampleNr
        Timed ()
timedResult <- IO () -> IO (Timed ())
forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT (IO () -> IO (Timed ())) -> IO () -> IO (Timed ())
forall a b. (a -> b) -> a -> b
$ outerArgs -> innerArg -> IO ()
func outerArgs
outers innerArg
inner
        ProgressReporter
report ProgressReporter -> ProgressReporter
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word64 -> Progress
ProgressExampleDone Word
totalExamples Word
exampleNr (Word64 -> Progress) -> Word64 -> Progress
forall a b. (a -> b) -> a -> b
$ Timed () -> Word64
forall a. Timed a -> Word64
timedTime Timed ()
timedResult
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Word -> (Word -> Word) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Word
exampleCounter Word -> Word
forall a. Enum a => a -> a
succ
        () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Timed () -> ()
forall a. Timed a -> a
timedValue Timed ()
timedResult

  ProgressReporter
report Progress
ProgressTestStarting
  Result
qcr <- Args -> Property -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
qcargs (((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> Property) -> Property
forall a b.
((a -> b -> IO ()) -> IO ()) -> (a -> b -> Property) -> Property
aroundProperty (outerArgs -> innerArg -> IO ()) -> IO ()
wrapperWithProgress outerArgs -> innerArg -> Property
p)
  ProgressReporter
report Progress
ProgressTestDone

  let testRunResultGoldenCase :: Maybe a
testRunResultGoldenCase = Maybe a
forall a. Maybe a
Nothing
  let testRunResultNumTests :: Maybe Word
testRunResultNumTests = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Result -> Int
numTests Result
qcr
  let testRunResultRetries :: Maybe a
testRunResultRetries = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFlakinessMessage :: Maybe a
testRunResultFlakinessMessage = Maybe a
forall a. Maybe a
Nothing
  case Result
qcr of
    Success {} -> do
      let testRunResultStatus :: TestStatus
testRunResultStatus = TestStatus
TestPassed
      let testRunResultException :: Maybe a
testRunResultException = Maybe a
forall a. Maybe a
Nothing
      let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
      let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
      let testRunResultExtraInfo :: Maybe a
testRunResultExtraInfo = Maybe a
forall a. Maybe a
Nothing
      let testRunResultLabels :: Maybe (Map [String] Int)
testRunResultLabels = Map [String] Int -> Maybe (Map [String] Int)
forall a. a -> Maybe a
Just (Map [String] Int -> Maybe (Map [String] Int))
-> Map [String] Int -> Maybe (Map [String] Int)
forall a b. (a -> b) -> a -> b
$ Result -> Map [String] Int
labels Result
qcr
      let testRunResultClasses :: Maybe (Map String Int)
testRunResultClasses = Map String Int -> Maybe (Map String Int)
forall a. a -> Maybe a
Just (Map String Int -> Maybe (Map String Int))
-> Map String Int -> Maybe (Map String Int)
forall a b. (a -> b) -> a -> b
$ Result -> Map String Int
classes Result
qcr
      let testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultTables = Map String (Map String Int) -> Maybe (Map String (Map String Int))
forall a. a -> Maybe a
Just (Map String (Map String Int)
 -> Maybe (Map String (Map String Int)))
-> Map String (Map String Int)
-> Maybe (Map String (Map String Int))
forall a b. (a -> b) -> a -> b
$ Result -> Map String (Map String Int)
tables Result
qcr
      TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultExtraInfo :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultNumShrinks :: forall a. Maybe a
testRunResultException :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultRetries :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..}
    GaveUp {} -> do
      let testRunResultStatus :: TestStatus
testRunResultStatus = TestStatus
TestFailed
      let testRunResultException :: Maybe a
testRunResultException = Maybe a
forall a. Maybe a
Nothing
      let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
      let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
      let testRunResultExtraInfo :: Maybe String
testRunResultExtraInfo = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Gave up, %d discarded tests" (Result -> Int
numDiscarded Result
qcr)
      let testRunResultLabels :: Maybe (Map [String] Int)
testRunResultLabels = Map [String] Int -> Maybe (Map [String] Int)
forall a. a -> Maybe a
Just (Map [String] Int -> Maybe (Map [String] Int))
-> Map [String] Int -> Maybe (Map [String] Int)
forall a b. (a -> b) -> a -> b
$ Result -> Map [String] Int
labels Result
qcr
      let testRunResultClasses :: Maybe (Map String Int)
testRunResultClasses = Map String Int -> Maybe (Map String Int)
forall a. a -> Maybe a
Just (Map String Int -> Maybe (Map String Int))
-> Map String Int -> Maybe (Map String Int)
forall a b. (a -> b) -> a -> b
$ Result -> Map String Int
classes Result
qcr
      let testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultTables = Map String (Map String Int) -> Maybe (Map String (Map String Int))
forall a. a -> Maybe a
Just (Map String (Map String Int)
 -> Maybe (Map String (Map String Int)))
-> Map String (Map String Int)
-> Maybe (Map String (Map String Int))
forall a b. (a -> b) -> a -> b
$ Result -> Map String (Map String Int)
tables Result
qcr
      TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultExtraInfo :: Maybe String
testRunResultFailingInputs :: forall a. [a]
testRunResultNumShrinks :: forall a. Maybe a
testRunResultException :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultRetries :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..}
    Failure {} -> do
      let testRunResultStatus :: TestStatus
testRunResultStatus = TestStatus
TestFailed
      let testRunResultException :: Maybe SomeException
testRunResultException = do
            SomeException
se <- Result -> Maybe SomeException
theException Result
qcr
            SomeException -> Maybe SomeException
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException
se :: SomeException)
      let testRunResultNumShrinks :: Maybe Word
testRunResultNumShrinks = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Result -> Int
numShrinks Result
qcr
      let testRunResultFailingInputs :: [String]
testRunResultFailingInputs = Result -> [String]
failingTestCase Result
qcr
      let testRunResultExtraInfo :: Maybe a
testRunResultExtraInfo = Maybe a
forall a. Maybe a
Nothing
      let testRunResultLabels :: Maybe (Map [String] Int)
testRunResultLabels = Map [String] Int -> Maybe (Map [String] Int)
forall a. a -> Maybe a
Just (Map [String] Int -> Maybe (Map [String] Int))
-> Map [String] Int -> Maybe (Map [String] Int)
forall a b. (a -> b) -> a -> b
$ [String] -> Int -> Map [String] Int
forall k a. k -> a -> Map k a
M.singleton (Result -> [String]
failingLabels Result
qcr) Int
1
      let testRunResultClasses :: Maybe (Map String Int)
testRunResultClasses = Map String Int -> Maybe (Map String Int)
forall a. a -> Maybe a
Just (Map String Int -> Maybe (Map String Int))
-> Map String Int -> Maybe (Map String Int)
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> Set String -> Map String Int
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (Int -> String -> Int
forall a b. a -> b -> a
const Int
1) (Result -> Set String
failingClasses Result
qcr)
      let testRunResultTables :: Maybe a
testRunResultTables = Maybe a
forall a. Maybe a
Nothing
      TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. Maybe a
testRunResultTables :: forall a. Maybe a
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultExtraInfo :: forall a. Maybe a
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultRetries :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..}
    NoExpectedFailure {} -> do
      let testRunResultStatus :: TestStatus
testRunResultStatus = TestStatus
TestFailed
      let testRunResultException :: Maybe a
testRunResultException = Maybe a
forall a. Maybe a
Nothing
      let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
      let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
      let testRunResultLabels :: Maybe (Map [String] Int)
testRunResultLabels = Map [String] Int -> Maybe (Map [String] Int)
forall a. a -> Maybe a
Just (Map [String] Int -> Maybe (Map [String] Int))
-> Map [String] Int -> Maybe (Map [String] Int)
forall a b. (a -> b) -> a -> b
$ Result -> Map [String] Int
labels Result
qcr
      let testRunResultClasses :: Maybe (Map String Int)
testRunResultClasses = Map String Int -> Maybe (Map String Int)
forall a. a -> Maybe a
Just (Map String Int -> Maybe (Map String Int))
-> Map String Int -> Maybe (Map String Int)
forall a b. (a -> b) -> a -> b
$ Result -> Map String Int
classes Result
qcr
      let testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultTables = Map String (Map String Int) -> Maybe (Map String (Map String Int))
forall a. a -> Maybe a
Just (Map String (Map String Int)
 -> Maybe (Map String (Map String Int)))
-> Map String (Map String Int)
-> Maybe (Map String (Map String Int))
forall a b. (a -> b) -> a -> b
$ Result -> Map String (Map String Int)
tables Result
qcr
      let testRunResultExtraInfo :: Maybe String
testRunResultExtraInfo = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
forall r. PrintfType r => String -> r
printf String
"Expected the property to fail but it didn't."
      TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultExtraInfo :: Maybe String
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: forall a. [a]
testRunResultNumShrinks :: forall a. Maybe a
testRunResultException :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultRetries :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..}

aroundProperty :: ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Property) -> Property
aroundProperty :: ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Property) -> Property
aroundProperty (a -> b -> IO ()) -> IO ()
action a -> b -> Property
p = Gen Prop -> Property
MkProperty (Gen Prop -> Property)
-> ((QCGen -> Int -> Prop) -> Gen Prop)
-> (QCGen -> Int -> Prop)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QCGen -> Int -> Prop) -> Gen Prop
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Prop) -> Property)
-> (QCGen -> Int -> Prop) -> Property
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Prop) -> Prop
forall a b.
((a -> b -> IO ()) -> IO ()) -> (a -> b -> Prop) -> Prop
aroundProp (a -> b -> IO ()) -> IO ()
action ((a -> b -> Prop) -> Prop) -> (a -> b -> Prop) -> Prop
forall a b. (a -> b) -> a -> b
$ \a
a b
b -> (Gen Prop -> QCGen -> Int -> Prop
forall a. Gen a -> QCGen -> Int -> a
unGen (Gen Prop -> QCGen -> Int -> Prop)
-> (Property -> Gen Prop) -> Property -> QCGen -> Int -> Prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Gen Prop
unProperty (Property -> QCGen -> Int -> Prop)
-> Property -> QCGen -> Int -> Prop
forall a b. (a -> b) -> a -> b
$ a -> b -> Property
p a
a b
b) QCGen
r Int
n

aroundProp :: ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Prop) -> Prop
aroundProp :: ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Prop) -> Prop
aroundProp (a -> b -> IO ()) -> IO ()
action a -> b -> Prop
p = Rose Result -> Prop
MkProp (Rose Result -> Prop) -> Rose Result -> Prop
forall a b. (a -> b) -> a -> b
$ ((a -> b -> IO ()) -> IO ())
-> (a -> b -> Rose Result) -> Rose Result
forall a b.
((a -> b -> IO ()) -> IO ())
-> (a -> b -> Rose Result) -> Rose Result
aroundRose (a -> b -> IO ()) -> IO ()
action (\a
a b
b -> Prop -> Rose Result
unProp (Prop -> Rose Result) -> Prop -> Rose Result
forall a b. (a -> b) -> a -> b
$ a -> b -> Prop
p a
a b
b)

aroundRose :: ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Rose QCP.Result) -> Rose QCP.Result
aroundRose :: ((a -> b -> IO ()) -> IO ())
-> (a -> b -> Rose Result) -> Rose Result
aroundRose (a -> b -> IO ()) -> IO ()
action a -> b -> Rose Result
r = IO (Rose Result) -> Rose Result
ioRose (IO (Rose Result) -> Rose Result)
-> IO (Rose Result) -> Rose Result
forall a b. (a -> b) -> a -> b
$ do
  IORef (Rose Result)
ref <- Rose Result -> IO (IORef (Rose Result))
forall a. a -> IO (IORef a)
newIORef (Result -> Rose Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
QCP.succeeded)
  (a -> b -> IO ()) -> IO ()
action ((a -> b -> IO ()) -> IO ()) -> (a -> b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a
a b
b -> Rose Result -> IO (Rose Result)
reduceRose (a -> b -> Rose Result
r a
a b
b) IO (Rose Result) -> (Rose Result -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef (Rose Result) -> Rose Result -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Rose Result)
ref
  IORef (Rose Result) -> IO (Rose Result)
forall a. IORef a -> IO a
readIORef IORef (Rose Result)
ref

-- | A golden test for output of type @a@.
--
-- The purpose of a golden test is to ensure that the output of a certain
-- process does not change even over time.
--
-- Golden tests can also be used to show how the output of a certain process
-- changes over time and force code reviewers to review the diff that they see
-- in the PR.
--
-- This works by saving a 'golden' output in the repository somewhere,
-- committing it, and then compare that golden output to the output that is
-- currently being produced. You can use `--golden-reset` to have sydtest
-- update the golden output by writing the current output.
data GoldenTest a = GoldenTest
  { -- | Read the golden test output, 'Nothing' if there is no golden output yet.
    GoldenTest a -> IO (Maybe a)
goldenTestRead :: IO (Maybe a),
    -- | Produce the current output
    GoldenTest a -> IO a
goldenTestProduce :: IO a,
    -- | Write golden output
    GoldenTest a -> a -> IO ()
goldenTestWrite :: a -> IO (),
    -- | Compare golden output with current output
    --
    -- The first argument is the current output, the second is the golden output
    GoldenTest a -> a -> a -> Maybe Assertion
goldenTestCompare :: a -> a -> Maybe Assertion
  }

instance IsTest (GoldenTest a) where
  type Arg1 (GoldenTest a) = ()
  type Arg2 (GoldenTest a) = ()
  runTest :: GoldenTest a
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (GoldenTest a) -> Arg2 (GoldenTest a) -> IO ()) -> IO ())
-> IO TestRunResult
runTest GoldenTest a
gt = (() -> () -> GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> () -> GoldenTest a)
     -> Arg2 (() -> () -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() () -> GoldenTest a
gt)

instance IsTest (arg -> GoldenTest a) where
  type Arg1 (arg -> GoldenTest a) = ()
  type Arg2 (arg -> GoldenTest a) = arg
  runTest :: (arg -> GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (arg -> GoldenTest a)
     -> Arg2 (arg -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest arg -> GoldenTest a
gt = (() -> arg -> GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> arg -> GoldenTest a)
     -> Arg2 (() -> arg -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> arg -> GoldenTest a
gt)

instance IsTest (outerArgs -> innerArg -> GoldenTest a) where
  type Arg1 (outerArgs -> innerArg -> GoldenTest a) = outerArgs
  type Arg2 (outerArgs -> innerArg -> GoldenTest a) = innerArg
  runTest :: (outerArgs -> innerArg -> GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> GoldenTest a)
     -> Arg2 (outerArgs -> innerArg -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest outerArgs -> innerArg -> GoldenTest a
func = (outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> IO (GoldenTest a))
     -> Arg2 (outerArgs -> innerArg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\outerArgs
outerArgs innerArg
innerArg -> GoldenTest a -> IO (GoldenTest a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (outerArgs -> innerArg -> GoldenTest a
func outerArgs
outerArgs innerArg
innerArg) :: IO (GoldenTest a))

instance IsTest (IO (GoldenTest a)) where
  type Arg1 (IO (GoldenTest a)) = ()
  type Arg2 (IO (GoldenTest a)) = ()
  runTest :: IO (GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (IO (GoldenTest a)) -> Arg2 (IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest IO (GoldenTest a)
func = (() -> () -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> () -> IO (GoldenTest a))
     -> Arg2 (() -> () -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() () -> IO (GoldenTest a)
func)

instance IsTest (arg -> IO (GoldenTest a)) where
  type Arg1 (arg -> IO (GoldenTest a)) = ()
  type Arg2 (arg -> IO (GoldenTest a)) = arg
  runTest :: (arg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (arg -> IO (GoldenTest a))
     -> Arg2 (arg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest arg -> IO (GoldenTest a)
func = (() -> arg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> arg -> IO (GoldenTest a))
     -> Arg2 (() -> arg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> arg -> IO (GoldenTest a)
func)

instance IsTest (outerArgs -> innerArg -> IO (GoldenTest a)) where
  type Arg1 (outerArgs -> innerArg -> IO (GoldenTest a)) = outerArgs
  type Arg2 (outerArgs -> innerArg -> IO (GoldenTest a)) = innerArg
  runTest :: (outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> IO (GoldenTest a))
     -> Arg2 (outerArgs -> innerArg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> innerArg -> IO (GoldenTest a))
     -> Arg2 (outerArgs -> innerArg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg a.
(outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runGoldenTestWithArg

runGoldenTestWithArg ::
  (outerArgs -> innerArg -> IO (GoldenTest a)) ->
  TestRunSettings ->
  ProgressReporter ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runGoldenTestWithArg :: (outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runGoldenTestWithArg outerArgs -> innerArg -> IO (GoldenTest a)
createGolden TestRunSettings {Bool
Int
SeedSetting
testRunSettingGoldenReset :: Bool
testRunSettingGoldenStart :: Bool
testRunSettingMaxShrinks :: Int
testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxSize :: Int
testRunSettingMaxSuccess :: Int
testRunSettingSeed :: SeedSetting
testRunSettingGoldenReset :: TestRunSettings -> Bool
testRunSettingGoldenStart :: TestRunSettings -> Bool
testRunSettingMaxShrinks :: TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: TestRunSettings -> Int
testRunSettingMaxSize :: TestRunSettings -> Int
testRunSettingMaxSuccess :: TestRunSettings -> Int
testRunSettingSeed :: TestRunSettings -> SeedSetting
..} ProgressReporter
_ (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  Either
  SomeException (TestStatus, Maybe GoldenCase, Maybe SomeException)
errOrTrip <- ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs
    -> innerArg
    -> IO (TestStatus, Maybe GoldenCase, Maybe SomeException))
-> IO
     (Either
        SomeException (TestStatus, Maybe GoldenCase, Maybe SomeException))
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r) -> IO (Either SomeException r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs
  -> innerArg
  -> IO (TestStatus, Maybe GoldenCase, Maybe SomeException))
 -> IO
      (Either
         SomeException (TestStatus, Maybe GoldenCase, Maybe SomeException)))
-> (outerArgs
    -> innerArg
    -> IO (TestStatus, Maybe GoldenCase, Maybe SomeException))
-> IO
     (Either
        SomeException (TestStatus, Maybe GoldenCase, Maybe SomeException))
forall a b. (a -> b) -> a -> b
$ \outerArgs
outerArgs innerArg
innerArgs -> do
    GoldenTest {IO a
IO (Maybe a)
a -> IO ()
a -> a -> Maybe Assertion
goldenTestCompare :: a -> a -> Maybe Assertion
goldenTestWrite :: a -> IO ()
goldenTestProduce :: IO a
goldenTestRead :: IO (Maybe a)
goldenTestCompare :: forall a. GoldenTest a -> a -> a -> Maybe Assertion
goldenTestWrite :: forall a. GoldenTest a -> a -> IO ()
goldenTestProduce :: forall a. GoldenTest a -> IO a
goldenTestRead :: forall a. GoldenTest a -> IO (Maybe a)
..} <- outerArgs -> innerArg -> IO (GoldenTest a)
createGolden outerArgs
outerArgs innerArg
innerArgs
    Maybe a
mGolden <- IO (Maybe a)
goldenTestRead
    case Maybe a
mGolden of
      Maybe a
Nothing ->
        if Bool
testRunSettingGoldenStart
          then do
            a
actual <- IO a
goldenTestProduce IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate
            a -> IO ()
goldenTestWrite a
actual
            (TestStatus, Maybe GoldenCase, Maybe SomeException)
-> IO (TestStatus, Maybe GoldenCase, Maybe SomeException)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, GoldenCase -> Maybe GoldenCase
forall a. a -> Maybe a
Just GoldenCase
GoldenStarted, Maybe SomeException
forall a. Maybe a
Nothing)
          else (TestStatus, Maybe GoldenCase, Maybe SomeException)
-> IO (TestStatus, Maybe GoldenCase, Maybe SomeException)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestFailed, GoldenCase -> Maybe GoldenCase
forall a. a -> Maybe a
Just GoldenCase
GoldenNotFound, Maybe SomeException
forall a. Maybe a
Nothing)
      Just a
golden -> do
        a
actual <- IO a
goldenTestProduce IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate
        case a -> a -> Maybe Assertion
goldenTestCompare a
actual a
golden of
          Maybe Assertion
Nothing -> (TestStatus, Maybe GoldenCase, Maybe SomeException)
-> IO (TestStatus, Maybe GoldenCase, Maybe SomeException)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, Maybe GoldenCase
forall a. Maybe a
Nothing, Maybe SomeException
forall a. Maybe a
Nothing)
          Just Assertion
assertion ->
            if Bool
testRunSettingGoldenReset
              then do
                a -> IO ()
goldenTestWrite a
actual
                (TestStatus, Maybe GoldenCase, Maybe SomeException)
-> IO (TestStatus, Maybe GoldenCase, Maybe SomeException)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, GoldenCase -> Maybe GoldenCase
forall a. a -> Maybe a
Just GoldenCase
GoldenReset, Maybe SomeException
forall a. Maybe a
Nothing)
              else (TestStatus, Maybe GoldenCase, Maybe SomeException)
-> IO (TestStatus, Maybe GoldenCase, Maybe SomeException)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestFailed, Maybe GoldenCase
forall a. Maybe a
Nothing, SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (SomeException -> Maybe SomeException)
-> SomeException -> Maybe SomeException
forall a b. (a -> b) -> a -> b
$ Assertion -> SomeException
forall e. Exception e => e -> SomeException
SomeException Assertion
assertion)
  let (TestStatus
testRunResultStatus, Maybe GoldenCase
testRunResultGoldenCase, Maybe SomeException
testRunResultException) = case Either
  SomeException (TestStatus, Maybe GoldenCase, Maybe SomeException)
errOrTrip of
        Left SomeException
e -> (TestStatus
TestFailed, Maybe GoldenCase
forall a. Maybe a
Nothing, SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e)
        Right (TestStatus, Maybe GoldenCase, Maybe SomeException)
trip -> (TestStatus, Maybe GoldenCase, Maybe SomeException)
trip
  let testRunResultRetries :: Maybe a
testRunResultRetries = Maybe a
forall a. Maybe a
Nothing
  let testRunResultNumTests :: Maybe a
testRunResultNumTests = Maybe a
forall a. Maybe a
Nothing
  let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
  let testRunResultExtraInfo :: Maybe a
testRunResultExtraInfo = Maybe a
forall a. Maybe a
Nothing
  let testRunResultLabels :: Maybe a
testRunResultLabels = Maybe a
forall a. Maybe a
Nothing
  let testRunResultClasses :: Maybe a
testRunResultClasses = Maybe a
forall a. Maybe a
Nothing
  let testRunResultTables :: Maybe a
testRunResultTables = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFlakinessMessage :: Maybe a
testRunResultFlakinessMessage = Maybe a
forall a. Maybe a
Nothing
  TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe Int
-> Maybe SomeException
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultFlakinessMessage :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultExtraInfo :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultNumShrinks :: forall a. Maybe a
testRunResultNumTests :: forall a. Maybe a
testRunResultRetries :: forall a. Maybe a
testRunResultException :: Maybe SomeException
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..}

exceptionHandlers :: [Handler (Either SomeException a)]
exceptionHandlers :: [Handler (Either SomeException a)]
exceptionHandlers =
  [ -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT (ctrl-c).
    (AsyncException -> IO (Either SomeException a))
-> Handler (Either SomeException a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\AsyncException
e -> AsyncException -> IO (Either SomeException a)
forall e a. Exception e => e -> IO a
throwIO (AsyncException
e :: AsyncException)),
    -- Catch all the rest
    (SomeException -> IO (Either SomeException a))
-> Handler (Either SomeException a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\SomeException
e -> Either SomeException a -> IO (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> IO (Either SomeException a))
-> Either SomeException a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException
e :: SomeException))
  ]

type Test = IO ()

data TestRunSettings = TestRunSettings
  { TestRunSettings -> SeedSetting
testRunSettingSeed :: !SeedSetting,
    TestRunSettings -> Int
testRunSettingMaxSuccess :: !Int,
    TestRunSettings -> Int
testRunSettingMaxSize :: !Int,
    TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: !Int,
    TestRunSettings -> Int
testRunSettingMaxShrinks :: !Int,
    TestRunSettings -> Bool
testRunSettingGoldenStart :: !Bool,
    TestRunSettings -> Bool
testRunSettingGoldenReset :: !Bool
  }
  deriving (Int -> TestRunSettings -> String -> String
[TestRunSettings] -> String -> String
TestRunSettings -> String
(Int -> TestRunSettings -> String -> String)
-> (TestRunSettings -> String)
-> ([TestRunSettings] -> String -> String)
-> Show TestRunSettings
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestRunSettings] -> String -> String
$cshowList :: [TestRunSettings] -> String -> String
show :: TestRunSettings -> String
$cshow :: TestRunSettings -> String
showsPrec :: Int -> TestRunSettings -> String -> String
$cshowsPrec :: Int -> TestRunSettings -> String -> String
Show, TestRunSettings -> TestRunSettings -> Bool
(TestRunSettings -> TestRunSettings -> Bool)
-> (TestRunSettings -> TestRunSettings -> Bool)
-> Eq TestRunSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestRunSettings -> TestRunSettings -> Bool
$c/= :: TestRunSettings -> TestRunSettings -> Bool
== :: TestRunSettings -> TestRunSettings -> Bool
$c== :: TestRunSettings -> TestRunSettings -> Bool
Eq, (forall x. TestRunSettings -> Rep TestRunSettings x)
-> (forall x. Rep TestRunSettings x -> TestRunSettings)
-> Generic TestRunSettings
forall x. Rep TestRunSettings x -> TestRunSettings
forall x. TestRunSettings -> Rep TestRunSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestRunSettings x -> TestRunSettings
$cfrom :: forall x. TestRunSettings -> Rep TestRunSettings x
Generic)

defaultTestRunSettings :: TestRunSettings
defaultTestRunSettings :: TestRunSettings
defaultTestRunSettings =
  TestRunSettings :: SeedSetting
-> Int -> Int -> Int -> Int -> Bool -> Bool -> TestRunSettings
TestRunSettings
    { testRunSettingSeed :: SeedSetting
testRunSettingSeed = Int -> SeedSetting
FixedSeed Int
42, -- This is set by default because we want reproducability by default.
      testRunSettingMaxSuccess :: Int
testRunSettingMaxSuccess = Args -> Int
maxSuccess Args
stdArgs,
      testRunSettingMaxSize :: Int
testRunSettingMaxSize = Args -> Int
maxSize Args
stdArgs,
      testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxDiscardRatio = Args -> Int
maxDiscardRatio Args
stdArgs,
      testRunSettingMaxShrinks :: Int
testRunSettingMaxShrinks = Int
100, -- This is different from what quickcheck does so that test suites are more likely to finish
      testRunSettingGoldenStart :: Bool
testRunSettingGoldenStart = Bool
True,
      testRunSettingGoldenReset :: Bool
testRunSettingGoldenReset = Bool
False
    }

data SeedSetting
  = RandomSeed
  | FixedSeed !Int
  deriving (Int -> SeedSetting -> String -> String
[SeedSetting] -> String -> String
SeedSetting -> String
(Int -> SeedSetting -> String -> String)
-> (SeedSetting -> String)
-> ([SeedSetting] -> String -> String)
-> Show SeedSetting
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SeedSetting] -> String -> String
$cshowList :: [SeedSetting] -> String -> String
show :: SeedSetting -> String
$cshow :: SeedSetting -> String
showsPrec :: Int -> SeedSetting -> String -> String
$cshowsPrec :: Int -> SeedSetting -> String -> String
Show, SeedSetting -> SeedSetting -> Bool
(SeedSetting -> SeedSetting -> Bool)
-> (SeedSetting -> SeedSetting -> Bool) -> Eq SeedSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeedSetting -> SeedSetting -> Bool
$c/= :: SeedSetting -> SeedSetting -> Bool
== :: SeedSetting -> SeedSetting -> Bool
$c== :: SeedSetting -> SeedSetting -> Bool
Eq, (forall x. SeedSetting -> Rep SeedSetting x)
-> (forall x. Rep SeedSetting x -> SeedSetting)
-> Generic SeedSetting
forall x. Rep SeedSetting x -> SeedSetting
forall x. SeedSetting -> Rep SeedSetting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeedSetting x -> SeedSetting
$cfrom :: forall x. SeedSetting -> Rep SeedSetting x
Generic)

instance HasCodec SeedSetting where
  codec :: JSONCodec SeedSetting
codec = (Either Text Int -> SeedSetting)
-> (SeedSetting -> Either Text Int)
-> Codec Value (Either Text Int) (Either Text Int)
-> JSONCodec SeedSetting
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either Text Int -> SeedSetting
forall a. Either a Int -> SeedSetting
f SeedSetting -> Either Text Int
g (Codec Value (Either Text Int) (Either Text Int)
 -> JSONCodec SeedSetting)
-> Codec Value (Either Text Int) (Either Text Int)
-> JSONCodec SeedSetting
forall a b. (a -> b) -> a -> b
$ Codec Value Text Text
-> Codec Value Int Int
-> Codec Value (Either Text Int) (Either Text Int)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> Codec Value Text Text
literalTextCodec Text
"random") Codec Value Int Int
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: Either a Int -> SeedSetting
f = \case
        Left a
_ -> SeedSetting
RandomSeed
        Right Int
i -> Int -> SeedSetting
FixedSeed Int
i
      g :: SeedSetting -> Either Text Int
g = \case
        SeedSetting
RandomSeed -> Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"random"
        FixedSeed Int
i -> Int -> Either Text Int
forall a b. b -> Either a b
Right Int
i

data TestRunResult = TestRunResult
  { TestRunResult -> TestStatus
testRunResultStatus :: !TestStatus,
    TestRunResult -> Maybe Int
testRunResultRetries :: !(Maybe Int),
    TestRunResult -> Maybe SomeException
testRunResultException :: !(Maybe SomeException),
    TestRunResult -> Maybe Word
testRunResultNumTests :: !(Maybe Word),
    TestRunResult -> Maybe Word
testRunResultNumShrinks :: !(Maybe Word),
    TestRunResult -> [String]
testRunResultFailingInputs :: [String],
    TestRunResult -> Maybe (Map [String] Int)
testRunResultLabels :: !(Maybe (Map [String] Int)),
    TestRunResult -> Maybe (Map String Int)
testRunResultClasses :: !(Maybe (Map String Int)),
    TestRunResult -> Maybe (Map String (Map String Int))
testRunResultTables :: !(Maybe (Map String (Map String Int))),
    TestRunResult -> Maybe GoldenCase
testRunResultGoldenCase :: !(Maybe GoldenCase),
    TestRunResult -> Maybe String
testRunResultExtraInfo :: !(Maybe String),
    TestRunResult -> Maybe String
testRunResultFlakinessMessage :: !(Maybe String)
  }
  deriving (Int -> TestRunResult -> String -> String
[TestRunResult] -> String -> String
TestRunResult -> String
(Int -> TestRunResult -> String -> String)
-> (TestRunResult -> String)
-> ([TestRunResult] -> String -> String)
-> Show TestRunResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestRunResult] -> String -> String
$cshowList :: [TestRunResult] -> String -> String
show :: TestRunResult -> String
$cshow :: TestRunResult -> String
showsPrec :: Int -> TestRunResult -> String -> String
$cshowsPrec :: Int -> TestRunResult -> String -> String
Show, (forall x. TestRunResult -> Rep TestRunResult x)
-> (forall x. Rep TestRunResult x -> TestRunResult)
-> Generic TestRunResult
forall x. Rep TestRunResult x -> TestRunResult
forall x. TestRunResult -> Rep TestRunResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestRunResult x -> TestRunResult
$cfrom :: forall x. TestRunResult -> Rep TestRunResult x
Generic)

data TestStatus = TestPassed | TestFailed
  deriving (Int -> TestStatus -> String -> String
[TestStatus] -> String -> String
TestStatus -> String
(Int -> TestStatus -> String -> String)
-> (TestStatus -> String)
-> ([TestStatus] -> String -> String)
-> Show TestStatus
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestStatus] -> String -> String
$cshowList :: [TestStatus] -> String -> String
show :: TestStatus -> String
$cshow :: TestStatus -> String
showsPrec :: Int -> TestStatus -> String -> String
$cshowsPrec :: Int -> TestStatus -> String -> String
Show, TestStatus -> TestStatus -> Bool
(TestStatus -> TestStatus -> Bool)
-> (TestStatus -> TestStatus -> Bool) -> Eq TestStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestStatus -> TestStatus -> Bool
$c/= :: TestStatus -> TestStatus -> Bool
== :: TestStatus -> TestStatus -> Bool
$c== :: TestStatus -> TestStatus -> Bool
Eq, (forall x. TestStatus -> Rep TestStatus x)
-> (forall x. Rep TestStatus x -> TestStatus) -> Generic TestStatus
forall x. Rep TestStatus x -> TestStatus
forall x. TestStatus -> Rep TestStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestStatus x -> TestStatus
$cfrom :: forall x. TestStatus -> Rep TestStatus x
Generic)

-- | A special exception that sydtest knows about and can display nicely in the error output
--
-- This is exported outwards so that you can define golden tests for custom types.
--
-- You will probably not want to use this directly in everyday tests, use `shouldBe` or a similar function instead.
data Assertion
  = NotEqualButShouldHaveBeenEqual String String
  | EqualButShouldNotHaveBeenEqual String String
  | PredicateSucceededButShouldHaveFailed
      String -- Value
      (Maybe String) -- Name of the predicate
  | PredicateFailedButShouldHaveSucceeded
      String -- Value
      (Maybe String) -- Name of the predicate
  | ExpectationFailed String
  | Context Assertion String
  deriving (Int -> Assertion -> String -> String
[Assertion] -> String -> String
Assertion -> String
(Int -> Assertion -> String -> String)
-> (Assertion -> String)
-> ([Assertion] -> String -> String)
-> Show Assertion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Assertion] -> String -> String
$cshowList :: [Assertion] -> String -> String
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> String -> String
$cshowsPrec :: Int -> Assertion -> String -> String
Show, Assertion -> Assertion -> Bool
(Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool) -> Eq Assertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Typeable, (forall x. Assertion -> Rep Assertion x)
-> (forall x. Rep Assertion x -> Assertion) -> Generic Assertion
forall x. Rep Assertion x -> Assertion
forall x. Assertion -> Rep Assertion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Assertion x -> Assertion
$cfrom :: forall x. Assertion -> Rep Assertion x
Generic)

instance Exception Assertion

data Contextual = Contextual !SomeException !String
  deriving (Int -> Contextual -> String -> String
[Contextual] -> String -> String
Contextual -> String
(Int -> Contextual -> String -> String)
-> (Contextual -> String)
-> ([Contextual] -> String -> String)
-> Show Contextual
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Contextual] -> String -> String
$cshowList :: [Contextual] -> String -> String
show :: Contextual -> String
$cshow :: Contextual -> String
showsPrec :: Int -> Contextual -> String -> String
$cshowsPrec :: Int -> Contextual -> String -> String
Show, Typeable, (forall x. Contextual -> Rep Contextual x)
-> (forall x. Rep Contextual x -> Contextual) -> Generic Contextual
forall x. Rep Contextual x -> Contextual
forall x. Contextual -> Rep Contextual x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Contextual x -> Contextual
$cfrom :: forall x. Contextual -> Rep Contextual x
Generic)

instance Exception Contextual

addContextToException :: Exception e => e -> String -> Contextual
addContextToException :: e -> String -> Contextual
addContextToException e
e = SomeException -> String -> Contextual
Contextual (e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
e)

data GoldenCase
  = GoldenNotFound
  | GoldenStarted
  | GoldenReset
  deriving (Int -> GoldenCase -> String -> String
[GoldenCase] -> String -> String
GoldenCase -> String
(Int -> GoldenCase -> String -> String)
-> (GoldenCase -> String)
-> ([GoldenCase] -> String -> String)
-> Show GoldenCase
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GoldenCase] -> String -> String
$cshowList :: [GoldenCase] -> String -> String
show :: GoldenCase -> String
$cshow :: GoldenCase -> String
showsPrec :: Int -> GoldenCase -> String -> String
$cshowsPrec :: Int -> GoldenCase -> String -> String
Show, GoldenCase -> GoldenCase -> Bool
(GoldenCase -> GoldenCase -> Bool)
-> (GoldenCase -> GoldenCase -> Bool) -> Eq GoldenCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GoldenCase -> GoldenCase -> Bool
$c/= :: GoldenCase -> GoldenCase -> Bool
== :: GoldenCase -> GoldenCase -> Bool
$c== :: GoldenCase -> GoldenCase -> Bool
Eq, Typeable, (forall x. GoldenCase -> Rep GoldenCase x)
-> (forall x. Rep GoldenCase x -> GoldenCase) -> Generic GoldenCase
forall x. Rep GoldenCase x -> GoldenCase
forall x. GoldenCase -> Rep GoldenCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GoldenCase x -> GoldenCase
$cfrom :: forall x. GoldenCase -> Rep GoldenCase x
Generic)

type ProgressReporter = Progress -> IO ()

noProgressReporter :: ProgressReporter
noProgressReporter :: ProgressReporter
noProgressReporter Progress
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

reportProgress :: ProgressReporter -> Progress -> IO ()
reportProgress :: ProgressReporter -> ProgressReporter
reportProgress = ProgressReporter -> ProgressReporter
forall a. a -> a
id

data Progress
  = ProgressTestStarting
  | ProgressExampleStarting
      !Word
      -- ^ Total examples
      !Word
      -- ^ Example number
  | ProgressExampleDone
      !Word
      -- ^ Total examples
      !Word
      -- ^ Example number
      !Word64
      -- ^ Time it took
  | ProgressTestDone
  deriving (Int -> Progress -> String -> String
[Progress] -> String -> String
Progress -> String
(Int -> Progress -> String -> String)
-> (Progress -> String)
-> ([Progress] -> String -> String)
-> Show Progress
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Progress] -> String -> String
$cshowList :: [Progress] -> String -> String
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> String -> String
$cshowsPrec :: Int -> Progress -> String -> String
Show, Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq, (forall x. Progress -> Rep Progress x)
-> (forall x. Rep Progress x -> Progress) -> Generic Progress
forall x. Rep Progress x -> Progress
forall x. Progress -> Rep Progress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Progress x -> Progress
$cfrom :: forall x. Progress -> Rep Progress x
Generic)

-- | Time an action and return the result as well as how long it took in seconds.
--
-- This function does not use the 'timeit' package because that package uses CPU time instead of system time.
-- That means that any waiting, like with 'threadDelay' would not be counted.
--
-- Note that this does not evaluate the result, on purpose.
timeItT :: MonadIO m => m a -> m (Timed a)
timeItT :: m a -> m (Timed a)
timeItT m a
func = do
  Word64
begin <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
getMonotonicTimeNSec
  a
r <- m a
func
  Word64
end <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
getMonotonicTimeNSec
  Timed a -> m (Timed a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Timed a -> m (Timed a)) -> Timed a -> m (Timed a)
forall a b. (a -> b) -> a -> b
$ a -> Word64 -> Timed a
forall a. a -> Word64 -> Timed a
Timed a
r (Word64
end Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
begin)

data Timed a = Timed
  { Timed a -> a
timedValue :: !a,
    -- | In nanoseconds
    Timed a -> Word64
timedTime :: !Word64
  }
  deriving (Int -> Timed a -> String -> String
[Timed a] -> String -> String
Timed a -> String
(Int -> Timed a -> String -> String)
-> (Timed a -> String)
-> ([Timed a] -> String -> String)
-> Show (Timed a)
forall a. Show a => Int -> Timed a -> String -> String
forall a. Show a => [Timed a] -> String -> String
forall a. Show a => Timed a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Timed a] -> String -> String
$cshowList :: forall a. Show a => [Timed a] -> String -> String
show :: Timed a -> String
$cshow :: forall a. Show a => Timed a -> String
showsPrec :: Int -> Timed a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Timed a -> String -> String
Show, Timed a -> Timed a -> Bool
(Timed a -> Timed a -> Bool)
-> (Timed a -> Timed a -> Bool) -> Eq (Timed a)
forall a. Eq a => Timed a -> Timed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timed a -> Timed a -> Bool
$c/= :: forall a. Eq a => Timed a -> Timed a -> Bool
== :: Timed a -> Timed a -> Bool
$c== :: forall a. Eq a => Timed a -> Timed a -> Bool
Eq, (forall x. Timed a -> Rep (Timed a) x)
-> (forall x. Rep (Timed a) x -> Timed a) -> Generic (Timed a)
forall x. Rep (Timed a) x -> Timed a
forall x. Timed a -> Rep (Timed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Timed a) x -> Timed a
forall a x. Timed a -> Rep (Timed a) x
$cto :: forall a x. Rep (Timed a) x -> Timed a
$cfrom :: forall a x. Timed a -> Rep (Timed a) x
Generic, a -> Timed b -> Timed a
(a -> b) -> Timed a -> Timed b
(forall a b. (a -> b) -> Timed a -> Timed b)
-> (forall a b. a -> Timed b -> Timed a) -> Functor Timed
forall a b. a -> Timed b -> Timed a
forall a b. (a -> b) -> Timed a -> Timed b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Timed b -> Timed a
$c<$ :: forall a b. a -> Timed b -> Timed a
fmap :: (a -> b) -> Timed a -> Timed b
$cfmap :: forall a b. (a -> b) -> Timed a -> Timed b
Functor)