{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# 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 OptEnvConf
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
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
(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 :: forall outerArgs innerArg.
(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
  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
  TestRunResult -> IO TestRunResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultNumTests :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumShrinks :: forall a. Maybe a
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultExtraInfo :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
..}

applyWrapper2 ::
  forall r outerArgs innerArg.
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  (outerArgs -> innerArg -> IO r) ->
  IO (Either SomeException r)
applyWrapper2 :: 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 r
func = do
  MVar (Either SomeException r)
var <- IO (MVar (Either SomeException r))
-> IO (MVar (Either SomeException r))
forall a. IO a -> IO a
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 a b. (a -> b) -> IO a -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a. IO a -> IO a
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 a. IO a -> IO a
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 a. a -> IO a
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
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
(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
e -> 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
e)

runIOTestWithArg ::
  (outerArgs -> innerArg -> IO ()) ->
  TestRunSettings ->
  ProgressReporter ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runIOTestWithArg :: forall outerArgs innerArg.
(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

  ProgressReporter
report Progress
ProgressTestStarting
  Either SomeException ()
result <- IO (Either SomeException ()) -> IO (Either SomeException ())
forall a. IO a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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
  TestRunResult -> IO TestRunResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultNumTests :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumShrinks :: forall a. Maybe a
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultExtraInfo :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
..}

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
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
(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
testRunSettingSeed :: SeedSetting
testRunSettingMaxSuccess :: Int
testRunSettingMaxSize :: Int
testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxShrinks :: Int
testRunSettingGoldenStart :: Bool
testRunSettingGoldenReset :: Bool
testRunSettingSeed :: TestRunSettings -> SeedSetting
testRunSettingMaxSuccess :: TestRunSettings -> Int
testRunSettingMaxSize :: TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: TestRunSettings -> Int
testRunSettingMaxShrinks :: TestRunSettings -> Int
testRunSettingGoldenStart :: TestRunSettings -> Bool
testRunSettingGoldenReset :: TestRunSettings -> Bool
..} =
  Args
stdArgs
    { replay = case 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 = False,
      maxSuccess = testRunSettingMaxSuccess,
      maxDiscardRatio = testRunSettingMaxDiscardRatio,
      maxSize = testRunSettingMaxSize,
      maxShrinks = testRunSettingMaxShrinks
    }

runPropertyTestWithArg ::
  forall outerArgs innerArg.
  (outerArgs -> innerArg -> Property) ->
  TestRunSettings ->
  ProgressReporter ->
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  IO TestRunResult
runPropertyTestWithArg :: forall outerArgs innerArg.
(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
        (()
result, Word64
duration) <- IO () -> IO ((), Word64)
forall (m :: * -> *) a. MonadIO m => m a -> m (a, Word64)
timeItDuration (IO () -> IO ((), Word64)) -> IO () -> IO ((), Word64)
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
duration
        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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
result

  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
  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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultStatus :: TestStatus
testRunResultException :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultExtraInfo :: forall a. Maybe a
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
..}
    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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultStatus :: TestStatus
testRunResultException :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultExtraInfo :: Maybe String
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
..}
    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 a. a -> Maybe a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultExtraInfo :: forall a. Maybe a
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: forall a. Maybe a
..}
    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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: forall a. Maybe a
testRunResultNumTests :: Maybe Word
testRunResultStatus :: TestStatus
testRunResultException :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultExtraInfo :: Maybe String
..}

