{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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 Control.Concurrent
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 ->
    ((Arg1 e -> Arg2 e -> IO ()) -> IO ()) ->
    IO TestRunResult

instance IsTest Bool where
  type Arg1 Bool = ()
  type Arg2 Bool = ()
  runTest :: Bool
-> TestRunSettings
-> ((Arg1 Bool -> Arg2 Bool -> IO ()) -> IO ())
-> IO TestRunResult
runTest Bool
func = (() -> () -> Bool)
-> TestRunSettings
-> ((Arg1 (() -> () -> Bool) -> Arg2 (() -> () -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (arg -> Bool) -> Arg2 (arg -> Bool) -> IO ()) -> IO ())
-> IO TestRunResult
runTest arg -> Bool
func = (() -> arg -> Bool)
-> TestRunSettings
-> ((Arg1 (() -> arg -> Bool) -> Arg2 (() -> arg -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (outerArgs -> innerArg -> Bool)
     -> Arg2 (outerArgs -> innerArg -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ((Arg1 (outerArgs -> innerArg -> Bool)
     -> Arg2 (outerArgs -> innerArg -> Bool) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg.
(outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPureTestWithArg

runPureTestWithArg ::
  (outerArgs -> innerArg -> Bool) ->
  TestRunSettings ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runPureTestWithArg :: (outerArgs -> innerArg -> Bool)
-> TestRunSettings
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPureTestWithArg outerArgs -> innerArg -> Bool
computeBool TestRunSettings {} (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  let testRunResultNumTests :: Maybe a
testRunResultNumTests = Maybe a
forall a. Maybe a
Nothing
  Either (Either String Assertion) Bool
resultBool <-
    ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO Bool)
-> IO (Either (Either String Assertion) Bool)
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r)
-> IO (Either (Either String Assertion) r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO Bool)
 -> IO (Either (Either String Assertion) Bool))
-> (outerArgs -> innerArg -> IO Bool)
-> IO (Either (Either String Assertion) 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)
  let (TestStatus
testRunResultStatus, Maybe (Either String Assertion)
testRunResultException) = case Either (Either String Assertion) Bool
resultBool of
        Left Either String Assertion
ex -> (TestStatus
TestFailed, Either String Assertion -> Maybe (Either String Assertion)
forall a. a -> Maybe a
Just Either String Assertion
ex)
        Right Bool
bool -> (if Bool
bool then TestStatus
TestPassed else TestStatus
TestFailed, Maybe (Either String Assertion)
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
  TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
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 (Either String Assertion)
testRunResultStatus :: TestStatus
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 (Either String Assertion)
testRunResultStatus :: TestStatus
testRunResultNumTests :: forall a. Maybe a
..}

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

instance IsTest (IO ()) where
  type Arg1 (IO ()) = ()
  type Arg2 (IO ()) = ()
  runTest :: IO ()
-> TestRunSettings
-> ((Arg1 (IO ()) -> Arg2 (IO ()) -> IO ()) -> IO ())
-> IO TestRunResult
runTest IO ()
func = (() -> () -> IO ())
-> TestRunSettings
-> ((Arg1 (() -> () -> IO ()) -> Arg2 (() -> () -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (arg -> IO ()) -> Arg2 (arg -> IO ()) -> IO ()) -> IO ())
-> IO TestRunResult
runTest arg -> IO ()
func = (() -> arg -> IO ())
-> TestRunSettings
-> ((Arg1 (() -> arg -> IO ())
     -> Arg2 (() -> arg -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (outerArgs -> innerArg -> IO ())
     -> Arg2 (outerArgs -> innerArg -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ((Arg1 (outerArgs -> innerArg -> IO ())
     -> Arg2 (outerArgs -> innerArg -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg.
(outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ((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
-> ((Arg1 (ReaderT env IO ()) -> Arg2 (ReaderT env IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest ReaderT env IO ()
func = (() -> ReaderT env IO ())
-> TestRunSettings
-> ((Arg1 (() -> ReaderT env IO ())
     -> Arg2 (() -> ReaderT env IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (outerArgs -> ReaderT env IO ())
     -> Arg2 (outerArgs -> ReaderT env IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest outerArgs -> ReaderT env IO ()
func = (outerArgs -> env -> IO ())
-> TestRunSettings
-> ((Arg1 (outerArgs -> env -> IO ())
     -> Arg2 (outerArgs -> env -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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 ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runIOTestWithArg :: (outerArgs -> innerArg -> IO ())
-> TestRunSettings
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runIOTestWithArg outerArgs -> innerArg -> IO ()
func TestRunSettings {} (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  let testRunResultNumTests :: Maybe a
testRunResultNumTests = Maybe a
forall a. Maybe a
Nothing
  Either (Either String Assertion) ()
result <- IO (Either (Either String Assertion) ())
-> IO (Either (Either String Assertion) ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (Either String Assertion) ())
 -> IO (Either (Either String Assertion) ()))
-> IO (Either (Either String Assertion) ())
-> IO (Either (Either String Assertion) ())
forall a b. (a -> b) -> a -> b
$
    ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO ())
-> IO (Either (Either String Assertion) ())
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r)
-> IO (Either (Either String Assertion) r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO ())
 -> IO (Either (Either String Assertion) ()))
-> (outerArgs -> innerArg -> IO ())
-> IO (Either (Either String Assertion) ())
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
  let (TestStatus
testRunResultStatus, Maybe (Either String Assertion)
testRunResultException) = case Either (Either String Assertion) ()
result of
        Left Either String Assertion
ex -> (TestStatus
TestFailed, Either String Assertion -> Maybe (Either String Assertion)
forall a. a -> Maybe a
Just Either String Assertion
ex)
        Right () -> (TestStatus
TestPassed, Maybe (Either String Assertion)
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
  TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe GoldenCase
TestStatus
forall a. [a]
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 (Either String Assertion)
testRunResultStatus :: TestStatus
testRunResultNumTests :: forall a. Maybe a
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 (Either String Assertion)
testRunResultStatus :: TestStatus
..}

instance IsTest Property where
  type Arg1 Property = ()
  type Arg2 Property = ()
  runTest :: Property
-> TestRunSettings
-> ((Arg1 Property -> Arg2 Property -> IO ()) -> IO ())
-> IO TestRunResult
runTest Property
func = (() -> () -> Property)
-> TestRunSettings
-> ((Arg1 (() -> () -> Property)
     -> Arg2 (() -> () -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (arg -> Property) -> Arg2 (arg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest arg -> Property
func = (() -> arg -> Property)
-> TestRunSettings
-> ((Arg1 (() -> arg -> Property)
     -> Arg2 (() -> arg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (outerArgs -> innerArg -> Property)
     -> Arg2 (outerArgs -> innerArg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ((Arg1 (outerArgs -> innerArg -> Property)
     -> Arg2 (outerArgs -> innerArg -> Property) -> IO ())
    -> IO ())
-> IO TestRunResult
forall outerArgs innerArg.
(outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPropertyTestWithArg

makeQuickCheckArgs :: TestRunSettings -> Args
makeQuickCheckArgs :: TestRunSettings -> Args
makeQuickCheckArgs TestRunSettings {Bool
Int
testRunSettingGoldenReset :: TestRunSettings -> Bool
testRunSettingGoldenStart :: TestRunSettings -> Bool
testRunSettingMaxShrinks :: TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: TestRunSettings -> Int
testRunSettingMaxSize :: TestRunSettings -> Int
testRunSettingMaxSuccess :: TestRunSettings -> Int
testRunSettingSeed :: TestRunSettings -> Int
testRunSettingGoldenReset :: Bool
testRunSettingGoldenStart :: Bool
testRunSettingMaxShrinks :: Int
testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxSize :: Int
testRunSettingMaxSuccess :: Int
testRunSettingSeed :: Int
..} =
  Args
stdArgs
    { replay :: Maybe (QCGen, Int)
replay = (QCGen, Int) -> Maybe (QCGen, Int)
forall a. a -> Maybe a
Just (Int -> QCGen
mkQCGen Int
testRunSettingSeed, 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 ::
  (outerArgs -> innerArg -> Property) ->
  TestRunSettings ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runPropertyTestWithArg :: (outerArgs -> innerArg -> Property)
-> TestRunSettings
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runPropertyTestWithArg outerArgs -> innerArg -> Property
p TestRunSettings
trs (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  let qcargs :: Args
qcargs = TestRunSettings -> Args
makeQuickCheckArgs TestRunSettings
trs
  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 ()
wrapper outerArgs -> innerArg -> Property
p)
  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
  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 (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
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
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
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 (Either String Assertion)
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 (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
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
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
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 (Either String Assertion)
testRunResultStatus :: TestStatus
..}
    Failure {} -> do
      let testRunResultStatus :: TestStatus
testRunResultStatus = TestStatus
TestFailed
      let testRunResultException :: Maybe (Either String Assertion)
testRunResultException = do
            AnException
se <- Result -> Maybe AnException
theException Result
qcr
            Either String Assertion -> Maybe (Either String Assertion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Assertion -> Maybe (Either String Assertion))
-> Either String Assertion -> Maybe (Either String Assertion)
forall a b. (a -> b) -> a -> b
$ case AnException -> Maybe Assertion
forall e. Exception e => AnException -> Maybe e
fromException AnException
se of
              Just Assertion
a -> Assertion -> Either String Assertion
forall a b. b -> Either a b
Right Assertion
a
              Maybe Assertion
Nothing -> String -> Either String Assertion
forall a b. a -> Either a b
Left (String -> Either String Assertion)
-> String -> Either String Assertion
forall a b. (a -> b) -> a -> b
$ AnException -> String
forall e. Exception e => e -> String
displayException AnException
se
      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 (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
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 (Either String Assertion)
testRunResultStatus :: TestStatus
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
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 (Either String Assertion)
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 (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
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
testRunResultNumTests :: Maybe Word
testRunResultGoldenCase :: forall a. Maybe a
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 (Either String Assertion)
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
-> ((Arg1 (GoldenTest a) -> Arg2 (GoldenTest a) -> IO ()) -> IO ())
-> IO TestRunResult
runTest GoldenTest a
gt = (() -> () -> GoldenTest a)
-> TestRunSettings
-> ((Arg1 (() -> () -> GoldenTest a)
     -> Arg2 (() -> () -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (arg -> GoldenTest a)
     -> Arg2 (arg -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest arg -> GoldenTest a
gt = (() -> arg -> GoldenTest a)
-> TestRunSettings
-> ((Arg1 (() -> arg -> GoldenTest a)
     -> Arg2 (() -> arg -> GoldenTest a) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((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
-> ((Arg1 (outerArgs -> innerArg -> IO (GoldenTest a))
     -> Arg2 (outerArgs -> innerArg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (IO (GoldenTest a)) -> Arg2 (IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest IO (GoldenTest a)
func = (() -> () -> IO (GoldenTest a))
-> TestRunSettings
-> ((Arg1 (() -> () -> IO (GoldenTest a))
     -> Arg2 (() -> () -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((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
-> ((Arg1 (() -> arg -> IO (GoldenTest a))
     -> Arg2 (() -> arg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((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
-> ((Arg1 (outerArgs -> innerArg -> IO (GoldenTest a))
     -> Arg2 (outerArgs -> innerArg -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = (outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ((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
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runGoldenTestWithArg

runGoldenTestWithArg ::
  (outerArgs -> innerArg -> IO (GoldenTest a)) ->
  TestRunSettings ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runGoldenTestWithArg :: (outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runGoldenTestWithArg outerArgs -> innerArg -> IO (GoldenTest a)
createGolden TestRunSettings {Bool
Int
testRunSettingGoldenReset :: Bool
testRunSettingGoldenStart :: Bool
testRunSettingMaxShrinks :: Int
testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxSize :: Int
testRunSettingMaxSuccess :: Int
testRunSettingSeed :: Int
testRunSettingGoldenReset :: TestRunSettings -> Bool
testRunSettingGoldenStart :: TestRunSettings -> Bool
testRunSettingMaxShrinks :: TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: TestRunSettings -> Int
testRunSettingMaxSize :: TestRunSettings -> Int
testRunSettingMaxSuccess :: TestRunSettings -> Int
testRunSettingSeed :: TestRunSettings -> Int
..} (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper = do
  Either
  (Either String Assertion)
  (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
errOrTrip <- ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs
    -> innerArg
    -> IO
         (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion)))
-> IO
     (Either
        (Either String Assertion)
        (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion)))
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r)
-> IO (Either (Either String Assertion) r)
applyWrapper2 (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs
  -> innerArg
  -> IO
       (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion)))
 -> IO
      (Either
         (Either String Assertion)
         (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))))
-> (outerArgs
    -> innerArg
    -> IO
         (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion)))
-> IO
     (Either
        (Either String Assertion)
        (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion)))
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
            a -> IO ()
goldenTestWrite a
actual
            (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
-> IO
     (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, GoldenCase -> Maybe GoldenCase
forall a. a -> Maybe a
Just GoldenCase
GoldenStarted, Maybe (Either String Assertion)
forall a. Maybe a
Nothing)
          else (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
-> IO
     (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestFailed, GoldenCase -> Maybe GoldenCase
forall a. a -> Maybe a
Just GoldenCase
GoldenNotFound, Maybe (Either String Assertion)
forall a. Maybe a
Nothing)
      Just a
golden -> do
        a
actual <- IO a
goldenTestProduce
        case a -> a -> Maybe Assertion
goldenTestCompare a
actual a
golden of
          Maybe Assertion
Nothing -> (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
-> IO
     (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, Maybe GoldenCase
forall a. Maybe a
Nothing, Maybe (Either String Assertion)
forall a. Maybe a
Nothing)
          Just Assertion
assertion ->
            if Bool
testRunSettingGoldenReset
              then do
                a -> IO ()
goldenTestWrite a
actual
                (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
-> IO
     (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, GoldenCase -> Maybe GoldenCase
forall a. a -> Maybe a
Just GoldenCase
GoldenReset, Maybe (Either String Assertion)
forall a. Maybe a
Nothing)
              else (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
-> IO
     (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestFailed, Maybe GoldenCase
forall a. Maybe a
Nothing, Either String Assertion -> Maybe (Either String Assertion)
forall a. a -> Maybe a
Just (Either String Assertion -> Maybe (Either String Assertion))
-> Either String Assertion -> Maybe (Either String Assertion)
forall a b. (a -> b) -> a -> b
$ Assertion -> Either String Assertion
forall a b. b -> Either a b
Right Assertion
assertion)
  let (TestStatus
testRunResultStatus, Maybe GoldenCase
testRunResultGoldenCase, Maybe (Either String Assertion)
testRunResultException) = case Either
  (Either String Assertion)
  (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
errOrTrip of
        Left Either String Assertion
e -> (TestStatus
TestFailed, Maybe GoldenCase
forall a. Maybe a
Nothing, Either String Assertion -> Maybe (Either String Assertion)
forall a. a -> Maybe a
Just Either String Assertion
e)
        Right (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
trip -> (TestStatus, Maybe GoldenCase, Maybe (Either String Assertion))
trip
  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
  TestRunResult -> IO TestRunResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult :: TestStatus
-> Maybe (Either String Assertion)
-> Maybe Word
-> Maybe Word
-> [String]
-> Maybe (Map [String] Int)
-> Maybe (Map String Int)
-> Maybe (Map String (Map String Int))
-> Maybe GoldenCase
-> Maybe String
-> TestRunResult
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe GoldenCase
TestStatus
forall a. [a]
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
testRunResultException :: Maybe (Either String Assertion)
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultStatus :: TestStatus
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 (Either String Assertion)
testRunResultStatus :: TestStatus
..}

exceptionHandlers :: [Handler (Either (Either String Assertion) a)]
exceptionHandlers :: [Handler (Either (Either String Assertion) a)]
exceptionHandlers =
  [ -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT (ctrl-c).
    (AsyncException -> IO (Either (Either String Assertion) a))
-> Handler (Either (Either String Assertion) a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\AsyncException
e -> AsyncException -> IO (Either (Either String Assertion) a)
forall a e. Exception e => e -> a
throw (AsyncException
e :: AsyncException)),
    -- Catch assertions first because we know what to do with them.
    (Assertion -> IO (Either (Either String Assertion) a))
-> Handler (Either (Either String Assertion) a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((Assertion -> IO (Either (Either String Assertion) a))
 -> Handler (Either (Either String Assertion) a))
-> (Assertion -> IO (Either (Either String Assertion) a))
-> Handler (Either (Either String Assertion) a)
forall a b. (a -> b) -> a -> b
$ \(Assertion
a :: Assertion) -> Either (Either String Assertion) a
-> IO (Either (Either String Assertion) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Assertion -> Either (Either String Assertion) a
forall a b. a -> Either a b
Left (Either String Assertion -> Either (Either String Assertion) a)
-> Either String Assertion -> Either (Either String Assertion) a
forall a b. (a -> b) -> a -> b
$ Assertion -> Either String Assertion
forall a b. b -> Either a b
Right Assertion
a),
    -- Catch all the rest as a string
    (AnException -> IO (Either (Either String Assertion) a))
-> Handler (Either (Either String Assertion) a)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\AnException
e -> Either (Either String Assertion) a
-> IO (Either (Either String Assertion) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Either String Assertion) a
 -> IO (Either (Either String Assertion) a))
-> Either (Either String Assertion) a
-> IO (Either (Either String Assertion) a)
forall a b. (a -> b) -> a -> b
$ Either String Assertion -> Either (Either String Assertion) a
forall a b. a -> Either a b
Left (String -> Either String Assertion
forall a b. a -> Either a b
Left (AnException -> String
forall e. Exception e => e -> String
displayException (AnException
e :: SomeException))))
  ]

type Test = IO ()

data TestRunSettings = TestRunSettings
  { TestRunSettings -> Int
testRunSettingSeed :: Int,
    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, (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 :: Int -> Int -> Int -> Int -> Int -> Bool -> Bool -> TestRunSettings
TestRunSettings
    { testRunSettingSeed :: Int
testRunSettingSeed = 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 TestRunResult = TestRunResult
  { TestRunResult -> TestStatus
testRunResultStatus :: !TestStatus,
    TestRunResult -> Maybe (Either String Assertion)
testRunResultException :: !(Maybe (Either String Assertion)),
    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)
  }
  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, TestRunResult -> TestRunResult -> Bool
(TestRunResult -> TestRunResult -> Bool)
-> (TestRunResult -> TestRunResult -> Bool) -> Eq TestRunResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestRunResult -> TestRunResult -> Bool
$c/= :: TestRunResult -> TestRunResult -> Bool
== :: TestRunResult -> TestRunResult -> Bool
$c== :: TestRunResult -> TestRunResult -> Bool
Eq, (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 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)

-- | 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)