aroundProperty :: ((a -> b -> IO ()) -> IO ()) -> (a -> b -> Property) -> Property
aroundProperty :: forall a b.
((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 :: forall a b.
((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 :: forall a b.
((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 a. a -> Rose a
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 a b. IO a -> (a -> IO b) -> IO b
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.
    forall a. GoldenTest a -> IO (Maybe a)
goldenTestRead :: IO (Maybe a),
    -- | Produce the current output
    forall a. GoldenTest a -> IO a
goldenTestProduce :: IO a,
    -- | Write golden output
    forall a. 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
    forall a. GoldenTest a -> a -> a -> IO (Maybe Assertion)
goldenTestCompare :: a -> a -> IO (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 a. a -> IO 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
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
(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 :: forall outerArgs innerArg a.
(outerArgs -> innerArg -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((outerArgs -> innerArg -> IO ()) -> IO ())
-> IO TestRunResult
runGoldenTestWithArg outerArgs -> innerArg -> IO (GoldenTest a)
createGolden TestRunSettings {Bool
Int
SeedSetting
testRunSettingSeed :: TestRunSettings -> SeedSetting
testRunSettingMaxSuccess :: TestRunSettings -> Int
testRunSettingMaxSize :: TestRunSettings -> Int
testRunSettingMaxDiscardRatio :: TestRunSettings -> Int
testRunSettingMaxShrinks :: TestRunSettings -> Int
testRunSettingGoldenStart :: TestRunSettings -> Bool
testRunSettingGoldenReset :: TestRunSettings -> Bool
testRunSettingSeed :: SeedSetting
testRunSettingMaxSuccess :: Int
testRunSettingMaxSize :: Int
testRunSettingMaxDiscardRatio :: Int
testRunSettingMaxShrinks :: Int
testRunSettingGoldenStart :: Bool
testRunSettingGoldenReset :: Bool
..} 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 -> IO (Maybe Assertion)
goldenTestRead :: forall a. GoldenTest a -> IO (Maybe a)
goldenTestProduce :: forall a. GoldenTest a -> IO a
goldenTestWrite :: forall a. GoldenTest a -> a -> IO ()
goldenTestCompare :: forall a. GoldenTest a -> a -> a -> IO (Maybe Assertion)
goldenTestRead :: IO (Maybe a)
goldenTestProduce :: IO a
goldenTestWrite :: a -> IO ()
goldenTestCompare :: a -> a -> IO (Maybe Assertion)
..} <- 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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate
        Maybe Assertion
mAssertion <- a -> a -> IO (Maybe Assertion)
goldenTestCompare a
actual a
golden
        case Maybe Assertion
mAssertion of
          Maybe Assertion
Nothing -> (TestStatus, Maybe GoldenCase, Maybe SomeException)
-> IO (TestStatus, Maybe GoldenCase, Maybe SomeException)
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
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
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultStatus :: TestStatus
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultException :: Maybe SomeException
testRunResultNumTests :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultExtraInfo :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
..}

exceptionHandlers :: [Handler (Either SomeException a)]
exceptionHandlers :: forall a. [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 a. a -> IO 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
$cshowsPrec :: Int -> TestRunSettings -> String -> String
showsPrec :: Int -> TestRunSettings -> String -> String
$cshow :: TestRunSettings -> String
show :: TestRunSettings -> String
$cshowList :: [TestRunSettings] -> String -> String
showList :: [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
$c== :: TestRunSettings -> TestRunSettings -> Bool
== :: TestRunSettings -> TestRunSettings -> Bool
$c/= :: TestRunSettings -> TestRunSettings -> Bool
/= :: 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
$cfrom :: forall x. TestRunSettings -> Rep TestRunSettings x
from :: forall x. TestRunSettings -> Rep TestRunSettings x
$cto :: forall x. Rep TestRunSettings x -> TestRunSettings
to :: forall x. Rep TestRunSettings x -> TestRunSettings
Generic)

defaultTestRunSettings :: TestRunSettings
defaultTestRunSettings :: TestRunSettings
defaultTestRunSettings =
  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 =
        -- This is different from what quickcheck does so that test suites are more likely to finish
        Int
100,
      testRunSettingGoldenStart :: Bool
testRunSettingGoldenStart =
        -- It's important that this is False
        -- If it's true by default, then we wouldn't notice it when golden
        -- results are ccidentally not shipped along with the test suite.
        -- In such a case, golden tests could never fail.
        Bool
False,
      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
$cshowsPrec :: Int -> SeedSetting -> String -> String
showsPrec :: Int -> SeedSetting -> String -> String
$cshow :: SeedSetting -> String
show :: SeedSetting -> String
$cshowList :: [SeedSetting] -> String -> String
showList :: [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
$c== :: SeedSetting -> SeedSetting -> Bool
== :: SeedSetting -> SeedSetting -> Bool
$c/= :: SeedSetting -> SeedSetting -> Bool
/= :: 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
$cfrom :: forall x. SeedSetting -> Rep SeedSetting x
from :: forall x. SeedSetting -> Rep SeedSetting x
$cto :: forall x. Rep SeedSetting x -> SeedSetting
to :: forall x. Rep SeedSetting x -> SeedSetting
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

instance HasParser SeedSetting where
  settingsParser :: Parser SeedSetting
settingsParser =
    [Parser SeedSetting] -> Parser SeedSetting
forall a. HasCallStack => [Parser a] -> Parser a
choice
      [ [Builder SeedSetting] -> Parser SeedSetting
forall a. HasCallStack => [Builder a] -> Parser a
setting
          [ String -> Builder SeedSetting
forall a. String -> Builder a
help String
"Use a random seed for pseudo-randomness",
            SeedSetting -> Builder SeedSetting
forall a. a -> Builder a
switch SeedSetting
RandomSeed,
            String -> Builder SeedSetting
forall a. String -> Builder a
long String
"random-seed"
          ],
        SeedSetting
RandomSeed
          SeedSetting -> Parser Bool -> Parser SeedSetting
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Builder Bool] -> Parser Bool
forall a. HasCallStack => [Builder a] -> Parser a
setting
            [ String -> Builder Bool
forall a. String -> Builder a
help String
"Use a random seed for pseudo-randomness",
              Reader Bool -> Builder Bool
forall a. Reader a -> Builder a
OptEnvConf.reader Reader Bool
exists,
              String -> Builder Bool
forall a. String -> Builder a
env String
"RANDOM_SEED",
              String -> Builder Bool
forall a. String -> Builder a
metavar String
"ANY"
            ],
        Int -> SeedSetting
FixedSeed
          (Int -> SeedSetting) -> Parser Int -> Parser SeedSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Builder Int] -> Parser Int
forall a. HasCallStack => [Builder a] -> Parser a
setting
            [ String -> Builder Int
forall a. String -> Builder a
help String
"Seed for pseudo-randomness",
              Reader Int -> Builder Int
forall a. Reader a -> Builder a
OptEnvConf.reader Reader Int
forall a. Read a => Reader a
auto,
              Builder Int
forall a. Builder a
option,
              String -> Builder Int
forall a. String -> Builder a
long String
"seed",
              String -> Builder Int
forall a. String -> Builder a
env String
"SEED",
              String -> Builder Int
forall a. String -> Builder a
metavar String
"INT"
            ],
        [Builder SeedSetting] -> Parser SeedSetting
forall a. HasCallStack => [Builder a] -> Parser a
setting
          [ String -> Builder SeedSetting
forall a. String -> Builder a
help String
"Seed for pseudo-randomness",
            String -> Builder SeedSetting
forall a. HasCodec a => String -> Builder a
conf String
"seed"
          ],
        SeedSetting -> Parser SeedSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SeedSetting -> Parser SeedSetting)
-> SeedSetting -> Parser SeedSetting
forall a b. (a -> b) -> a -> b
$ TestRunSettings -> SeedSetting
testRunSettingSeed TestRunSettings
defaultTestRunSettings
      ]

data TestRunResult = TestRunResult
  { TestRunResult -> TestStatus
testRunResultStatus :: !TestStatus,
    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)
  }
  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
$cshowsPrec :: Int -> TestRunResult -> String -> String
showsPrec :: Int -> TestRunResult -> String -> String
$cshow :: TestRunResult -> String
show :: TestRunResult -> String
$cshowList :: [TestRunResult] -> String -> String
showList :: [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
$cfrom :: forall x. TestRunResult -> Rep TestRunResult x
from :: forall x. TestRunResult -> Rep TestRunResult x
$cto :: forall x. Rep TestRunResult x -> TestRunResult
to :: forall x. Rep TestRunResult x -> TestRunResult
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
$cshowsPrec :: Int -> TestStatus -> String -> String
showsPrec :: Int -> TestStatus -> String -> String
$cshow :: TestStatus -> String
show :: TestStatus -> String
$cshowList :: [TestStatus] -> String -> String
showList :: [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
$c== :: TestStatus -> TestStatus -> Bool
== :: TestStatus -> TestStatus -> Bool
$c/= :: TestStatus -> TestStatus -> Bool
/= :: 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
$cfrom :: forall x. TestStatus -> Rep TestStatus x
from :: forall x. TestStatus -> Rep TestStatus x
$cto :: forall x. Rep TestStatus x -> TestStatus
to :: forall x. Rep TestStatus x -> TestStatus
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
$cshowsPrec :: Int -> Assertion -> String -> String
showsPrec :: Int -> Assertion -> String -> String
$cshow :: Assertion -> String
show :: Assertion -> String
$cshowList :: [Assertion] -> String -> String
showList :: [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
$c== :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
/= :: 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
$cfrom :: forall x. Assertion -> Rep Assertion x
from :: forall x. Assertion -> Rep Assertion x
$cto :: forall x. Rep Assertion x -> Assertion
to :: forall x. Rep Assertion x -> Assertion
Generic)

instance Exception Assertion

-- | An exception with context.
--
-- We wrap an existentially qualified exception here, instead of
-- 'SomeException', so that we can unwrap it.
-- (For some unknown reason, that doesn't work otherwise.)
data Contextual
  = forall e. (Exception e) => Contextual !e !String

instance Show Contextual where
  showsPrec :: Int -> Contextual -> String -> String
showsPrec Int
d (Contextual e
e String
s) = Bool -> (String -> String) -> String -> String
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"Contextual " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 (e -> String
forall e. Exception e => e -> String
displayException e
e) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 String
s

instance Exception Contextual

addContextToException :: (Exception e) => e -> String -> Contextual
addContextToException :: forall e. Exception e => e -> String -> Contextual
addContextToException e
e = e -> String -> Contextual
forall e. Exception e => e -> String -> Contextual
Contextual 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
$cshowsPrec :: Int -> GoldenCase -> String -> String
showsPrec :: Int -> GoldenCase -> String -> String
$cshow :: GoldenCase -> String
show :: GoldenCase -> String
$cshowList :: [GoldenCase] -> String -> String
showList :: [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
$c== :: GoldenCase -> GoldenCase -> Bool
== :: GoldenCase -> GoldenCase -> Bool
$c/= :: GoldenCase -> GoldenCase -> Bool
/= :: 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
$cfrom :: forall x. GoldenCase -> Rep GoldenCase x
from :: forall x. GoldenCase -> Rep GoldenCase x
$cto :: forall x. Rep GoldenCase x -> GoldenCase
to :: forall x. Rep GoldenCase x -> GoldenCase
Generic)

type ProgressReporter = Progress -> IO ()

noProgressReporter :: ProgressReporter
noProgressReporter :: ProgressReporter
noProgressReporter Progress
_ = () -> IO ()
forall a. a -> IO a
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
      -- Total examples
      !Word
      -- Example number
      !Word
  | ProgressExampleDone
      -- Total examples
      !Word
      -- Example number
      !Word
      -- Time it took
      !Word64
  | 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
$cshowsPrec :: Int -> Progress -> String -> String
showsPrec :: Int -> Progress -> String -> String
$cshow :: Progress -> String
show :: Progress -> String
$cshowList :: [Progress] -> String -> String
showList :: [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
$c== :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
/= :: 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
$cfrom :: forall x. Progress -> Rep Progress x
from :: forall x. Progress -> Rep Progress x
$cto :: forall x. Rep Progress x -> Progress
to :: forall x. Rep Progress x -> Progress
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) => Int -> m a -> m (Timed a)
timeItT :: forall (m :: * -> *) a. MonadIO m => Int -> m a -> m (Timed a)
timeItT Int
worker m a
func = do
  (a
r, (Word64
begin, Word64
end)) <- m a -> m (a, (Word64, Word64))
forall (m :: * -> *) a. MonadIO m => m a -> m (a, (Word64, Word64))
timeItBeginEnd m a
func
  Timed a -> m (Timed a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Timed
      { timedValue :: a
timedValue = a
r,
        timedWorker :: Int
timedWorker = Int
worker,
        timedBegin :: Word64
timedBegin = Word64
begin,
        timedEnd :: Word64
timedEnd = Word64
end
      }

timeItDuration :: (MonadIO m) => m a -> m (a, Word64)
timeItDuration :: forall (m :: * -> *) a. MonadIO m => m a -> m (a, Word64)
timeItDuration m a
func = do
  (a
r, (Word64
begin, Word64
end)) <- m a -> m (a, (Word64, Word64))
forall (m :: * -> *) a. MonadIO m => m a -> m (a, (Word64, Word64))
timeItBeginEnd m a
func
  (a, Word64) -> m (a, Word64)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
r, Word64
end Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
begin)

timeItBeginEnd :: (MonadIO m) => m a -> m (a, (Word64, Word64))
timeItBeginEnd :: forall (m :: * -> *) a. MonadIO m => m a -> m (a, (Word64, Word64))
timeItBeginEnd m a
func = do
  Word64
begin <- IO Word64 -> m Word64
forall a. IO a -> m a
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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
getMonotonicTimeNSec
  (a, (Word64, Word64)) -> m (a, (Word64, Word64))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
r, (Word64
begin, Word64
end))

data Timed a = Timed
  { forall a. Timed a -> a
timedValue :: !a,
    forall a. Timed a -> Int
timedWorker :: !Int,
    -- | In nanoseconds
    forall a. Timed a -> Word64
timedBegin :: !Word64,
    -- | In nanoseconds
    forall a. Timed a -> Word64
timedEnd :: !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
$cshowsPrec :: forall a. Show a => Int -> Timed a -> String -> String
showsPrec :: Int -> Timed a -> String -> String
$cshow :: forall a. Show a => Timed a -> String
show :: Timed a -> String
$cshowList :: forall a. Show a => [Timed a] -> String -> String
showList :: [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
$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
/= :: 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
$cfrom :: forall a x. Timed a -> Rep (Timed a) x
from :: forall x. Timed a -> Rep (Timed a) x
$cto :: forall a x. Rep (Timed a) x -> Timed a
to :: forall x. Rep (Timed a) x -> Timed a
Generic, (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
$cfmap :: forall a b. (a -> b) -> Timed a -> Timed b
fmap :: forall a b. (a -> b) -> Timed a -> Timed b
$c<$ :: forall a b. a -> Timed b -> Timed a
<$ :: forall a b. a -> Timed b -> Timed a
Functor)

timedTime :: Timed a -> Word64
timedTime :: forall a. Timed a -> Word64
timedTime Timed {a
Int
Word64
timedValue :: forall a. Timed a -> a
timedWorker :: forall a. Timed a -> Int
timedBegin :: forall a. Timed a -> Word64
timedEnd :: forall a. Timed a -> Word64
timedValue :: a
timedWorker :: Int
timedBegin :: Word64
timedEnd :: Word64
..} = Word64
timedEnd Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
timedBegin