{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Hedgehog.Internal.Property (
Property(..)
, PropertyT(..)
, PropertyName(..)
, PropertyConfig(..)
, TestLimit(..)
, TestCount(..)
, DiscardLimit(..)
, DiscardCount(..)
, ShrinkLimit(..)
, ShrinkCount(..)
, Skip(..)
, ShrinkPath(..)
, ShrinkRetries(..)
, withTests
, withDiscards
, withShrinks
, withRetries
, withSkip
, property
, test
, forAll
, forAllT
, forAllWith
, forAllWithT
, defaultMinTests
, discard
, skipCompress
, shrinkPathCompress
, skipDecompress
, shrinkPathDecompress
, Group(..)
, GroupName(..)
, PropertyCount(..)
, MonadTest(..)
, Test
, TestT(..)
, Log(..)
, Journal(..)
, Failure(..)
, Diff(..)
, annotate
, annotateShow
, footnote
, footnoteShow
, failure
, success
, assert
, diff
, (===)
, (/==)
, eval
, evalNF
, evalM
, evalIO
, evalEither
, evalEitherM
, evalExceptT
, evalMaybe
, evalMaybeM
, Coverage(..)
, Label(..)
, LabelName(..)
, cover
, classify
, label
, collect
, coverPercentage
, labelCovered
, coverageSuccess
, coverageFailures
, journalCoverage
, Cover(..)
, CoverCount(..)
, CoverPercentage(..)
, toCoverCount
, Confidence(..)
, TerminationCriteria(..)
, confidenceSuccess
, confidenceFailure
, withConfidence
, verifiedTermination
, defaultConfidence
, defaultConfig
, mapConfig
, failDiff
, failException
, failWith
, writeLog
, mkTest
, mkTestT
, runTest
, runTestT
, wilsonBounds
) where
import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData, rnf)
import Control.Exception.Safe (MonadThrow, MonadCatch)
import Control.Exception.Safe (SomeException(..), displayException)
import Control.Monad (MonadPlus(..), (<=<))
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Error.Class (MonadError(..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Morph (MFunctor(..))
import Control.Monad.Primitive (PrimMonad(..))
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Control (ComposeSt, defaultLiftBaseWith, defaultRestoreM)
import Control.Monad.Trans.Control (MonadBaseControl(..), MonadTransControl(..))
import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.Identity (IdentityT)
import Control.Monad.Trans.Maybe (MaybeT)
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Resource (MonadResource(..))
import Control.Monad.Trans.Resource (ResourceT)
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Data.Char as Char
import Data.Functor (($>))
import Data.Functor.Identity (Identity(..))
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Number.Erf (invnormcdf)
import qualified Data.List as List
import Data.String (IsString(..))
import Data.Ratio ((%))
import Data.Typeable (typeOf)
import Hedgehog.Internal.Distributive
import Hedgehog.Internal.Exception
import Hedgehog.Internal.Gen (Gen, GenT)
import qualified Hedgehog.Internal.Gen as Gen
import Hedgehog.Internal.Prelude
import Hedgehog.Internal.Show
import Hedgehog.Internal.Source
import Language.Haskell.TH.Syntax (Lift)
import qualified Numeric
import Text.Read (readMaybe)
data Property =
Property {
Property -> PropertyConfig
propertyConfig :: !PropertyConfig
, Property -> PropertyT IO ()
propertyTest :: PropertyT IO ()
}
newtype PropertyT m a =
PropertyT {
forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
unPropertyT :: TestT (GenT m) a
} deriving (
(forall a b. (a -> b) -> PropertyT m a -> PropertyT m b)
-> (forall a b. a -> PropertyT m b -> PropertyT m a)
-> Functor (PropertyT m)
forall a b. a -> PropertyT m b -> PropertyT m a
forall a b. (a -> b) -> PropertyT m a -> PropertyT m b
forall (m :: * -> *) a b.
Functor m =>
a -> PropertyT m b -> PropertyT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PropertyT m a -> PropertyT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PropertyT m a -> PropertyT m b
fmap :: forall a b. (a -> b) -> PropertyT m a -> PropertyT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PropertyT m b -> PropertyT m a
<$ :: forall a b. a -> PropertyT m b -> PropertyT m a
Functor
, Functor (PropertyT m)
Functor (PropertyT m) =>
(forall a. a -> PropertyT m a)
-> (forall a b.
PropertyT m (a -> b) -> PropertyT m a -> PropertyT m b)
-> (forall a b c.
(a -> b -> c) -> PropertyT m a -> PropertyT m b -> PropertyT m c)
-> (forall a b. PropertyT m a -> PropertyT m b -> PropertyT m b)
-> (forall a b. PropertyT m a -> PropertyT m b -> PropertyT m a)
-> Applicative (PropertyT m)
forall a. a -> PropertyT m a
forall a b. PropertyT m a -> PropertyT m b -> PropertyT m a
forall a b. PropertyT m a -> PropertyT m b -> PropertyT m b
forall a b. PropertyT m (a -> b) -> PropertyT m a -> PropertyT m b
forall a b c.
(a -> b -> c) -> PropertyT m a -> PropertyT m b -> PropertyT m c
forall (m :: * -> *). Monad m => Functor (PropertyT m)
forall (m :: * -> *) a. Monad m => a -> PropertyT m a
forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> PropertyT m b -> PropertyT m a
forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> PropertyT m b -> PropertyT m b
forall (m :: * -> *) a b.
Monad m =>
PropertyT m (a -> b) -> PropertyT m a -> PropertyT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PropertyT m a -> PropertyT m b -> PropertyT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> PropertyT m a
pure :: forall a. a -> PropertyT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
PropertyT m (a -> b) -> PropertyT m a -> PropertyT m b
<*> :: forall a b. PropertyT m (a -> b) -> PropertyT m a -> PropertyT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PropertyT m a -> PropertyT m b -> PropertyT m c
liftA2 :: forall a b c.
(a -> b -> c) -> PropertyT m a -> PropertyT m b -> PropertyT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> PropertyT m b -> PropertyT m b
*> :: forall a b. PropertyT m a -> PropertyT m b -> PropertyT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> PropertyT m b -> PropertyT m a
<* :: forall a b. PropertyT m a -> PropertyT m b -> PropertyT m a
Applicative
, Applicative (PropertyT m)
Applicative (PropertyT m) =>
(forall a b.
PropertyT m a -> (a -> PropertyT m b) -> PropertyT m b)
-> (forall a b. PropertyT m a -> PropertyT m b -> PropertyT m b)
-> (forall a. a -> PropertyT m a)
-> Monad (PropertyT m)
forall a. a -> PropertyT m a
forall a b. PropertyT m a -> PropertyT m b -> PropertyT m b
forall a b. PropertyT m a -> (a -> PropertyT m b) -> PropertyT m b
forall (m :: * -> *). Monad m => Applicative (PropertyT m)
forall (m :: * -> *) a. Monad m => a -> PropertyT m a
forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> PropertyT m b -> PropertyT m b
forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> (a -> PropertyT m b) -> PropertyT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> (a -> PropertyT m b) -> PropertyT m b
>>= :: forall a b. PropertyT m a -> (a -> PropertyT m b) -> PropertyT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
PropertyT m a -> PropertyT m b -> PropertyT m b
>> :: forall a b. PropertyT m a -> PropertyT m b -> PropertyT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> PropertyT m a
return :: forall a. a -> PropertyT m a
Monad
, Monad (PropertyT m)
Monad (PropertyT m) =>
(forall a. IO a -> PropertyT m a) -> MonadIO (PropertyT m)
forall a. IO a -> PropertyT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (PropertyT m)
forall (m :: * -> *) a. MonadIO m => IO a -> PropertyT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> PropertyT m a
liftIO :: forall a. IO a -> PropertyT m a
MonadIO
, MonadBase b
, Monad (PropertyT m)
Monad (PropertyT m) =>
(forall e a. (HasCallStack, Exception e) => e -> PropertyT m a)
-> MonadThrow (PropertyT m)
forall e a. (HasCallStack, Exception e) => e -> PropertyT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (PropertyT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> PropertyT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> PropertyT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> PropertyT m a
MonadThrow
, MonadThrow (PropertyT m)
MonadThrow (PropertyT m) =>
(forall e a.
(HasCallStack, Exception e) =>
PropertyT m a -> (e -> PropertyT m a) -> PropertyT m a)
-> MonadCatch (PropertyT m)
forall e a.
(HasCallStack, Exception e) =>
PropertyT m a -> (e -> PropertyT m a) -> PropertyT m a
forall (m :: * -> *). MonadCatch m => MonadThrow (PropertyT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
PropertyT m a -> (e -> PropertyT m a) -> PropertyT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
PropertyT m a -> (e -> PropertyT m a) -> PropertyT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
PropertyT m a -> (e -> PropertyT m a) -> PropertyT m a
MonadCatch
, MonadReader r
, MonadState s
, MonadError e
)
deriving instance MonadResource m => MonadResource (PropertyT m)
#if __GLASGOW_HASKELL__ >= 802
deriving instance MonadBaseControl b m => MonadBaseControl b (PropertyT m)
#else
instance MonadBaseControl b m => MonadBaseControl b (PropertyT m) where
type StM (PropertyT m) a = StM (TestT (GenT m)) a
liftBaseWith f = PropertyT $ liftBaseWith $ \rib -> f (rib . unPropertyT)
restoreM = PropertyT . restoreM
#endif
type Test =
TestT Identity
newtype TestT m a =
TestT {
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest :: ExceptT Failure (Lazy.WriterT Journal m) a
} deriving (
(forall a b. (a -> b) -> TestT m a -> TestT m b)
-> (forall a b. a -> TestT m b -> TestT m a) -> Functor (TestT m)
forall a b. a -> TestT m b -> TestT m a
forall a b. (a -> b) -> TestT m a -> TestT m b
forall (m :: * -> *) a b. Functor m => a -> TestT m b -> TestT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TestT m a -> TestT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TestT m a -> TestT m b
fmap :: forall a b. (a -> b) -> TestT m a -> TestT m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> TestT m b -> TestT m a
<$ :: forall a b. a -> TestT m b -> TestT m a
Functor
, Functor (TestT m)
Functor (TestT m) =>
(forall a. a -> TestT m a)
-> (forall a b. TestT m (a -> b) -> TestT m a -> TestT m b)
-> (forall a b c.
(a -> b -> c) -> TestT m a -> TestT m b -> TestT m c)
-> (forall a b. TestT m a -> TestT m b -> TestT m b)
-> (forall a b. TestT m a -> TestT m b -> TestT m a)
-> Applicative (TestT m)
forall a. a -> TestT m a
forall a b. TestT m a -> TestT m b -> TestT m a
forall a b. TestT m a -> TestT m b -> TestT m b
forall a b. TestT m (a -> b) -> TestT m a -> TestT m b
forall a b c. (a -> b -> c) -> TestT m a -> TestT m b -> TestT m c
forall (m :: * -> *). Monad m => Functor (TestT m)
forall (m :: * -> *) a. Monad m => a -> TestT m a
forall (m :: * -> *) a b.
Monad m =>
TestT m a -> TestT m b -> TestT m a
forall (m :: * -> *) a b.
Monad m =>
TestT m a -> TestT m b -> TestT m b
forall (m :: * -> *) a b.
Monad m =>
TestT m (a -> b) -> TestT m a -> TestT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TestT m a -> TestT m b -> TestT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> TestT m a
pure :: forall a. a -> TestT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TestT m (a -> b) -> TestT m a -> TestT m b
<*> :: forall a b. TestT m (a -> b) -> TestT m a -> TestT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TestT m a -> TestT m b -> TestT m c
liftA2 :: forall a b c. (a -> b -> c) -> TestT m a -> TestT m b -> TestT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
TestT m a -> TestT m b -> TestT m b
*> :: forall a b. TestT m a -> TestT m b -> TestT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
TestT m a -> TestT m b -> TestT m a
<* :: forall a b. TestT m a -> TestT m b -> TestT m a
Applicative
, Monad (TestT m)
Monad (TestT m) =>
(forall a. IO a -> TestT m a) -> MonadIO (TestT m)
forall a. IO a -> TestT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (TestT m)
forall (m :: * -> *) a. MonadIO m => IO a -> TestT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> TestT m a
liftIO :: forall a. IO a -> TestT m a
MonadIO
, MonadBase b
, Monad (TestT m)
Monad (TestT m) =>
(forall e a. (HasCallStack, Exception e) => e -> TestT m a)
-> MonadThrow (TestT m)
forall e a. (HasCallStack, Exception e) => e -> TestT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (TestT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> TestT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> TestT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> TestT m a
MonadThrow
, MonadThrow (TestT m)
MonadThrow (TestT m) =>
(forall e a.
(HasCallStack, Exception e) =>
TestT m a -> (e -> TestT m a) -> TestT m a)
-> MonadCatch (TestT m)
forall e a.
(HasCallStack, Exception e) =>
TestT m a -> (e -> TestT m a) -> TestT m a
forall (m :: * -> *). MonadCatch m => MonadThrow (TestT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
TestT m a -> (e -> TestT m a) -> TestT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
TestT m a -> (e -> TestT m a) -> TestT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
TestT m a -> (e -> TestT m a) -> TestT m a
MonadCatch
, MonadReader r
, MonadState s
)
newtype PropertyName =
PropertyName {
PropertyName -> String
unPropertyName :: String
} deriving (PropertyName -> PropertyName -> Bool
(PropertyName -> PropertyName -> Bool)
-> (PropertyName -> PropertyName -> Bool) -> Eq PropertyName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyName -> PropertyName -> Bool
== :: PropertyName -> PropertyName -> Bool
$c/= :: PropertyName -> PropertyName -> Bool
/= :: PropertyName -> PropertyName -> Bool
Eq, Eq PropertyName
Eq PropertyName =>
(PropertyName -> PropertyName -> Ordering)
-> (PropertyName -> PropertyName -> Bool)
-> (PropertyName -> PropertyName -> Bool)
-> (PropertyName -> PropertyName -> Bool)
-> (PropertyName -> PropertyName -> Bool)
-> (PropertyName -> PropertyName -> PropertyName)
-> (PropertyName -> PropertyName -> PropertyName)
-> Ord PropertyName
PropertyName -> PropertyName -> Bool
PropertyName -> PropertyName -> Ordering
PropertyName -> PropertyName -> PropertyName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PropertyName -> PropertyName -> Ordering
compare :: PropertyName -> PropertyName -> Ordering
$c< :: PropertyName -> PropertyName -> Bool
< :: PropertyName -> PropertyName -> Bool
$c<= :: PropertyName -> PropertyName -> Bool
<= :: PropertyName -> PropertyName -> Bool
$c> :: PropertyName -> PropertyName -> Bool
> :: PropertyName -> PropertyName -> Bool
$c>= :: PropertyName -> PropertyName -> Bool
>= :: PropertyName -> PropertyName -> Bool
$cmax :: PropertyName -> PropertyName -> PropertyName
max :: PropertyName -> PropertyName -> PropertyName
$cmin :: PropertyName -> PropertyName -> PropertyName
min :: PropertyName -> PropertyName -> PropertyName
Ord, Int -> PropertyName -> String -> String
[PropertyName] -> String -> String
PropertyName -> String
(Int -> PropertyName -> String -> String)
-> (PropertyName -> String)
-> ([PropertyName] -> String -> String)
-> Show PropertyName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PropertyName -> String -> String
showsPrec :: Int -> PropertyName -> String -> String
$cshow :: PropertyName -> String
show :: PropertyName -> String
$cshowList :: [PropertyName] -> String -> String
showList :: [PropertyName] -> String -> String
Show, String -> PropertyName
(String -> PropertyName) -> IsString PropertyName
forall a. (String -> a) -> IsString a
$cfromString :: String -> PropertyName
fromString :: String -> PropertyName
IsString, NonEmpty PropertyName -> PropertyName
PropertyName -> PropertyName -> PropertyName
(PropertyName -> PropertyName -> PropertyName)
-> (NonEmpty PropertyName -> PropertyName)
-> (forall b. Integral b => b -> PropertyName -> PropertyName)
-> Semigroup PropertyName
forall b. Integral b => b -> PropertyName -> PropertyName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: PropertyName -> PropertyName -> PropertyName
<> :: PropertyName -> PropertyName -> PropertyName
$csconcat :: NonEmpty PropertyName -> PropertyName
sconcat :: NonEmpty PropertyName -> PropertyName
$cstimes :: forall b. Integral b => b -> PropertyName -> PropertyName
stimes :: forall b. Integral b => b -> PropertyName -> PropertyName
Semigroup, (forall (m :: * -> *). Quote m => PropertyName -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
PropertyName -> Code m PropertyName)
-> Lift PropertyName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PropertyName -> m Exp
forall (m :: * -> *).
Quote m =>
PropertyName -> Code m PropertyName
$clift :: forall (m :: * -> *). Quote m => PropertyName -> m Exp
lift :: forall (m :: * -> *). Quote m => PropertyName -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
PropertyName -> Code m PropertyName
liftTyped :: forall (m :: * -> *).
Quote m =>
PropertyName -> Code m PropertyName
Lift)
newtype Confidence =
Confidence {
Confidence -> Int64
unConfidence :: Int64
} deriving (Confidence -> Confidence -> Bool
(Confidence -> Confidence -> Bool)
-> (Confidence -> Confidence -> Bool) -> Eq Confidence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Confidence -> Confidence -> Bool
== :: Confidence -> Confidence -> Bool
$c/= :: Confidence -> Confidence -> Bool
/= :: Confidence -> Confidence -> Bool
Eq, Eq Confidence
Eq Confidence =>
(Confidence -> Confidence -> Ordering)
-> (Confidence -> Confidence -> Bool)
-> (Confidence -> Confidence -> Bool)
-> (Confidence -> Confidence -> Bool)
-> (Confidence -> Confidence -> Bool)
-> (Confidence -> Confidence -> Confidence)
-> (Confidence -> Confidence -> Confidence)
-> Ord Confidence
Confidence -> Confidence -> Bool
Confidence -> Confidence -> Ordering
Confidence -> Confidence -> Confidence
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Confidence -> Confidence -> Ordering
compare :: Confidence -> Confidence -> Ordering
$c< :: Confidence -> Confidence -> Bool
< :: Confidence -> Confidence -> Bool
$c<= :: Confidence -> Confidence -> Bool
<= :: Confidence -> Confidence -> Bool
$c> :: Confidence -> Confidence -> Bool
> :: Confidence -> Confidence -> Bool
$c>= :: Confidence -> Confidence -> Bool
>= :: Confidence -> Confidence -> Bool
$cmax :: Confidence -> Confidence -> Confidence
max :: Confidence -> Confidence -> Confidence
$cmin :: Confidence -> Confidence -> Confidence
min :: Confidence -> Confidence -> Confidence
Ord, Int -> Confidence -> String -> String
[Confidence] -> String -> String
Confidence -> String
(Int -> Confidence -> String -> String)
-> (Confidence -> String)
-> ([Confidence] -> String -> String)
-> Show Confidence
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Confidence -> String -> String
showsPrec :: Int -> Confidence -> String -> String
$cshow :: Confidence -> String
show :: Confidence -> String
$cshowList :: [Confidence] -> String -> String
showList :: [Confidence] -> String -> String
Show, Integer -> Confidence
Confidence -> Confidence
Confidence -> Confidence -> Confidence
(Confidence -> Confidence -> Confidence)
-> (Confidence -> Confidence -> Confidence)
-> (Confidence -> Confidence -> Confidence)
-> (Confidence -> Confidence)
-> (Confidence -> Confidence)
-> (Confidence -> Confidence)
-> (Integer -> Confidence)
-> Num Confidence
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Confidence -> Confidence -> Confidence
+ :: Confidence -> Confidence -> Confidence
$c- :: Confidence -> Confidence -> Confidence
- :: Confidence -> Confidence -> Confidence
$c* :: Confidence -> Confidence -> Confidence
* :: Confidence -> Confidence -> Confidence
$cnegate :: Confidence -> Confidence
negate :: Confidence -> Confidence
$cabs :: Confidence -> Confidence
abs :: Confidence -> Confidence
$csignum :: Confidence -> Confidence
signum :: Confidence -> Confidence
$cfromInteger :: Integer -> Confidence
fromInteger :: Integer -> Confidence
Num, (forall (m :: * -> *). Quote m => Confidence -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
Confidence -> Code m Confidence)
-> Lift Confidence
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Confidence -> m Exp
forall (m :: * -> *). Quote m => Confidence -> Code m Confidence
$clift :: forall (m :: * -> *). Quote m => Confidence -> m Exp
lift :: forall (m :: * -> *). Quote m => Confidence -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Confidence -> Code m Confidence
liftTyped :: forall (m :: * -> *). Quote m => Confidence -> Code m Confidence
Lift)
data PropertyConfig =
PropertyConfig {
PropertyConfig -> DiscardLimit
propertyDiscardLimit :: !DiscardLimit
, PropertyConfig -> ShrinkLimit
propertyShrinkLimit :: !ShrinkLimit
, PropertyConfig -> ShrinkRetries
propertyShrinkRetries :: !ShrinkRetries
, PropertyConfig -> TerminationCriteria
propertyTerminationCriteria :: !TerminationCriteria
, PropertyConfig -> Maybe Skip
propertySkip :: Maybe Skip
} deriving (PropertyConfig -> PropertyConfig -> Bool
(PropertyConfig -> PropertyConfig -> Bool)
-> (PropertyConfig -> PropertyConfig -> Bool) -> Eq PropertyConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyConfig -> PropertyConfig -> Bool
== :: PropertyConfig -> PropertyConfig -> Bool
$c/= :: PropertyConfig -> PropertyConfig -> Bool
/= :: PropertyConfig -> PropertyConfig -> Bool
Eq, Eq PropertyConfig
Eq PropertyConfig =>
(PropertyConfig -> PropertyConfig -> Ordering)
-> (PropertyConfig -> PropertyConfig -> Bool)
-> (PropertyConfig -> PropertyConfig -> Bool)
-> (PropertyConfig -> PropertyConfig -> Bool)
-> (PropertyConfig -> PropertyConfig -> Bool)
-> (PropertyConfig -> PropertyConfig -> PropertyConfig)
-> (PropertyConfig -> PropertyConfig -> PropertyConfig)
-> Ord PropertyConfig
PropertyConfig -> PropertyConfig -> Bool
PropertyConfig -> PropertyConfig -> Ordering
PropertyConfig -> PropertyConfig -> PropertyConfig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PropertyConfig -> PropertyConfig -> Ordering
compare :: PropertyConfig -> PropertyConfig -> Ordering
$c< :: PropertyConfig -> PropertyConfig -> Bool
< :: PropertyConfig -> PropertyConfig -> Bool
$c<= :: PropertyConfig -> PropertyConfig -> Bool
<= :: PropertyConfig -> PropertyConfig -> Bool
$c> :: PropertyConfig -> PropertyConfig -> Bool
> :: PropertyConfig -> PropertyConfig -> Bool
$c>= :: PropertyConfig -> PropertyConfig -> Bool
>= :: PropertyConfig -> PropertyConfig -> Bool
$cmax :: PropertyConfig -> PropertyConfig -> PropertyConfig
max :: PropertyConfig -> PropertyConfig -> PropertyConfig
$cmin :: PropertyConfig -> PropertyConfig -> PropertyConfig
min :: PropertyConfig -> PropertyConfig -> PropertyConfig
Ord, Int -> PropertyConfig -> String -> String
[PropertyConfig] -> String -> String
PropertyConfig -> String
(Int -> PropertyConfig -> String -> String)
-> (PropertyConfig -> String)
-> ([PropertyConfig] -> String -> String)
-> Show PropertyConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PropertyConfig -> String -> String
showsPrec :: Int -> PropertyConfig -> String -> String
$cshow :: PropertyConfig -> String
show :: PropertyConfig -> String
$cshowList :: [PropertyConfig] -> String -> String
showList :: [PropertyConfig] -> String -> String
Show, (forall (m :: * -> *). Quote m => PropertyConfig -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
PropertyConfig -> Code m PropertyConfig)
-> Lift PropertyConfig
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PropertyConfig -> m Exp
forall (m :: * -> *).
Quote m =>
PropertyConfig -> Code m PropertyConfig
$clift :: forall (m :: * -> *). Quote m => PropertyConfig -> m Exp
lift :: forall (m :: * -> *). Quote m => PropertyConfig -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
PropertyConfig -> Code m PropertyConfig
liftTyped :: forall (m :: * -> *).
Quote m =>
PropertyConfig -> Code m PropertyConfig
Lift)
newtype TestLimit =
TestLimit Int
deriving (TestLimit -> TestLimit -> Bool
(TestLimit -> TestLimit -> Bool)
-> (TestLimit -> TestLimit -> Bool) -> Eq TestLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestLimit -> TestLimit -> Bool
== :: TestLimit -> TestLimit -> Bool
$c/= :: TestLimit -> TestLimit -> Bool
/= :: TestLimit -> TestLimit -> Bool
Eq, Eq TestLimit
Eq TestLimit =>
(TestLimit -> TestLimit -> Ordering)
-> (TestLimit -> TestLimit -> Bool)
-> (TestLimit -> TestLimit -> Bool)
-> (TestLimit -> TestLimit -> Bool)
-> (TestLimit -> TestLimit -> Bool)
-> (TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> TestLimit)
-> Ord TestLimit
TestLimit -> TestLimit -> Bool
TestLimit -> TestLimit -> Ordering
TestLimit -> TestLimit -> TestLimit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TestLimit -> TestLimit -> Ordering
compare :: TestLimit -> TestLimit -> Ordering
$c< :: TestLimit -> TestLimit -> Bool
< :: TestLimit -> TestLimit -> Bool
$c<= :: TestLimit -> TestLimit -> Bool
<= :: TestLimit -> TestLimit -> Bool
$c> :: TestLimit -> TestLimit -> Bool
> :: TestLimit -> TestLimit -> Bool
$c>= :: TestLimit -> TestLimit -> Bool
>= :: TestLimit -> TestLimit -> Bool
$cmax :: TestLimit -> TestLimit -> TestLimit
max :: TestLimit -> TestLimit -> TestLimit
$cmin :: TestLimit -> TestLimit -> TestLimit
min :: TestLimit -> TestLimit -> TestLimit
Ord, Int -> TestLimit -> String -> String
[TestLimit] -> String -> String
TestLimit -> String
(Int -> TestLimit -> String -> String)
-> (TestLimit -> String)
-> ([TestLimit] -> String -> String)
-> Show TestLimit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestLimit -> String -> String
showsPrec :: Int -> TestLimit -> String -> String
$cshow :: TestLimit -> String
show :: TestLimit -> String
$cshowList :: [TestLimit] -> String -> String
showList :: [TestLimit] -> String -> String
Show, Integer -> TestLimit
TestLimit -> TestLimit
TestLimit -> TestLimit -> TestLimit
(TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit)
-> (TestLimit -> TestLimit)
-> (TestLimit -> TestLimit)
-> (Integer -> TestLimit)
-> Num TestLimit
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TestLimit -> TestLimit -> TestLimit
+ :: TestLimit -> TestLimit -> TestLimit
$c- :: TestLimit -> TestLimit -> TestLimit
- :: TestLimit -> TestLimit -> TestLimit
$c* :: TestLimit -> TestLimit -> TestLimit
* :: TestLimit -> TestLimit -> TestLimit
$cnegate :: TestLimit -> TestLimit
negate :: TestLimit -> TestLimit
$cabs :: TestLimit -> TestLimit
abs :: TestLimit -> TestLimit
$csignum :: TestLimit -> TestLimit
signum :: TestLimit -> TestLimit
$cfromInteger :: Integer -> TestLimit
fromInteger :: Integer -> TestLimit
Num, Int -> TestLimit
TestLimit -> Int
TestLimit -> [TestLimit]
TestLimit -> TestLimit
TestLimit -> TestLimit -> [TestLimit]
TestLimit -> TestLimit -> TestLimit -> [TestLimit]
(TestLimit -> TestLimit)
-> (TestLimit -> TestLimit)
-> (Int -> TestLimit)
-> (TestLimit -> Int)
-> (TestLimit -> [TestLimit])
-> (TestLimit -> TestLimit -> [TestLimit])
-> (TestLimit -> TestLimit -> [TestLimit])
-> (TestLimit -> TestLimit -> TestLimit -> [TestLimit])
-> Enum TestLimit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TestLimit -> TestLimit
succ :: TestLimit -> TestLimit
$cpred :: TestLimit -> TestLimit
pred :: TestLimit -> TestLimit
$ctoEnum :: Int -> TestLimit
toEnum :: Int -> TestLimit
$cfromEnum :: TestLimit -> Int
fromEnum :: TestLimit -> Int
$cenumFrom :: TestLimit -> [TestLimit]
enumFrom :: TestLimit -> [TestLimit]
$cenumFromThen :: TestLimit -> TestLimit -> [TestLimit]
enumFromThen :: TestLimit -> TestLimit -> [TestLimit]
$cenumFromTo :: TestLimit -> TestLimit -> [TestLimit]
enumFromTo :: TestLimit -> TestLimit -> [TestLimit]
$cenumFromThenTo :: TestLimit -> TestLimit -> TestLimit -> [TestLimit]
enumFromThenTo :: TestLimit -> TestLimit -> TestLimit -> [TestLimit]
Enum, Num TestLimit
Ord TestLimit
(Num TestLimit, Ord TestLimit) =>
(TestLimit -> Rational) -> Real TestLimit
TestLimit -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: TestLimit -> Rational
toRational :: TestLimit -> Rational
Real, Enum TestLimit
Real TestLimit
(Real TestLimit, Enum TestLimit) =>
(TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> TestLimit)
-> (TestLimit -> TestLimit -> (TestLimit, TestLimit))
-> (TestLimit -> TestLimit -> (TestLimit, TestLimit))
-> (TestLimit -> Integer)
-> Integral TestLimit
TestLimit -> Integer
TestLimit -> TestLimit -> (TestLimit, TestLimit)
TestLimit -> TestLimit -> TestLimit
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: TestLimit -> TestLimit -> TestLimit
quot :: TestLimit -> TestLimit -> TestLimit
$crem :: TestLimit -> TestLimit -> TestLimit
rem :: TestLimit -> TestLimit -> TestLimit
$cdiv :: TestLimit -> TestLimit -> TestLimit
div :: TestLimit -> TestLimit -> TestLimit
$cmod :: TestLimit -> TestLimit -> TestLimit
mod :: TestLimit -> TestLimit -> TestLimit
$cquotRem :: TestLimit -> TestLimit -> (TestLimit, TestLimit)
quotRem :: TestLimit -> TestLimit -> (TestLimit, TestLimit)
$cdivMod :: TestLimit -> TestLimit -> (TestLimit, TestLimit)
divMod :: TestLimit -> TestLimit -> (TestLimit, TestLimit)
$ctoInteger :: TestLimit -> Integer
toInteger :: TestLimit -> Integer
Integral, (forall (m :: * -> *). Quote m => TestLimit -> m Exp)
-> (forall (m :: * -> *). Quote m => TestLimit -> Code m TestLimit)
-> Lift TestLimit
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TestLimit -> m Exp
forall (m :: * -> *). Quote m => TestLimit -> Code m TestLimit
$clift :: forall (m :: * -> *). Quote m => TestLimit -> m Exp
lift :: forall (m :: * -> *). Quote m => TestLimit -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TestLimit -> Code m TestLimit
liftTyped :: forall (m :: * -> *). Quote m => TestLimit -> Code m TestLimit
Lift)
newtype TestCount =
TestCount Int
deriving (TestCount -> TestCount -> Bool
(TestCount -> TestCount -> Bool)
-> (TestCount -> TestCount -> Bool) -> Eq TestCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestCount -> TestCount -> Bool
== :: TestCount -> TestCount -> Bool
$c/= :: TestCount -> TestCount -> Bool
/= :: TestCount -> TestCount -> Bool
Eq, Eq TestCount
Eq TestCount =>
(TestCount -> TestCount -> Ordering)
-> (TestCount -> TestCount -> Bool)
-> (TestCount -> TestCount -> Bool)
-> (TestCount -> TestCount -> Bool)
-> (TestCount -> TestCount -> Bool)
-> (TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> TestCount)
-> Ord TestCount
TestCount -> TestCount -> Bool
TestCount -> TestCount -> Ordering
TestCount -> TestCount -> TestCount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TestCount -> TestCount -> Ordering
compare :: TestCount -> TestCount -> Ordering
$c< :: TestCount -> TestCount -> Bool
< :: TestCount -> TestCount -> Bool
$c<= :: TestCount -> TestCount -> Bool
<= :: TestCount -> TestCount -> Bool
$c> :: TestCount -> TestCount -> Bool
> :: TestCount -> TestCount -> Bool
$c>= :: TestCount -> TestCount -> Bool
>= :: TestCount -> TestCount -> Bool
$cmax :: TestCount -> TestCount -> TestCount
max :: TestCount -> TestCount -> TestCount
$cmin :: TestCount -> TestCount -> TestCount
min :: TestCount -> TestCount -> TestCount
Ord, Int -> TestCount -> String -> String
[TestCount] -> String -> String
TestCount -> String
(Int -> TestCount -> String -> String)
-> (TestCount -> String)
-> ([TestCount] -> String -> String)
-> Show TestCount
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestCount -> String -> String
showsPrec :: Int -> TestCount -> String -> String
$cshow :: TestCount -> String
show :: TestCount -> String
$cshowList :: [TestCount] -> String -> String
showList :: [TestCount] -> String -> String
Show, Integer -> TestCount
TestCount -> TestCount
TestCount -> TestCount -> TestCount
(TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount)
-> (TestCount -> TestCount)
-> (TestCount -> TestCount)
-> (Integer -> TestCount)
-> Num TestCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TestCount -> TestCount -> TestCount
+ :: TestCount -> TestCount -> TestCount
$c- :: TestCount -> TestCount -> TestCount
- :: TestCount -> TestCount -> TestCount
$c* :: TestCount -> TestCount -> TestCount
* :: TestCount -> TestCount -> TestCount
$cnegate :: TestCount -> TestCount
negate :: TestCount -> TestCount
$cabs :: TestCount -> TestCount
abs :: TestCount -> TestCount
$csignum :: TestCount -> TestCount
signum :: TestCount -> TestCount
$cfromInteger :: Integer -> TestCount
fromInteger :: Integer -> TestCount
Num, Int -> TestCount
TestCount -> Int
TestCount -> [TestCount]
TestCount -> TestCount
TestCount -> TestCount -> [TestCount]
TestCount -> TestCount -> TestCount -> [TestCount]
(TestCount -> TestCount)
-> (TestCount -> TestCount)
-> (Int -> TestCount)
-> (TestCount -> Int)
-> (TestCount -> [TestCount])
-> (TestCount -> TestCount -> [TestCount])
-> (TestCount -> TestCount -> [TestCount])
-> (TestCount -> TestCount -> TestCount -> [TestCount])
-> Enum TestCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TestCount -> TestCount
succ :: TestCount -> TestCount
$cpred :: TestCount -> TestCount
pred :: TestCount -> TestCount
$ctoEnum :: Int -> TestCount
toEnum :: Int -> TestCount
$cfromEnum :: TestCount -> Int
fromEnum :: TestCount -> Int
$cenumFrom :: TestCount -> [TestCount]
enumFrom :: TestCount -> [TestCount]
$cenumFromThen :: TestCount -> TestCount -> [TestCount]
enumFromThen :: TestCount -> TestCount -> [TestCount]
$cenumFromTo :: TestCount -> TestCount -> [TestCount]
enumFromTo :: TestCount -> TestCount -> [TestCount]
$cenumFromThenTo :: TestCount -> TestCount -> TestCount -> [TestCount]
enumFromThenTo :: TestCount -> TestCount -> TestCount -> [TestCount]
Enum, Num TestCount
Ord TestCount
(Num TestCount, Ord TestCount) =>
(TestCount -> Rational) -> Real TestCount
TestCount -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: TestCount -> Rational
toRational :: TestCount -> Rational
Real, Enum TestCount
Real TestCount
(Real TestCount, Enum TestCount) =>
(TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> TestCount)
-> (TestCount -> TestCount -> (TestCount, TestCount))
-> (TestCount -> TestCount -> (TestCount, TestCount))
-> (TestCount -> Integer)
-> Integral TestCount
TestCount -> Integer
TestCount -> TestCount -> (TestCount, TestCount)
TestCount -> TestCount -> TestCount
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: TestCount -> TestCount -> TestCount
quot :: TestCount -> TestCount -> TestCount
$crem :: TestCount -> TestCount -> TestCount
rem :: TestCount -> TestCount -> TestCount
$cdiv :: TestCount -> TestCount -> TestCount
div :: TestCount -> TestCount -> TestCount
$cmod :: TestCount -> TestCount -> TestCount
mod :: TestCount -> TestCount -> TestCount
$cquotRem :: TestCount -> TestCount -> (TestCount, TestCount)
quotRem :: TestCount -> TestCount -> (TestCount, TestCount)
$cdivMod :: TestCount -> TestCount -> (TestCount, TestCount)
divMod :: TestCount -> TestCount -> (TestCount, TestCount)
$ctoInteger :: TestCount -> Integer
toInteger :: TestCount -> Integer
Integral, (forall (m :: * -> *). Quote m => TestCount -> m Exp)
-> (forall (m :: * -> *). Quote m => TestCount -> Code m TestCount)
-> Lift TestCount
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TestCount -> m Exp
forall (m :: * -> *). Quote m => TestCount -> Code m TestCount
$clift :: forall (m :: * -> *). Quote m => TestCount -> m Exp
lift :: forall (m :: * -> *). Quote m => TestCount -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TestCount -> Code m TestCount
liftTyped :: forall (m :: * -> *). Quote m => TestCount -> Code m TestCount
Lift)
newtype DiscardCount =
DiscardCount Int
deriving (DiscardCount -> DiscardCount -> Bool
(DiscardCount -> DiscardCount -> Bool)
-> (DiscardCount -> DiscardCount -> Bool) -> Eq DiscardCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiscardCount -> DiscardCount -> Bool
== :: DiscardCount -> DiscardCount -> Bool
$c/= :: DiscardCount -> DiscardCount -> Bool
/= :: DiscardCount -> DiscardCount -> Bool
Eq, Eq DiscardCount
Eq DiscardCount =>
(DiscardCount -> DiscardCount -> Ordering)
-> (DiscardCount -> DiscardCount -> Bool)
-> (DiscardCount -> DiscardCount -> Bool)
-> (DiscardCount -> DiscardCount -> Bool)
-> (DiscardCount -> DiscardCount -> Bool)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> Ord DiscardCount
DiscardCount -> DiscardCount -> Bool
DiscardCount -> DiscardCount -> Ordering
DiscardCount -> DiscardCount -> DiscardCount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DiscardCount -> DiscardCount -> Ordering
compare :: DiscardCount -> DiscardCount -> Ordering
$c< :: DiscardCount -> DiscardCount -> Bool
< :: DiscardCount -> DiscardCount -> Bool
$c<= :: DiscardCount -> DiscardCount -> Bool
<= :: DiscardCount -> DiscardCount -> Bool
$c> :: DiscardCount -> DiscardCount -> Bool
> :: DiscardCount -> DiscardCount -> Bool
$c>= :: DiscardCount -> DiscardCount -> Bool
>= :: DiscardCount -> DiscardCount -> Bool
$cmax :: DiscardCount -> DiscardCount -> DiscardCount
max :: DiscardCount -> DiscardCount -> DiscardCount
$cmin :: DiscardCount -> DiscardCount -> DiscardCount
min :: DiscardCount -> DiscardCount -> DiscardCount
Ord, Int -> DiscardCount -> String -> String
[DiscardCount] -> String -> String
DiscardCount -> String
(Int -> DiscardCount -> String -> String)
-> (DiscardCount -> String)
-> ([DiscardCount] -> String -> String)
-> Show DiscardCount
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DiscardCount -> String -> String
showsPrec :: Int -> DiscardCount -> String -> String
$cshow :: DiscardCount -> String
show :: DiscardCount -> String
$cshowList :: [DiscardCount] -> String -> String
showList :: [DiscardCount] -> String -> String
Show, Integer -> DiscardCount
DiscardCount -> DiscardCount
DiscardCount -> DiscardCount -> DiscardCount
(DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount)
-> (Integer -> DiscardCount)
-> Num DiscardCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: DiscardCount -> DiscardCount -> DiscardCount
+ :: DiscardCount -> DiscardCount -> DiscardCount
$c- :: DiscardCount -> DiscardCount -> DiscardCount
- :: DiscardCount -> DiscardCount -> DiscardCount
$c* :: DiscardCount -> DiscardCount -> DiscardCount
* :: DiscardCount -> DiscardCount -> DiscardCount
$cnegate :: DiscardCount -> DiscardCount
negate :: DiscardCount -> DiscardCount
$cabs :: DiscardCount -> DiscardCount
abs :: DiscardCount -> DiscardCount
$csignum :: DiscardCount -> DiscardCount
signum :: DiscardCount -> DiscardCount
$cfromInteger :: Integer -> DiscardCount
fromInteger :: Integer -> DiscardCount
Num, Int -> DiscardCount
DiscardCount -> Int
DiscardCount -> [DiscardCount]
DiscardCount -> DiscardCount
DiscardCount -> DiscardCount -> [DiscardCount]
DiscardCount -> DiscardCount -> DiscardCount -> [DiscardCount]
(DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount)
-> (Int -> DiscardCount)
-> (DiscardCount -> Int)
-> (DiscardCount -> [DiscardCount])
-> (DiscardCount -> DiscardCount -> [DiscardCount])
-> (DiscardCount -> DiscardCount -> [DiscardCount])
-> (DiscardCount -> DiscardCount -> DiscardCount -> [DiscardCount])
-> Enum DiscardCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DiscardCount -> DiscardCount
succ :: DiscardCount -> DiscardCount
$cpred :: DiscardCount -> DiscardCount
pred :: DiscardCount -> DiscardCount
$ctoEnum :: Int -> DiscardCount
toEnum :: Int -> DiscardCount
$cfromEnum :: DiscardCount -> Int
fromEnum :: DiscardCount -> Int
$cenumFrom :: DiscardCount -> [DiscardCount]
enumFrom :: DiscardCount -> [DiscardCount]
$cenumFromThen :: DiscardCount -> DiscardCount -> [DiscardCount]
enumFromThen :: DiscardCount -> DiscardCount -> [DiscardCount]
$cenumFromTo :: DiscardCount -> DiscardCount -> [DiscardCount]
enumFromTo :: DiscardCount -> DiscardCount -> [DiscardCount]
$cenumFromThenTo :: DiscardCount -> DiscardCount -> DiscardCount -> [DiscardCount]
enumFromThenTo :: DiscardCount -> DiscardCount -> DiscardCount -> [DiscardCount]
Enum, Num DiscardCount
Ord DiscardCount
(Num DiscardCount, Ord DiscardCount) =>
(DiscardCount -> Rational) -> Real DiscardCount
DiscardCount -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: DiscardCount -> Rational
toRational :: DiscardCount -> Rational
Real, Enum DiscardCount
Real DiscardCount
(Real DiscardCount, Enum DiscardCount) =>
(DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> DiscardCount)
-> (DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount))
-> (DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount))
-> (DiscardCount -> Integer)
-> Integral DiscardCount
DiscardCount -> Integer
DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount)
DiscardCount -> DiscardCount -> DiscardCount
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: DiscardCount -> DiscardCount -> DiscardCount
quot :: DiscardCount -> DiscardCount -> DiscardCount
$crem :: DiscardCount -> DiscardCount -> DiscardCount
rem :: DiscardCount -> DiscardCount -> DiscardCount
$cdiv :: DiscardCount -> DiscardCount -> DiscardCount
div :: DiscardCount -> DiscardCount -> DiscardCount
$cmod :: DiscardCount -> DiscardCount -> DiscardCount
mod :: DiscardCount -> DiscardCount -> DiscardCount
$cquotRem :: DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount)
quotRem :: DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount)
$cdivMod :: DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount)
divMod :: DiscardCount -> DiscardCount -> (DiscardCount, DiscardCount)
$ctoInteger :: DiscardCount -> Integer
toInteger :: DiscardCount -> Integer
Integral, (forall (m :: * -> *). Quote m => DiscardCount -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
DiscardCount -> Code m DiscardCount)
-> Lift DiscardCount
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => DiscardCount -> m Exp
forall (m :: * -> *).
Quote m =>
DiscardCount -> Code m DiscardCount
$clift :: forall (m :: * -> *). Quote m => DiscardCount -> m Exp
lift :: forall (m :: * -> *). Quote m => DiscardCount -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
DiscardCount -> Code m DiscardCount
liftTyped :: forall (m :: * -> *).
Quote m =>
DiscardCount -> Code m DiscardCount
Lift)
newtype DiscardLimit =
DiscardLimit Int
deriving (DiscardLimit -> DiscardLimit -> Bool
(DiscardLimit -> DiscardLimit -> Bool)
-> (DiscardLimit -> DiscardLimit -> Bool) -> Eq DiscardLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiscardLimit -> DiscardLimit -> Bool
== :: DiscardLimit -> DiscardLimit -> Bool
$c/= :: DiscardLimit -> DiscardLimit -> Bool
/= :: DiscardLimit -> DiscardLimit -> Bool
Eq, Eq DiscardLimit
Eq DiscardLimit =>
(DiscardLimit -> DiscardLimit -> Ordering)
-> (DiscardLimit -> DiscardLimit -> Bool)
-> (DiscardLimit -> DiscardLimit -> Bool)
-> (DiscardLimit -> DiscardLimit -> Bool)
-> (DiscardLimit -> DiscardLimit -> Bool)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> Ord DiscardLimit
DiscardLimit -> DiscardLimit -> Bool
DiscardLimit -> DiscardLimit -> Ordering
DiscardLimit -> DiscardLimit -> DiscardLimit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DiscardLimit -> DiscardLimit -> Ordering
compare :: DiscardLimit -> DiscardLimit -> Ordering
$c< :: DiscardLimit -> DiscardLimit -> Bool
< :: DiscardLimit -> DiscardLimit -> Bool
$c<= :: DiscardLimit -> DiscardLimit -> Bool
<= :: DiscardLimit -> DiscardLimit -> Bool
$c> :: DiscardLimit -> DiscardLimit -> Bool
> :: DiscardLimit -> DiscardLimit -> Bool
$c>= :: DiscardLimit -> DiscardLimit -> Bool
>= :: DiscardLimit -> DiscardLimit -> Bool
$cmax :: DiscardLimit -> DiscardLimit -> DiscardLimit
max :: DiscardLimit -> DiscardLimit -> DiscardLimit
$cmin :: DiscardLimit -> DiscardLimit -> DiscardLimit
min :: DiscardLimit -> DiscardLimit -> DiscardLimit
Ord, Int -> DiscardLimit -> String -> String
[DiscardLimit] -> String -> String
DiscardLimit -> String
(Int -> DiscardLimit -> String -> String)
-> (DiscardLimit -> String)
-> ([DiscardLimit] -> String -> String)
-> Show DiscardLimit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DiscardLimit -> String -> String
showsPrec :: Int -> DiscardLimit -> String -> String
$cshow :: DiscardLimit -> String
show :: DiscardLimit -> String
$cshowList :: [DiscardLimit] -> String -> String
showList :: [DiscardLimit] -> String -> String
Show, Integer -> DiscardLimit
DiscardLimit -> DiscardLimit
DiscardLimit -> DiscardLimit -> DiscardLimit
(DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit)
-> (Integer -> DiscardLimit)
-> Num DiscardLimit
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: DiscardLimit -> DiscardLimit -> DiscardLimit
+ :: DiscardLimit -> DiscardLimit -> DiscardLimit
$c- :: DiscardLimit -> DiscardLimit -> DiscardLimit
- :: DiscardLimit -> DiscardLimit -> DiscardLimit
$c* :: DiscardLimit -> DiscardLimit -> DiscardLimit
* :: DiscardLimit -> DiscardLimit -> DiscardLimit
$cnegate :: DiscardLimit -> DiscardLimit
negate :: DiscardLimit -> DiscardLimit
$cabs :: DiscardLimit -> DiscardLimit
abs :: DiscardLimit -> DiscardLimit
$csignum :: DiscardLimit -> DiscardLimit
signum :: DiscardLimit -> DiscardLimit
$cfromInteger :: Integer -> DiscardLimit
fromInteger :: Integer -> DiscardLimit
Num, Int -> DiscardLimit
DiscardLimit -> Int
DiscardLimit -> [DiscardLimit]
DiscardLimit -> DiscardLimit
DiscardLimit -> DiscardLimit -> [DiscardLimit]
DiscardLimit -> DiscardLimit -> DiscardLimit -> [DiscardLimit]
(DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit)
-> (Int -> DiscardLimit)
-> (DiscardLimit -> Int)
-> (DiscardLimit -> [DiscardLimit])
-> (DiscardLimit -> DiscardLimit -> [DiscardLimit])
-> (DiscardLimit -> DiscardLimit -> [DiscardLimit])
-> (DiscardLimit -> DiscardLimit -> DiscardLimit -> [DiscardLimit])
-> Enum DiscardLimit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DiscardLimit -> DiscardLimit
succ :: DiscardLimit -> DiscardLimit
$cpred :: DiscardLimit -> DiscardLimit
pred :: DiscardLimit -> DiscardLimit
$ctoEnum :: Int -> DiscardLimit
toEnum :: Int -> DiscardLimit
$cfromEnum :: DiscardLimit -> Int
fromEnum :: DiscardLimit -> Int
$cenumFrom :: DiscardLimit -> [DiscardLimit]
enumFrom :: DiscardLimit -> [DiscardLimit]
$cenumFromThen :: DiscardLimit -> DiscardLimit -> [DiscardLimit]
enumFromThen :: DiscardLimit -> DiscardLimit -> [DiscardLimit]
$cenumFromTo :: DiscardLimit -> DiscardLimit -> [DiscardLimit]
enumFromTo :: DiscardLimit -> DiscardLimit -> [DiscardLimit]
$cenumFromThenTo :: DiscardLimit -> DiscardLimit -> DiscardLimit -> [DiscardLimit]
enumFromThenTo :: DiscardLimit -> DiscardLimit -> DiscardLimit -> [DiscardLimit]
Enum, Num DiscardLimit
Ord DiscardLimit
(Num DiscardLimit, Ord DiscardLimit) =>
(DiscardLimit -> Rational) -> Real DiscardLimit
DiscardLimit -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: DiscardLimit -> Rational
toRational :: DiscardLimit -> Rational
Real, Enum DiscardLimit
Real DiscardLimit
(Real DiscardLimit, Enum DiscardLimit) =>
(DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> DiscardLimit)
-> (DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit))
-> (DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit))
-> (DiscardLimit -> Integer)
-> Integral DiscardLimit
DiscardLimit -> Integer
DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit)
DiscardLimit -> DiscardLimit -> DiscardLimit
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: DiscardLimit -> DiscardLimit -> DiscardLimit
quot :: DiscardLimit -> DiscardLimit -> DiscardLimit
$crem :: DiscardLimit -> DiscardLimit -> DiscardLimit
rem :: DiscardLimit -> DiscardLimit -> DiscardLimit
$cdiv :: DiscardLimit -> DiscardLimit -> DiscardLimit
div :: DiscardLimit -> DiscardLimit -> DiscardLimit
$cmod :: DiscardLimit -> DiscardLimit -> DiscardLimit
mod :: DiscardLimit -> DiscardLimit -> DiscardLimit
$cquotRem :: DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit)
quotRem :: DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit)
$cdivMod :: DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit)
divMod :: DiscardLimit -> DiscardLimit -> (DiscardLimit, DiscardLimit)
$ctoInteger :: DiscardLimit -> Integer
toInteger :: DiscardLimit -> Integer
Integral, (forall (m :: * -> *). Quote m => DiscardLimit -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
DiscardLimit -> Code m DiscardLimit)
-> Lift DiscardLimit
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => DiscardLimit -> m Exp
forall (m :: * -> *).
Quote m =>
DiscardLimit -> Code m DiscardLimit
$clift :: forall (m :: * -> *). Quote m => DiscardLimit -> m Exp
lift :: forall (m :: * -> *). Quote m => DiscardLimit -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
DiscardLimit -> Code m DiscardLimit
liftTyped :: forall (m :: * -> *).
Quote m =>
DiscardLimit -> Code m DiscardLimit
Lift)
newtype ShrinkLimit =
ShrinkLimit Int
deriving (ShrinkLimit -> ShrinkLimit -> Bool
(ShrinkLimit -> ShrinkLimit -> Bool)
-> (ShrinkLimit -> ShrinkLimit -> Bool) -> Eq ShrinkLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShrinkLimit -> ShrinkLimit -> Bool
== :: ShrinkLimit -> ShrinkLimit -> Bool
$c/= :: ShrinkLimit -> ShrinkLimit -> Bool
/= :: ShrinkLimit -> ShrinkLimit -> Bool
Eq, Eq ShrinkLimit
Eq ShrinkLimit =>
(ShrinkLimit -> ShrinkLimit -> Ordering)
-> (ShrinkLimit -> ShrinkLimit -> Bool)
-> (ShrinkLimit -> ShrinkLimit -> Bool)
-> (ShrinkLimit -> ShrinkLimit -> Bool)
-> (ShrinkLimit -> ShrinkLimit -> Bool)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> Ord ShrinkLimit
ShrinkLimit -> ShrinkLimit -> Bool
ShrinkLimit -> ShrinkLimit -> Ordering
ShrinkLimit -> ShrinkLimit -> ShrinkLimit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShrinkLimit -> ShrinkLimit -> Ordering
compare :: ShrinkLimit -> ShrinkLimit -> Ordering
$c< :: ShrinkLimit -> ShrinkLimit -> Bool
< :: ShrinkLimit -> ShrinkLimit -> Bool
$c<= :: ShrinkLimit -> ShrinkLimit -> Bool
<= :: ShrinkLimit -> ShrinkLimit -> Bool
$c> :: ShrinkLimit -> ShrinkLimit -> Bool
> :: ShrinkLimit -> ShrinkLimit -> Bool
$c>= :: ShrinkLimit -> ShrinkLimit -> Bool
>= :: ShrinkLimit -> ShrinkLimit -> Bool
$cmax :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
max :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$cmin :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
min :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
Ord, Int -> ShrinkLimit -> String -> String
[ShrinkLimit] -> String -> String
ShrinkLimit -> String
(Int -> ShrinkLimit -> String -> String)
-> (ShrinkLimit -> String)
-> ([ShrinkLimit] -> String -> String)
-> Show ShrinkLimit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ShrinkLimit -> String -> String
showsPrec :: Int -> ShrinkLimit -> String -> String
$cshow :: ShrinkLimit -> String
show :: ShrinkLimit -> String
$cshowList :: [ShrinkLimit] -> String -> String
showList :: [ShrinkLimit] -> String -> String
Show, Integer -> ShrinkLimit
ShrinkLimit -> ShrinkLimit
ShrinkLimit -> ShrinkLimit -> ShrinkLimit
(ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit)
-> (Integer -> ShrinkLimit)
-> Num ShrinkLimit
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
+ :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$c- :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
- :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$c* :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
* :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$cnegate :: ShrinkLimit -> ShrinkLimit
negate :: ShrinkLimit -> ShrinkLimit
$cabs :: ShrinkLimit -> ShrinkLimit
abs :: ShrinkLimit -> ShrinkLimit
$csignum :: ShrinkLimit -> ShrinkLimit
signum :: ShrinkLimit -> ShrinkLimit
$cfromInteger :: Integer -> ShrinkLimit
fromInteger :: Integer -> ShrinkLimit
Num, Int -> ShrinkLimit
ShrinkLimit -> Int
ShrinkLimit -> [ShrinkLimit]
ShrinkLimit -> ShrinkLimit
ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
ShrinkLimit -> ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
(ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit)
-> (Int -> ShrinkLimit)
-> (ShrinkLimit -> Int)
-> (ShrinkLimit -> [ShrinkLimit])
-> (ShrinkLimit -> ShrinkLimit -> [ShrinkLimit])
-> (ShrinkLimit -> ShrinkLimit -> [ShrinkLimit])
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit -> [ShrinkLimit])
-> Enum ShrinkLimit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ShrinkLimit -> ShrinkLimit
succ :: ShrinkLimit -> ShrinkLimit
$cpred :: ShrinkLimit -> ShrinkLimit
pred :: ShrinkLimit -> ShrinkLimit
$ctoEnum :: Int -> ShrinkLimit
toEnum :: Int -> ShrinkLimit
$cfromEnum :: ShrinkLimit -> Int
fromEnum :: ShrinkLimit -> Int
$cenumFrom :: ShrinkLimit -> [ShrinkLimit]
enumFrom :: ShrinkLimit -> [ShrinkLimit]
$cenumFromThen :: ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
enumFromThen :: ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
$cenumFromTo :: ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
enumFromTo :: ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
$cenumFromThenTo :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
enumFromThenTo :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit -> [ShrinkLimit]
Enum, Num ShrinkLimit
Ord ShrinkLimit
(Num ShrinkLimit, Ord ShrinkLimit) =>
(ShrinkLimit -> Rational) -> Real ShrinkLimit
ShrinkLimit -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ShrinkLimit -> Rational
toRational :: ShrinkLimit -> Rational
Real, Enum ShrinkLimit
Real ShrinkLimit
(Real ShrinkLimit, Enum ShrinkLimit) =>
(ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> ShrinkLimit)
-> (ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit))
-> (ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit))
-> (ShrinkLimit -> Integer)
-> Integral ShrinkLimit
ShrinkLimit -> Integer
ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit)
ShrinkLimit -> ShrinkLimit -> ShrinkLimit
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
quot :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$crem :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
rem :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$cdiv :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
div :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$cmod :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
mod :: ShrinkLimit -> ShrinkLimit -> ShrinkLimit
$cquotRem :: ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit)
quotRem :: ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit)
$cdivMod :: ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit)
divMod :: ShrinkLimit -> ShrinkLimit -> (ShrinkLimit, ShrinkLimit)
$ctoInteger :: ShrinkLimit -> Integer
toInteger :: ShrinkLimit -> Integer
Integral, (forall (m :: * -> *). Quote m => ShrinkLimit -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ShrinkLimit -> Code m ShrinkLimit)
-> Lift ShrinkLimit
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShrinkLimit -> m Exp
forall (m :: * -> *). Quote m => ShrinkLimit -> Code m ShrinkLimit
$clift :: forall (m :: * -> *). Quote m => ShrinkLimit -> m Exp
lift :: forall (m :: * -> *). Quote m => ShrinkLimit -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ShrinkLimit -> Code m ShrinkLimit
liftTyped :: forall (m :: * -> *). Quote m => ShrinkLimit -> Code m ShrinkLimit
Lift)
newtype ShrinkCount =
ShrinkCount Int
deriving (ShrinkCount -> ShrinkCount -> Bool
(ShrinkCount -> ShrinkCount -> Bool)
-> (ShrinkCount -> ShrinkCount -> Bool) -> Eq ShrinkCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShrinkCount -> ShrinkCount -> Bool
== :: ShrinkCount -> ShrinkCount -> Bool
$c/= :: ShrinkCount -> ShrinkCount -> Bool
/= :: ShrinkCount -> ShrinkCount -> Bool
Eq, Eq ShrinkCount
Eq ShrinkCount =>
(ShrinkCount -> ShrinkCount -> Ordering)
-> (ShrinkCount -> ShrinkCount -> Bool)
-> (ShrinkCount -> ShrinkCount -> Bool)
-> (ShrinkCount -> ShrinkCount -> Bool)
-> (ShrinkCount -> ShrinkCount -> Bool)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> Ord ShrinkCount
ShrinkCount -> ShrinkCount -> Bool
ShrinkCount -> ShrinkCount -> Ordering
ShrinkCount -> ShrinkCount -> ShrinkCount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShrinkCount -> ShrinkCount -> Ordering
compare :: ShrinkCount -> ShrinkCount -> Ordering
$c< :: ShrinkCount -> ShrinkCount -> Bool
< :: ShrinkCount -> ShrinkCount -> Bool
$c<= :: ShrinkCount -> ShrinkCount -> Bool
<= :: ShrinkCount -> ShrinkCount -> Bool
$c> :: ShrinkCount -> ShrinkCount -> Bool
> :: ShrinkCount -> ShrinkCount -> Bool
$c>= :: ShrinkCount -> ShrinkCount -> Bool
>= :: ShrinkCount -> ShrinkCount -> Bool
$cmax :: ShrinkCount -> ShrinkCount -> ShrinkCount
max :: ShrinkCount -> ShrinkCount -> ShrinkCount
$cmin :: ShrinkCount -> ShrinkCount -> ShrinkCount
min :: ShrinkCount -> ShrinkCount -> ShrinkCount
Ord, Int -> ShrinkCount -> String -> String
[ShrinkCount] -> String -> String
ShrinkCount -> String
(Int -> ShrinkCount -> String -> String)
-> (ShrinkCount -> String)
-> ([ShrinkCount] -> String -> String)
-> Show ShrinkCount
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ShrinkCount -> String -> String
showsPrec :: Int -> ShrinkCount -> String -> String
$cshow :: ShrinkCount -> String
show :: ShrinkCount -> String
$cshowList :: [ShrinkCount] -> String -> String
showList :: [ShrinkCount] -> String -> String
Show, Integer -> ShrinkCount
ShrinkCount -> ShrinkCount
ShrinkCount -> ShrinkCount -> ShrinkCount
(ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount)
-> (Integer -> ShrinkCount)
-> Num ShrinkCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ShrinkCount -> ShrinkCount -> ShrinkCount
+ :: ShrinkCount -> ShrinkCount -> ShrinkCount
$c- :: ShrinkCount -> ShrinkCount -> ShrinkCount
- :: ShrinkCount -> ShrinkCount -> ShrinkCount
$c* :: ShrinkCount -> ShrinkCount -> ShrinkCount
* :: ShrinkCount -> ShrinkCount -> ShrinkCount
$cnegate :: ShrinkCount -> ShrinkCount
negate :: ShrinkCount -> ShrinkCount
$cabs :: ShrinkCount -> ShrinkCount
abs :: ShrinkCount -> ShrinkCount
$csignum :: ShrinkCount -> ShrinkCount
signum :: ShrinkCount -> ShrinkCount
$cfromInteger :: Integer -> ShrinkCount
fromInteger :: Integer -> ShrinkCount
Num, Int -> ShrinkCount
ShrinkCount -> Int
ShrinkCount -> [ShrinkCount]
ShrinkCount -> ShrinkCount
ShrinkCount -> ShrinkCount -> [ShrinkCount]
ShrinkCount -> ShrinkCount -> ShrinkCount -> [ShrinkCount]
(ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount)
-> (Int -> ShrinkCount)
-> (ShrinkCount -> Int)
-> (ShrinkCount -> [ShrinkCount])
-> (ShrinkCount -> ShrinkCount -> [ShrinkCount])
-> (ShrinkCount -> ShrinkCount -> [ShrinkCount])
-> (ShrinkCount -> ShrinkCount -> ShrinkCount -> [ShrinkCount])
-> Enum ShrinkCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ShrinkCount -> ShrinkCount
succ :: ShrinkCount -> ShrinkCount
$cpred :: ShrinkCount -> ShrinkCount
pred :: ShrinkCount -> ShrinkCount
$ctoEnum :: Int -> ShrinkCount
toEnum :: Int -> ShrinkCount
$cfromEnum :: ShrinkCount -> Int
fromEnum :: ShrinkCount -> Int
$cenumFrom :: ShrinkCount -> [ShrinkCount]
enumFrom :: ShrinkCount -> [ShrinkCount]
$cenumFromThen :: ShrinkCount -> ShrinkCount -> [ShrinkCount]
enumFromThen :: ShrinkCount -> ShrinkCount -> [ShrinkCount]
$cenumFromTo :: ShrinkCount -> ShrinkCount -> [ShrinkCount]
enumFromTo :: ShrinkCount -> ShrinkCount -> [ShrinkCount]
$cenumFromThenTo :: ShrinkCount -> ShrinkCount -> ShrinkCount -> [ShrinkCount]
enumFromThenTo :: ShrinkCount -> ShrinkCount -> ShrinkCount -> [ShrinkCount]
Enum, Num ShrinkCount
Ord ShrinkCount
(Num ShrinkCount, Ord ShrinkCount) =>
(ShrinkCount -> Rational) -> Real ShrinkCount
ShrinkCount -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ShrinkCount -> Rational
toRational :: ShrinkCount -> Rational
Real, Enum ShrinkCount
Real ShrinkCount
(Real ShrinkCount, Enum ShrinkCount) =>
(ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> ShrinkCount)
-> (ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount))
-> (ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount))
-> (ShrinkCount -> Integer)
-> Integral ShrinkCount
ShrinkCount -> Integer
ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount)
ShrinkCount -> ShrinkCount -> ShrinkCount
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ShrinkCount -> ShrinkCount -> ShrinkCount
quot :: ShrinkCount -> ShrinkCount -> ShrinkCount
$crem :: ShrinkCount -> ShrinkCount -> ShrinkCount
rem :: ShrinkCount -> ShrinkCount -> ShrinkCount
$cdiv :: ShrinkCount -> ShrinkCount -> ShrinkCount
div :: ShrinkCount -> ShrinkCount -> ShrinkCount
$cmod :: ShrinkCount -> ShrinkCount -> ShrinkCount
mod :: ShrinkCount -> ShrinkCount -> ShrinkCount
$cquotRem :: ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount)
quotRem :: ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount)
$cdivMod :: ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount)
divMod :: ShrinkCount -> ShrinkCount -> (ShrinkCount, ShrinkCount)
$ctoInteger :: ShrinkCount -> Integer
toInteger :: ShrinkCount -> Integer
Integral)
data Skip =
SkipNothing
| SkipToTest TestCount DiscardCount
| SkipToShrink TestCount DiscardCount ShrinkPath
deriving (Skip -> Skip -> Bool
(Skip -> Skip -> Bool) -> (Skip -> Skip -> Bool) -> Eq Skip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Skip -> Skip -> Bool
== :: Skip -> Skip -> Bool
$c/= :: Skip -> Skip -> Bool
/= :: Skip -> Skip -> Bool
Eq, Eq Skip
Eq Skip =>
(Skip -> Skip -> Ordering)
-> (Skip -> Skip -> Bool)
-> (Skip -> Skip -> Bool)
-> (Skip -> Skip -> Bool)
-> (Skip -> Skip -> Bool)
-> (Skip -> Skip -> Skip)
-> (Skip -> Skip -> Skip)
-> Ord Skip
Skip -> Skip -> Bool
Skip -> Skip -> Ordering
Skip -> Skip -> Skip
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Skip -> Skip -> Ordering
compare :: Skip -> Skip -> Ordering
$c< :: Skip -> Skip -> Bool
< :: Skip -> Skip -> Bool
$c<= :: Skip -> Skip -> Bool
<= :: Skip -> Skip -> Bool
$c> :: Skip -> Skip -> Bool
> :: Skip -> Skip -> Bool
$c>= :: Skip -> Skip -> Bool
>= :: Skip -> Skip -> Bool
$cmax :: Skip -> Skip -> Skip
max :: Skip -> Skip -> Skip
$cmin :: Skip -> Skip -> Skip
min :: Skip -> Skip -> Skip
Ord, Int -> Skip -> String -> String
[Skip] -> String -> String
Skip -> String
(Int -> Skip -> String -> String)
-> (Skip -> String) -> ([Skip] -> String -> String) -> Show Skip
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Skip -> String -> String
showsPrec :: Int -> Skip -> String -> String
$cshow :: Skip -> String
show :: Skip -> String
$cshowList :: [Skip] -> String -> String
showList :: [Skip] -> String -> String
Show, (forall (m :: * -> *). Quote m => Skip -> m Exp)
-> (forall (m :: * -> *). Quote m => Skip -> Code m Skip)
-> Lift Skip
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Skip -> m Exp
forall (m :: * -> *). Quote m => Skip -> Code m Skip
$clift :: forall (m :: * -> *). Quote m => Skip -> m Exp
lift :: forall (m :: * -> *). Quote m => Skip -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Skip -> Code m Skip
liftTyped :: forall (m :: * -> *). Quote m => Skip -> Code m Skip
Lift)
instance IsString Skip where
fromString :: String -> Skip
fromString String
s =
case String -> Maybe Skip
skipDecompress String
s of
Maybe Skip
Nothing ->
String -> Skip
forall a. HasCallStack => String -> a
error (String -> Skip) -> String -> Skip
forall a b. (a -> b) -> a -> b
$ String
"fromString: Not a valid Skip: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
Just Skip
skip ->
Skip
skip
newtype ShrinkPath =
ShrinkPath [Int]
deriving (ShrinkPath -> ShrinkPath -> Bool
(ShrinkPath -> ShrinkPath -> Bool)
-> (ShrinkPath -> ShrinkPath -> Bool) -> Eq ShrinkPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShrinkPath -> ShrinkPath -> Bool
== :: ShrinkPath -> ShrinkPath -> Bool
$c/= :: ShrinkPath -> ShrinkPath -> Bool
/= :: ShrinkPath -> ShrinkPath -> Bool
Eq, Eq ShrinkPath
Eq ShrinkPath =>
(ShrinkPath -> ShrinkPath -> Ordering)
-> (ShrinkPath -> ShrinkPath -> Bool)
-> (ShrinkPath -> ShrinkPath -> Bool)
-> (ShrinkPath -> ShrinkPath -> Bool)
-> (ShrinkPath -> ShrinkPath -> Bool)
-> (ShrinkPath -> ShrinkPath -> ShrinkPath)
-> (ShrinkPath -> ShrinkPath -> ShrinkPath)
-> Ord ShrinkPath
ShrinkPath -> ShrinkPath -> Bool
ShrinkPath -> ShrinkPath -> Ordering
ShrinkPath -> ShrinkPath -> ShrinkPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShrinkPath -> ShrinkPath -> Ordering
compare :: ShrinkPath -> ShrinkPath -> Ordering
$c< :: ShrinkPath -> ShrinkPath -> Bool
< :: ShrinkPath -> ShrinkPath -> Bool
$c<= :: ShrinkPath -> ShrinkPath -> Bool
<= :: ShrinkPath -> ShrinkPath -> Bool
$c> :: ShrinkPath -> ShrinkPath -> Bool
> :: ShrinkPath -> ShrinkPath -> Bool
$c>= :: ShrinkPath -> ShrinkPath -> Bool
>= :: ShrinkPath -> ShrinkPath -> Bool
$cmax :: ShrinkPath -> ShrinkPath -> ShrinkPath
max :: ShrinkPath -> ShrinkPath -> ShrinkPath
$cmin :: ShrinkPath -> ShrinkPath -> ShrinkPath
min :: ShrinkPath -> ShrinkPath -> ShrinkPath
Ord, Int -> ShrinkPath -> String -> String
[ShrinkPath] -> String -> String
ShrinkPath -> String
(Int -> ShrinkPath -> String -> String)
-> (ShrinkPath -> String)
-> ([ShrinkPath] -> String -> String)
-> Show ShrinkPath
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ShrinkPath -> String -> String
showsPrec :: Int -> ShrinkPath -> String -> String
$cshow :: ShrinkPath -> String
show :: ShrinkPath -> String
$cshowList :: [ShrinkPath] -> String -> String
showList :: [ShrinkPath] -> String -> String
Show, (forall (m :: * -> *). Quote m => ShrinkPath -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ShrinkPath -> Code m ShrinkPath)
-> Lift ShrinkPath
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShrinkPath -> m Exp
forall (m :: * -> *). Quote m => ShrinkPath -> Code m ShrinkPath
$clift :: forall (m :: * -> *). Quote m => ShrinkPath -> m Exp
lift :: forall (m :: * -> *). Quote m => ShrinkPath -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ShrinkPath -> Code m ShrinkPath
liftTyped :: forall (m :: * -> *). Quote m => ShrinkPath -> Code m ShrinkPath
Lift)
skipCompress :: Skip -> String
skipCompress :: Skip -> String
skipCompress =
let
showTD :: TestCount -> DiscardCount -> String
showTD (TestCount Int
t) (DiscardCount Int
d) =
Int -> String
forall a. Show a => a -> String
show Int
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d)
in \case
Skip
SkipNothing ->
String
""
SkipToTest TestCount
t DiscardCount
d->
TestCount -> DiscardCount -> String
showTD TestCount
t DiscardCount
d
SkipToShrink TestCount
t DiscardCount
d ShrinkPath
sp ->
TestCount -> DiscardCount -> String
showTD TestCount
t DiscardCount
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ShrinkPath -> String
shrinkPathCompress ShrinkPath
sp
shrinkPathCompress :: ShrinkPath -> String
shrinkPathCompress :: ShrinkPath -> String
shrinkPathCompress (ShrinkPath [Int]
sp) =
let
groups :: [(Int, Int)]
groups = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\[Int]
l -> ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
l, [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
l)) ([[Int]] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
List.group [Int]
sp
in
([String -> String] -> String -> String
forall a. Monoid a => [a] -> a
mconcat
([String -> String] -> String -> String)
-> [String -> String] -> String -> String
forall a b. (a -> b) -> a -> b
$ (String -> (Int, Int) -> String -> String)
-> [String] -> [(Int, Int)] -> [String -> String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\String
alphabet (Int
loc, Int
count) ->
Int -> (Int -> Char) -> Int -> String -> String
forall a. Integral a => a -> (Int -> Char) -> a -> String -> String
Numeric.showIntAtBase Int
26 (String
alphabet String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!!) Int
loc
(String -> String) -> (String -> String) -> String -> String
forall a. Semigroup a => a -> a -> a
<> if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String -> String
forall a. Monoid a => a
mempty else Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
count
)
([String] -> [String]
forall a. HasCallStack => [a] -> [a]
cycle [[Char
'a'..Char
'z'], [Char
'A'..Char
'Z']])
[(Int, Int)]
groups
)
String
""
skipDecompress :: String -> Maybe Skip
skipDecompress :: String -> Maybe Skip
skipDecompress String
str =
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str then
Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
SkipNothing
else do
let
(String
tcDcStr, String
spStr)
= (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
str
(String
tcStr, String
dcStr)
= (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
tcDcStr
TestCount
tc <- Int -> TestCount
TestCount (Int -> TestCount) -> Maybe Int -> Maybe TestCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
tcStr
DiscardCount
dc <- Int -> DiscardCount
DiscardCount (Int -> DiscardCount) -> Maybe Int -> Maybe DiscardCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dcStr
then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
else String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
dcStr)
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
spStr then
Skip -> Maybe Skip
forall a. a -> Maybe a
Just (Skip -> Maybe Skip) -> Skip -> Maybe Skip
forall a b. (a -> b) -> a -> b
$ TestCount -> DiscardCount -> Skip
SkipToTest TestCount
tc DiscardCount
dc
else do
ShrinkPath
sp <- String -> Maybe ShrinkPath
shrinkPathDecompress (String -> Maybe ShrinkPath) -> String -> Maybe ShrinkPath
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
spStr
Skip -> Maybe Skip
forall a. a -> Maybe a
Just (Skip -> Maybe Skip) -> Skip -> Maybe Skip
forall a b. (a -> b) -> a -> b
$ TestCount -> DiscardCount -> ShrinkPath -> Skip
SkipToShrink TestCount
tc DiscardCount
dc ShrinkPath
sp
shrinkPathDecompress :: String -> Maybe ShrinkPath
shrinkPathDecompress :: String -> Maybe ShrinkPath
shrinkPathDecompress String
str =
let
isDigit :: Char -> Bool
isDigit Char
c = Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
isLower :: Char -> Bool
isLower Char
c = Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
isUpper :: Char -> Bool
isUpper Char
c = Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z'
classifyChar :: Char -> (Bool, Bool, Bool)
classifyChar Char
c = (Char -> Bool
isDigit Char
c, Char -> Bool
isLower Char
c, Char -> Bool
isUpper Char
c)
readSNum :: String -> [(a, String)]
readSNum String
"" = []
readSNum s :: String
s@(Char
c1:String
_) =
if Char -> Bool
isDigit Char
c1 then
a -> (Char -> Bool) -> (Char -> Int) -> String -> [(a, String)]
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Numeric.readInt a
10 Char -> Bool
isDigit (\Char
c -> Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0') String
s
else if Char -> Bool
isLower Char
c1 then
a -> (Char -> Bool) -> (Char -> Int) -> String -> [(a, String)]
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Numeric.readInt a
26 Char -> Bool
isLower (\Char
c -> Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a') String
s
else if Char -> Bool
isUpper Char
c1 then
a -> (Char -> Bool) -> (Char -> Int) -> String -> [(a, String)]
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Numeric.readInt a
26 Char -> Bool
isUpper (\Char
c -> Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'A') String
s
else
[]
readNumMaybe :: String -> Maybe a
readNumMaybe String
s =
case String -> [(a, String)]
forall {a}. Num a => String -> [(a, String)]
readSNum String
s of
[(a
num, String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
num
[(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing
[(Maybe Int, Maybe Int)]
spGroups :: [(Maybe Int, Maybe Int)] =
let
go :: String -> [(Maybe a, Maybe a)]
go [] =
[]
go (Char
c1:String
cs) =
let
(String
hd, String
tl1) =
(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char -> (Bool, Bool, Bool)
classifyChar Char
c (Bool, Bool, Bool) -> (Bool, Bool, Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> (Bool, Bool, Bool)
classifyChar Char
c1) String
cs
(String
digs, String
tl2) =
(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
tl1
in
( String -> Maybe a
forall {a}. Num a => String -> Maybe a
readNumMaybe (Char
c1Char -> String -> String
forall a. a -> [a] -> [a]
:String
hd)
, String -> Maybe a
forall {a}. Num a => String -> Maybe a
readNumMaybe (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
digs then String
"1" else String
digs
)
(Maybe a, Maybe a) -> [(Maybe a, Maybe a)] -> [(Maybe a, Maybe a)]
forall a. a -> [a] -> [a]
: String -> [(Maybe a, Maybe a)]
go String
tl2
in
String -> [(Maybe Int, Maybe Int)]
forall {a} {a}. (Num a, Num a) => String -> [(Maybe a, Maybe a)]
go String
str
in do
[Int]
sp <- [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> Maybe [[Int]] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
((Maybe Int, Maybe Int) -> Maybe [Int])
-> [(Maybe Int, Maybe Int)] -> Maybe [[Int]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Maybe Int
mNum, Maybe Int
mCount) -> Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int -> Int -> [Int]) -> Maybe Int -> Maybe (Int -> [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mCount Maybe (Int -> [Int]) -> Maybe Int -> Maybe [Int]
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mNum) [(Maybe Int, Maybe Int)]
spGroups
ShrinkPath -> Maybe ShrinkPath
forall a. a -> Maybe a
Just (ShrinkPath -> Maybe ShrinkPath) -> ShrinkPath -> Maybe ShrinkPath
forall a b. (a -> b) -> a -> b
$ [Int] -> ShrinkPath
ShrinkPath [Int]
sp
newtype ShrinkRetries =
ShrinkRetries Int
deriving (ShrinkRetries -> ShrinkRetries -> Bool
(ShrinkRetries -> ShrinkRetries -> Bool)
-> (ShrinkRetries -> ShrinkRetries -> Bool) -> Eq ShrinkRetries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShrinkRetries -> ShrinkRetries -> Bool
== :: ShrinkRetries -> ShrinkRetries -> Bool
$c/= :: ShrinkRetries -> ShrinkRetries -> Bool
/= :: ShrinkRetries -> ShrinkRetries -> Bool
Eq, Eq ShrinkRetries
Eq ShrinkRetries =>
(ShrinkRetries -> ShrinkRetries -> Ordering)
-> (ShrinkRetries -> ShrinkRetries -> Bool)
-> (ShrinkRetries -> ShrinkRetries -> Bool)
-> (ShrinkRetries -> ShrinkRetries -> Bool)
-> (ShrinkRetries -> ShrinkRetries -> Bool)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> Ord ShrinkRetries
ShrinkRetries -> ShrinkRetries -> Bool
ShrinkRetries -> ShrinkRetries -> Ordering
ShrinkRetries -> ShrinkRetries -> ShrinkRetries
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShrinkRetries -> ShrinkRetries -> Ordering
compare :: ShrinkRetries -> ShrinkRetries -> Ordering
$c< :: ShrinkRetries -> ShrinkRetries -> Bool
< :: ShrinkRetries -> ShrinkRetries -> Bool
$c<= :: ShrinkRetries -> ShrinkRetries -> Bool
<= :: ShrinkRetries -> ShrinkRetries -> Bool
$c> :: ShrinkRetries -> ShrinkRetries -> Bool
> :: ShrinkRetries -> ShrinkRetries -> Bool
$c>= :: ShrinkRetries -> ShrinkRetries -> Bool
>= :: ShrinkRetries -> ShrinkRetries -> Bool
$cmax :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
max :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$cmin :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
min :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
Ord, Int -> ShrinkRetries -> String -> String
[ShrinkRetries] -> String -> String
ShrinkRetries -> String
(Int -> ShrinkRetries -> String -> String)
-> (ShrinkRetries -> String)
-> ([ShrinkRetries] -> String -> String)
-> Show ShrinkRetries
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ShrinkRetries -> String -> String
showsPrec :: Int -> ShrinkRetries -> String -> String
$cshow :: ShrinkRetries -> String
show :: ShrinkRetries -> String
$cshowList :: [ShrinkRetries] -> String -> String
showList :: [ShrinkRetries] -> String -> String
Show, Integer -> ShrinkRetries
ShrinkRetries -> ShrinkRetries
ShrinkRetries -> ShrinkRetries -> ShrinkRetries
(ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries)
-> (Integer -> ShrinkRetries)
-> Num ShrinkRetries
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
+ :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$c- :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
- :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$c* :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
* :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$cnegate :: ShrinkRetries -> ShrinkRetries
negate :: ShrinkRetries -> ShrinkRetries
$cabs :: ShrinkRetries -> ShrinkRetries
abs :: ShrinkRetries -> ShrinkRetries
$csignum :: ShrinkRetries -> ShrinkRetries
signum :: ShrinkRetries -> ShrinkRetries
$cfromInteger :: Integer -> ShrinkRetries
fromInteger :: Integer -> ShrinkRetries
Num, Int -> ShrinkRetries
ShrinkRetries -> Int
ShrinkRetries -> [ShrinkRetries]
ShrinkRetries -> ShrinkRetries
ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
ShrinkRetries -> ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
(ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries)
-> (Int -> ShrinkRetries)
-> (ShrinkRetries -> Int)
-> (ShrinkRetries -> [ShrinkRetries])
-> (ShrinkRetries -> ShrinkRetries -> [ShrinkRetries])
-> (ShrinkRetries -> ShrinkRetries -> [ShrinkRetries])
-> (ShrinkRetries
-> ShrinkRetries -> ShrinkRetries -> [ShrinkRetries])
-> Enum ShrinkRetries
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ShrinkRetries -> ShrinkRetries
succ :: ShrinkRetries -> ShrinkRetries
$cpred :: ShrinkRetries -> ShrinkRetries
pred :: ShrinkRetries -> ShrinkRetries
$ctoEnum :: Int -> ShrinkRetries
toEnum :: Int -> ShrinkRetries
$cfromEnum :: ShrinkRetries -> Int
fromEnum :: ShrinkRetries -> Int
$cenumFrom :: ShrinkRetries -> [ShrinkRetries]
enumFrom :: ShrinkRetries -> [ShrinkRetries]
$cenumFromThen :: ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
enumFromThen :: ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
$cenumFromTo :: ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
enumFromTo :: ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
$cenumFromThenTo :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
enumFromThenTo :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries -> [ShrinkRetries]
Enum, Num ShrinkRetries
Ord ShrinkRetries
(Num ShrinkRetries, Ord ShrinkRetries) =>
(ShrinkRetries -> Rational) -> Real ShrinkRetries
ShrinkRetries -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ShrinkRetries -> Rational
toRational :: ShrinkRetries -> Rational
Real, Enum ShrinkRetries
Real ShrinkRetries
(Real ShrinkRetries, Enum ShrinkRetries) =>
(ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries -> ShrinkRetries -> ShrinkRetries)
-> (ShrinkRetries
-> ShrinkRetries -> (ShrinkRetries, ShrinkRetries))
-> (ShrinkRetries
-> ShrinkRetries -> (ShrinkRetries, ShrinkRetries))
-> (ShrinkRetries -> Integer)
-> Integral ShrinkRetries
ShrinkRetries -> Integer
ShrinkRetries -> ShrinkRetries -> (ShrinkRetries, ShrinkRetries)
ShrinkRetries -> ShrinkRetries -> ShrinkRetries
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
quot :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$crem :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
rem :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$cdiv :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
div :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$cmod :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
mod :: ShrinkRetries -> ShrinkRetries -> ShrinkRetries
$cquotRem :: ShrinkRetries -> ShrinkRetries -> (ShrinkRetries, ShrinkRetries)
quotRem :: ShrinkRetries -> ShrinkRetries -> (ShrinkRetries, ShrinkRetries)
$cdivMod :: ShrinkRetries -> ShrinkRetries -> (ShrinkRetries, ShrinkRetries)
divMod :: ShrinkRetries -> ShrinkRetries -> (ShrinkRetries, ShrinkRetries)
$ctoInteger :: ShrinkRetries -> Integer
toInteger :: ShrinkRetries -> Integer
Integral, (forall (m :: * -> *). Quote m => ShrinkRetries -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ShrinkRetries -> Code m ShrinkRetries)
-> Lift ShrinkRetries
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShrinkRetries -> m Exp
forall (m :: * -> *).
Quote m =>
ShrinkRetries -> Code m ShrinkRetries
$clift :: forall (m :: * -> *). Quote m => ShrinkRetries -> m Exp
lift :: forall (m :: * -> *). Quote m => ShrinkRetries -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShrinkRetries -> Code m ShrinkRetries
liftTyped :: forall (m :: * -> *).
Quote m =>
ShrinkRetries -> Code m ShrinkRetries
Lift)
data Group =
Group {
Group -> GroupName
groupName :: !GroupName
, Group -> [(PropertyName, Property)]
groupProperties :: ![(PropertyName, Property)]
}
newtype GroupName =
GroupName {
GroupName -> String
unGroupName :: String
} deriving (GroupName -> GroupName -> Bool
(GroupName -> GroupName -> Bool)
-> (GroupName -> GroupName -> Bool) -> Eq GroupName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupName -> GroupName -> Bool
== :: GroupName -> GroupName -> Bool
$c/= :: GroupName -> GroupName -> Bool
/= :: GroupName -> GroupName -> Bool
Eq, Eq GroupName
Eq GroupName =>
(GroupName -> GroupName -> Ordering)
-> (GroupName -> GroupName -> Bool)
-> (GroupName -> GroupName -> Bool)
-> (GroupName -> GroupName -> Bool)
-> (GroupName -> GroupName -> Bool)
-> (GroupName -> GroupName -> GroupName)
-> (GroupName -> GroupName -> GroupName)
-> Ord GroupName
GroupName -> GroupName -> Bool
GroupName -> GroupName -> Ordering
GroupName -> GroupName -> GroupName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GroupName -> GroupName -> Ordering
compare :: GroupName -> GroupName -> Ordering
$c< :: GroupName -> GroupName -> Bool
< :: GroupName -> GroupName -> Bool
$c<= :: GroupName -> GroupName -> Bool
<= :: GroupName -> GroupName -> Bool
$c> :: GroupName -> GroupName -> Bool
> :: GroupName -> GroupName -> Bool
$c>= :: GroupName -> GroupName -> Bool
>= :: GroupName -> GroupName -> Bool
$cmax :: GroupName -> GroupName -> GroupName
max :: GroupName -> GroupName -> GroupName
$cmin :: GroupName -> GroupName -> GroupName
min :: GroupName -> GroupName -> GroupName
Ord, Int -> GroupName -> String -> String
[GroupName] -> String -> String
GroupName -> String
(Int -> GroupName -> String -> String)
-> (GroupName -> String)
-> ([GroupName] -> String -> String)
-> Show GroupName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GroupName -> String -> String
showsPrec :: Int -> GroupName -> String -> String
$cshow :: GroupName -> String
show :: GroupName -> String
$cshowList :: [GroupName] -> String -> String
showList :: [GroupName] -> String -> String
Show, String -> GroupName
(String -> GroupName) -> IsString GroupName
forall a. (String -> a) -> IsString a
$cfromString :: String -> GroupName
fromString :: String -> GroupName
IsString, NonEmpty GroupName -> GroupName
GroupName -> GroupName -> GroupName
(GroupName -> GroupName -> GroupName)
-> (NonEmpty GroupName -> GroupName)
-> (forall b. Integral b => b -> GroupName -> GroupName)
-> Semigroup GroupName
forall b. Integral b => b -> GroupName -> GroupName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: GroupName -> GroupName -> GroupName
<> :: GroupName -> GroupName -> GroupName
$csconcat :: NonEmpty GroupName -> GroupName
sconcat :: NonEmpty GroupName -> GroupName
$cstimes :: forall b. Integral b => b -> GroupName -> GroupName
stimes :: forall b. Integral b => b -> GroupName -> GroupName
Semigroup, (forall (m :: * -> *). Quote m => GroupName -> m Exp)
-> (forall (m :: * -> *). Quote m => GroupName -> Code m GroupName)
-> Lift GroupName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => GroupName -> m Exp
forall (m :: * -> *). Quote m => GroupName -> Code m GroupName
$clift :: forall (m :: * -> *). Quote m => GroupName -> m Exp
lift :: forall (m :: * -> *). Quote m => GroupName -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => GroupName -> Code m GroupName
liftTyped :: forall (m :: * -> *). Quote m => GroupName -> Code m GroupName
Lift)
newtype PropertyCount =
PropertyCount Int
deriving (PropertyCount -> PropertyCount -> Bool
(PropertyCount -> PropertyCount -> Bool)
-> (PropertyCount -> PropertyCount -> Bool) -> Eq PropertyCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyCount -> PropertyCount -> Bool
== :: PropertyCount -> PropertyCount -> Bool
$c/= :: PropertyCount -> PropertyCount -> Bool
/= :: PropertyCount -> PropertyCount -> Bool
Eq, Eq PropertyCount
Eq PropertyCount =>
(PropertyCount -> PropertyCount -> Ordering)
-> (PropertyCount -> PropertyCount -> Bool)
-> (PropertyCount -> PropertyCount -> Bool)
-> (PropertyCount -> PropertyCount -> Bool)
-> (PropertyCount -> PropertyCount -> Bool)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> Ord PropertyCount
PropertyCount -> PropertyCount -> Bool
PropertyCount -> PropertyCount -> Ordering
PropertyCount -> PropertyCount -> PropertyCount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PropertyCount -> PropertyCount -> Ordering
compare :: PropertyCount -> PropertyCount -> Ordering
$c< :: PropertyCount -> PropertyCount -> Bool
< :: PropertyCount -> PropertyCount -> Bool
$c<= :: PropertyCount -> PropertyCount -> Bool
<= :: PropertyCount -> PropertyCount -> Bool
$c> :: PropertyCount -> PropertyCount -> Bool
> :: PropertyCount -> PropertyCount -> Bool
$c>= :: PropertyCount -> PropertyCount -> Bool
>= :: PropertyCount -> PropertyCount -> Bool
$cmax :: PropertyCount -> PropertyCount -> PropertyCount
max :: PropertyCount -> PropertyCount -> PropertyCount
$cmin :: PropertyCount -> PropertyCount -> PropertyCount
min :: PropertyCount -> PropertyCount -> PropertyCount
Ord, Int -> PropertyCount -> String -> String
[PropertyCount] -> String -> String
PropertyCount -> String
(Int -> PropertyCount -> String -> String)
-> (PropertyCount -> String)
-> ([PropertyCount] -> String -> String)
-> Show PropertyCount
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PropertyCount -> String -> String
showsPrec :: Int -> PropertyCount -> String -> String
$cshow :: PropertyCount -> String
show :: PropertyCount -> String
$cshowList :: [PropertyCount] -> String -> String
showList :: [PropertyCount] -> String -> String
Show, Integer -> PropertyCount
PropertyCount -> PropertyCount
PropertyCount -> PropertyCount -> PropertyCount
(PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount)
-> (Integer -> PropertyCount)
-> Num PropertyCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PropertyCount -> PropertyCount -> PropertyCount
+ :: PropertyCount -> PropertyCount -> PropertyCount
$c- :: PropertyCount -> PropertyCount -> PropertyCount
- :: PropertyCount -> PropertyCount -> PropertyCount
$c* :: PropertyCount -> PropertyCount -> PropertyCount
* :: PropertyCount -> PropertyCount -> PropertyCount
$cnegate :: PropertyCount -> PropertyCount
negate :: PropertyCount -> PropertyCount
$cabs :: PropertyCount -> PropertyCount
abs :: PropertyCount -> PropertyCount
$csignum :: PropertyCount -> PropertyCount
signum :: PropertyCount -> PropertyCount
$cfromInteger :: Integer -> PropertyCount
fromInteger :: Integer -> PropertyCount
Num, Int -> PropertyCount
PropertyCount -> Int
PropertyCount -> [PropertyCount]
PropertyCount -> PropertyCount
PropertyCount -> PropertyCount -> [PropertyCount]
PropertyCount -> PropertyCount -> PropertyCount -> [PropertyCount]
(PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount)
-> (Int -> PropertyCount)
-> (PropertyCount -> Int)
-> (PropertyCount -> [PropertyCount])
-> (PropertyCount -> PropertyCount -> [PropertyCount])
-> (PropertyCount -> PropertyCount -> [PropertyCount])
-> (PropertyCount
-> PropertyCount -> PropertyCount -> [PropertyCount])
-> Enum PropertyCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PropertyCount -> PropertyCount
succ :: PropertyCount -> PropertyCount
$cpred :: PropertyCount -> PropertyCount
pred :: PropertyCount -> PropertyCount
$ctoEnum :: Int -> PropertyCount
toEnum :: Int -> PropertyCount
$cfromEnum :: PropertyCount -> Int
fromEnum :: PropertyCount -> Int
$cenumFrom :: PropertyCount -> [PropertyCount]
enumFrom :: PropertyCount -> [PropertyCount]
$cenumFromThen :: PropertyCount -> PropertyCount -> [PropertyCount]
enumFromThen :: PropertyCount -> PropertyCount -> [PropertyCount]
$cenumFromTo :: PropertyCount -> PropertyCount -> [PropertyCount]
enumFromTo :: PropertyCount -> PropertyCount -> [PropertyCount]
$cenumFromThenTo :: PropertyCount -> PropertyCount -> PropertyCount -> [PropertyCount]
enumFromThenTo :: PropertyCount -> PropertyCount -> PropertyCount -> [PropertyCount]
Enum, Num PropertyCount
Ord PropertyCount
(Num PropertyCount, Ord PropertyCount) =>
(PropertyCount -> Rational) -> Real PropertyCount
PropertyCount -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: PropertyCount -> Rational
toRational :: PropertyCount -> Rational
Real, Enum PropertyCount
Real PropertyCount
(Real PropertyCount, Enum PropertyCount) =>
(PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount -> PropertyCount -> PropertyCount)
-> (PropertyCount
-> PropertyCount -> (PropertyCount, PropertyCount))
-> (PropertyCount
-> PropertyCount -> (PropertyCount, PropertyCount))
-> (PropertyCount -> Integer)
-> Integral PropertyCount
PropertyCount -> Integer
PropertyCount -> PropertyCount -> (PropertyCount, PropertyCount)
PropertyCount -> PropertyCount -> PropertyCount
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: PropertyCount -> PropertyCount -> PropertyCount
quot :: PropertyCount -> PropertyCount -> PropertyCount
$crem :: PropertyCount -> PropertyCount -> PropertyCount
rem :: PropertyCount -> PropertyCount -> PropertyCount
$cdiv :: PropertyCount -> PropertyCount -> PropertyCount
div :: PropertyCount -> PropertyCount -> PropertyCount
$cmod :: PropertyCount -> PropertyCount -> PropertyCount
mod :: PropertyCount -> PropertyCount -> PropertyCount
$cquotRem :: PropertyCount -> PropertyCount -> (PropertyCount, PropertyCount)
quotRem :: PropertyCount -> PropertyCount -> (PropertyCount, PropertyCount)
$cdivMod :: PropertyCount -> PropertyCount -> (PropertyCount, PropertyCount)
divMod :: PropertyCount -> PropertyCount -> (PropertyCount, PropertyCount)
$ctoInteger :: PropertyCount -> Integer
toInteger :: PropertyCount -> Integer
Integral)
data TerminationCriteria =
EarlyTermination Confidence TestLimit
| NoEarlyTermination Confidence TestLimit
| NoConfidenceTermination TestLimit
deriving (TerminationCriteria -> TerminationCriteria -> Bool
(TerminationCriteria -> TerminationCriteria -> Bool)
-> (TerminationCriteria -> TerminationCriteria -> Bool)
-> Eq TerminationCriteria
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TerminationCriteria -> TerminationCriteria -> Bool
== :: TerminationCriteria -> TerminationCriteria -> Bool
$c/= :: TerminationCriteria -> TerminationCriteria -> Bool
/= :: TerminationCriteria -> TerminationCriteria -> Bool
Eq, Eq TerminationCriteria
Eq TerminationCriteria =>
(TerminationCriteria -> TerminationCriteria -> Ordering)
-> (TerminationCriteria -> TerminationCriteria -> Bool)
-> (TerminationCriteria -> TerminationCriteria -> Bool)
-> (TerminationCriteria -> TerminationCriteria -> Bool)
-> (TerminationCriteria -> TerminationCriteria -> Bool)
-> (TerminationCriteria
-> TerminationCriteria -> TerminationCriteria)
-> (TerminationCriteria
-> TerminationCriteria -> TerminationCriteria)
-> Ord TerminationCriteria
TerminationCriteria -> TerminationCriteria -> Bool
TerminationCriteria -> TerminationCriteria -> Ordering
TerminationCriteria -> TerminationCriteria -> TerminationCriteria
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TerminationCriteria -> TerminationCriteria -> Ordering
compare :: TerminationCriteria -> TerminationCriteria -> Ordering
$c< :: TerminationCriteria -> TerminationCriteria -> Bool
< :: TerminationCriteria -> TerminationCriteria -> Bool
$c<= :: TerminationCriteria -> TerminationCriteria -> Bool
<= :: TerminationCriteria -> TerminationCriteria -> Bool
$c> :: TerminationCriteria -> TerminationCriteria -> Bool
> :: TerminationCriteria -> TerminationCriteria -> Bool
$c>= :: TerminationCriteria -> TerminationCriteria -> Bool
>= :: TerminationCriteria -> TerminationCriteria -> Bool
$cmax :: TerminationCriteria -> TerminationCriteria -> TerminationCriteria
max :: TerminationCriteria -> TerminationCriteria -> TerminationCriteria
$cmin :: TerminationCriteria -> TerminationCriteria -> TerminationCriteria
min :: TerminationCriteria -> TerminationCriteria -> TerminationCriteria
Ord, Int -> TerminationCriteria -> String -> String
[TerminationCriteria] -> String -> String
TerminationCriteria -> String
(Int -> TerminationCriteria -> String -> String)
-> (TerminationCriteria -> String)
-> ([TerminationCriteria] -> String -> String)
-> Show TerminationCriteria
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TerminationCriteria -> String -> String
showsPrec :: Int -> TerminationCriteria -> String -> String
$cshow :: TerminationCriteria -> String
show :: TerminationCriteria -> String
$cshowList :: [TerminationCriteria] -> String -> String
showList :: [TerminationCriteria] -> String -> String
Show, (forall (m :: * -> *). Quote m => TerminationCriteria -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
TerminationCriteria -> Code m TerminationCriteria)
-> Lift TerminationCriteria
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TerminationCriteria -> m Exp
forall (m :: * -> *).
Quote m =>
TerminationCriteria -> Code m TerminationCriteria
$clift :: forall (m :: * -> *). Quote m => TerminationCriteria -> m Exp
lift :: forall (m :: * -> *). Quote m => TerminationCriteria -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TerminationCriteria -> Code m TerminationCriteria
liftTyped :: forall (m :: * -> *).
Quote m =>
TerminationCriteria -> Code m TerminationCriteria
Lift)
data Log =
Annotation (Maybe Span) String
| String
| Label (Label Cover)
deriving (Log -> Log -> Bool
(Log -> Log -> Bool) -> (Log -> Log -> Bool) -> Eq Log
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Log -> Log -> Bool
== :: Log -> Log -> Bool
$c/= :: Log -> Log -> Bool
/= :: Log -> Log -> Bool
Eq, Int -> Log -> String -> String
[Log] -> String -> String
Log -> String
(Int -> Log -> String -> String)
-> (Log -> String) -> ([Log] -> String -> String) -> Show Log
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Log -> String -> String
showsPrec :: Int -> Log -> String -> String
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> String -> String
showList :: [Log] -> String -> String
Show)
newtype Journal =
Journal {
Journal -> [Log]
journalLogs :: [Log]
} deriving (Journal -> Journal -> Bool
(Journal -> Journal -> Bool)
-> (Journal -> Journal -> Bool) -> Eq Journal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Journal -> Journal -> Bool
== :: Journal -> Journal -> Bool
$c/= :: Journal -> Journal -> Bool
/= :: Journal -> Journal -> Bool
Eq, Int -> Journal -> String -> String
[Journal] -> String -> String
Journal -> String
(Int -> Journal -> String -> String)
-> (Journal -> String)
-> ([Journal] -> String -> String)
-> Show Journal
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Journal -> String -> String
showsPrec :: Int -> Journal -> String -> String
$cshow :: Journal -> String
show :: Journal -> String
$cshowList :: [Journal] -> String -> String
showList :: [Journal] -> String -> String
Show, NonEmpty Journal -> Journal
Journal -> Journal -> Journal
(Journal -> Journal -> Journal)
-> (NonEmpty Journal -> Journal)
-> (forall b. Integral b => b -> Journal -> Journal)
-> Semigroup Journal
forall b. Integral b => b -> Journal -> Journal
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Journal -> Journal -> Journal
<> :: Journal -> Journal -> Journal
$csconcat :: NonEmpty Journal -> Journal
sconcat :: NonEmpty Journal -> Journal
$cstimes :: forall b. Integral b => b -> Journal -> Journal
stimes :: forall b. Integral b => b -> Journal -> Journal
Semigroup, Semigroup Journal
Journal
Semigroup Journal =>
Journal
-> (Journal -> Journal -> Journal)
-> ([Journal] -> Journal)
-> Monoid Journal
[Journal] -> Journal
Journal -> Journal -> Journal
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Journal
mempty :: Journal
$cmappend :: Journal -> Journal -> Journal
mappend :: Journal -> Journal -> Journal
$cmconcat :: [Journal] -> Journal
mconcat :: [Journal] -> Journal
Monoid)
data Failure =
Failure (Maybe Span) String (Maybe Diff)
deriving (Failure -> Failure -> Bool
(Failure -> Failure -> Bool)
-> (Failure -> Failure -> Bool) -> Eq Failure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Failure -> Failure -> Bool
== :: Failure -> Failure -> Bool
$c/= :: Failure -> Failure -> Bool
/= :: Failure -> Failure -> Bool
Eq, Int -> Failure -> String -> String
[Failure] -> String -> String
Failure -> String
(Int -> Failure -> String -> String)
-> (Failure -> String)
-> ([Failure] -> String -> String)
-> Show Failure
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Failure -> String -> String
showsPrec :: Int -> Failure -> String -> String
$cshow :: Failure -> String
show :: Failure -> String
$cshowList :: [Failure] -> String -> String
showList :: [Failure] -> String -> String
Show)
data Diff =
Diff {
Diff -> String
diffPrefix :: String
, Diff -> String
diffRemoved :: String
, Diff -> String
diffInfix :: String
, Diff -> String
diffAdded :: String
, Diff -> String
diffSuffix :: String
, Diff -> ValueDiff
diffValue :: ValueDiff
} deriving (Diff -> Diff -> Bool
(Diff -> Diff -> Bool) -> (Diff -> Diff -> Bool) -> Eq Diff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Diff -> Diff -> Bool
== :: Diff -> Diff -> Bool
$c/= :: Diff -> Diff -> Bool
/= :: Diff -> Diff -> Bool
Eq, Int -> Diff -> String -> String
[Diff] -> String -> String
Diff -> String
(Int -> Diff -> String -> String)
-> (Diff -> String) -> ([Diff] -> String -> String) -> Show Diff
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Diff -> String -> String
showsPrec :: Int -> Diff -> String -> String
$cshow :: Diff -> String
show :: Diff -> String
$cshowList :: [Diff] -> String -> String
showList :: [Diff] -> String -> String
Show)
data Cover =
NoCover
| Cover
deriving (Cover -> Cover -> Bool
(Cover -> Cover -> Bool) -> (Cover -> Cover -> Bool) -> Eq Cover
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cover -> Cover -> Bool
== :: Cover -> Cover -> Bool
$c/= :: Cover -> Cover -> Bool
/= :: Cover -> Cover -> Bool
Eq, Eq Cover
Eq Cover =>
(Cover -> Cover -> Ordering)
-> (Cover -> Cover -> Bool)
-> (Cover -> Cover -> Bool)
-> (Cover -> Cover -> Bool)
-> (Cover -> Cover -> Bool)
-> (Cover -> Cover -> Cover)
-> (Cover -> Cover -> Cover)
-> Ord Cover
Cover -> Cover -> Bool
Cover -> Cover -> Ordering
Cover -> Cover -> Cover
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Cover -> Cover -> Ordering
compare :: Cover -> Cover -> Ordering
$c< :: Cover -> Cover -> Bool
< :: Cover -> Cover -> Bool
$c<= :: Cover -> Cover -> Bool
<= :: Cover -> Cover -> Bool
$c> :: Cover -> Cover -> Bool
> :: Cover -> Cover -> Bool
$c>= :: Cover -> Cover -> Bool
>= :: Cover -> Cover -> Bool
$cmax :: Cover -> Cover -> Cover
max :: Cover -> Cover -> Cover
$cmin :: Cover -> Cover -> Cover
min :: Cover -> Cover -> Cover
Ord, Int -> Cover -> String -> String
[Cover] -> String -> String
Cover -> String
(Int -> Cover -> String -> String)
-> (Cover -> String) -> ([Cover] -> String -> String) -> Show Cover
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Cover -> String -> String
showsPrec :: Int -> Cover -> String -> String
$cshow :: Cover -> String
show :: Cover -> String
$cshowList :: [Cover] -> String -> String
showList :: [Cover] -> String -> String
Show)
newtype CoverCount =
CoverCount {
CoverCount -> Int
unCoverCount :: Int
} deriving (CoverCount -> CoverCount -> Bool
(CoverCount -> CoverCount -> Bool)
-> (CoverCount -> CoverCount -> Bool) -> Eq CoverCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CoverCount -> CoverCount -> Bool
== :: CoverCount -> CoverCount -> Bool
$c/= :: CoverCount -> CoverCount -> Bool
/= :: CoverCount -> CoverCount -> Bool
Eq, Eq CoverCount
Eq CoverCount =>
(CoverCount -> CoverCount -> Ordering)
-> (CoverCount -> CoverCount -> Bool)
-> (CoverCount -> CoverCount -> Bool)
-> (CoverCount -> CoverCount -> Bool)
-> (CoverCount -> CoverCount -> Bool)
-> (CoverCount -> CoverCount -> CoverCount)
-> (CoverCount -> CoverCount -> CoverCount)
-> Ord CoverCount
CoverCount -> CoverCount -> Bool
CoverCount -> CoverCount -> Ordering
CoverCount -> CoverCount -> CoverCount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CoverCount -> CoverCount -> Ordering
compare :: CoverCount -> CoverCount -> Ordering
$c< :: CoverCount -> CoverCount -> Bool
< :: CoverCount -> CoverCount -> Bool
$c<= :: CoverCount -> CoverCount -> Bool
<= :: CoverCount -> CoverCount -> Bool
$c> :: CoverCount -> CoverCount -> Bool
> :: CoverCount -> CoverCount -> Bool
$c>= :: CoverCount -> CoverCount -> Bool
>= :: CoverCount -> CoverCount -> Bool
$cmax :: CoverCount -> CoverCount -> CoverCount
max :: CoverCount -> CoverCount -> CoverCount
$cmin :: CoverCount -> CoverCount -> CoverCount
min :: CoverCount -> CoverCount -> CoverCount
Ord, Int -> CoverCount -> String -> String
[CoverCount] -> String -> String
CoverCount -> String
(Int -> CoverCount -> String -> String)
-> (CoverCount -> String)
-> ([CoverCount] -> String -> String)
-> Show CoverCount
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CoverCount -> String -> String
showsPrec :: Int -> CoverCount -> String -> String
$cshow :: CoverCount -> String
show :: CoverCount -> String
$cshowList :: [CoverCount] -> String -> String
showList :: [CoverCount] -> String -> String
Show, Integer -> CoverCount
CoverCount -> CoverCount
CoverCount -> CoverCount -> CoverCount
(CoverCount -> CoverCount -> CoverCount)
-> (CoverCount -> CoverCount -> CoverCount)
-> (CoverCount -> CoverCount -> CoverCount)
-> (CoverCount -> CoverCount)
-> (CoverCount -> CoverCount)
-> (CoverCount -> CoverCount)
-> (Integer -> CoverCount)
-> Num CoverCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: CoverCount -> CoverCount -> CoverCount
+ :: CoverCount -> CoverCount -> CoverCount
$c- :: CoverCount -> CoverCount -> CoverCount
- :: CoverCount -> CoverCount -> CoverCount
$c* :: CoverCount -> CoverCount -> CoverCount
* :: CoverCount -> CoverCount -> CoverCount
$cnegate :: CoverCount -> CoverCount
negate :: CoverCount -> CoverCount
$cabs :: CoverCount -> CoverCount
abs :: CoverCount -> CoverCount
$csignum :: CoverCount -> CoverCount
signum :: CoverCount -> CoverCount
$cfromInteger :: Integer -> CoverCount
fromInteger :: Integer -> CoverCount
Num)
newtype CoverPercentage =
CoverPercentage {
CoverPercentage -> Double
unCoverPercentage :: Double
} deriving (CoverPercentage -> CoverPercentage -> Bool
(CoverPercentage -> CoverPercentage -> Bool)
-> (CoverPercentage -> CoverPercentage -> Bool)
-> Eq CoverPercentage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CoverPercentage -> CoverPercentage -> Bool
== :: CoverPercentage -> CoverPercentage -> Bool
$c/= :: CoverPercentage -> CoverPercentage -> Bool
/= :: CoverPercentage -> CoverPercentage -> Bool
Eq, Eq CoverPercentage
Eq CoverPercentage =>
(CoverPercentage -> CoverPercentage -> Ordering)
-> (CoverPercentage -> CoverPercentage -> Bool)
-> (CoverPercentage -> CoverPercentage -> Bool)
-> (CoverPercentage -> CoverPercentage -> Bool)
-> (CoverPercentage -> CoverPercentage -> Bool)
-> (CoverPercentage -> CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage -> CoverPercentage)
-> Ord CoverPercentage
CoverPercentage -> CoverPercentage -> Bool
CoverPercentage -> CoverPercentage -> Ordering
CoverPercentage -> CoverPercentage -> CoverPercentage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CoverPercentage -> CoverPercentage -> Ordering
compare :: CoverPercentage -> CoverPercentage -> Ordering
$c< :: CoverPercentage -> CoverPercentage -> Bool
< :: CoverPercentage -> CoverPercentage -> Bool
$c<= :: CoverPercentage -> CoverPercentage -> Bool
<= :: CoverPercentage -> CoverPercentage -> Bool
$c> :: CoverPercentage -> CoverPercentage -> Bool
> :: CoverPercentage -> CoverPercentage -> Bool
$c>= :: CoverPercentage -> CoverPercentage -> Bool
>= :: CoverPercentage -> CoverPercentage -> Bool
$cmax :: CoverPercentage -> CoverPercentage -> CoverPercentage
max :: CoverPercentage -> CoverPercentage -> CoverPercentage
$cmin :: CoverPercentage -> CoverPercentage -> CoverPercentage
min :: CoverPercentage -> CoverPercentage -> CoverPercentage
Ord, Int -> CoverPercentage -> String -> String
[CoverPercentage] -> String -> String
CoverPercentage -> String
(Int -> CoverPercentage -> String -> String)
-> (CoverPercentage -> String)
-> ([CoverPercentage] -> String -> String)
-> Show CoverPercentage
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CoverPercentage -> String -> String
showsPrec :: Int -> CoverPercentage -> String -> String
$cshow :: CoverPercentage -> String
show :: CoverPercentage -> String
$cshowList :: [CoverPercentage] -> String -> String
showList :: [CoverPercentage] -> String -> String
Show, Integer -> CoverPercentage
CoverPercentage -> CoverPercentage
CoverPercentage -> CoverPercentage -> CoverPercentage
(CoverPercentage -> CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage)
-> (Integer -> CoverPercentage)
-> Num CoverPercentage
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: CoverPercentage -> CoverPercentage -> CoverPercentage
+ :: CoverPercentage -> CoverPercentage -> CoverPercentage
$c- :: CoverPercentage -> CoverPercentage -> CoverPercentage
- :: CoverPercentage -> CoverPercentage -> CoverPercentage
$c* :: CoverPercentage -> CoverPercentage -> CoverPercentage
* :: CoverPercentage -> CoverPercentage -> CoverPercentage
$cnegate :: CoverPercentage -> CoverPercentage
negate :: CoverPercentage -> CoverPercentage
$cabs :: CoverPercentage -> CoverPercentage
abs :: CoverPercentage -> CoverPercentage
$csignum :: CoverPercentage -> CoverPercentage
signum :: CoverPercentage -> CoverPercentage
$cfromInteger :: Integer -> CoverPercentage
fromInteger :: Integer -> CoverPercentage
Num, Num CoverPercentage
Num CoverPercentage =>
(CoverPercentage -> CoverPercentage -> CoverPercentage)
-> (CoverPercentage -> CoverPercentage)
-> (Rational -> CoverPercentage)
-> Fractional CoverPercentage
Rational -> CoverPercentage
CoverPercentage -> CoverPercentage
CoverPercentage -> CoverPercentage -> CoverPercentage
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: CoverPercentage -> CoverPercentage -> CoverPercentage
/ :: CoverPercentage -> CoverPercentage -> CoverPercentage
$crecip :: CoverPercentage -> CoverPercentage
recip :: CoverPercentage -> CoverPercentage
$cfromRational :: Rational -> CoverPercentage
fromRational :: Rational -> CoverPercentage
Fractional)
newtype LabelName =
LabelName {
LabelName -> String
unLabelName :: String
} deriving (LabelName -> LabelName -> Bool
(LabelName -> LabelName -> Bool)
-> (LabelName -> LabelName -> Bool) -> Eq LabelName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelName -> LabelName -> Bool
== :: LabelName -> LabelName -> Bool
$c/= :: LabelName -> LabelName -> Bool
/= :: LabelName -> LabelName -> Bool
Eq, Semigroup LabelName
LabelName
Semigroup LabelName =>
LabelName
-> (LabelName -> LabelName -> LabelName)
-> ([LabelName] -> LabelName)
-> Monoid LabelName
[LabelName] -> LabelName
LabelName -> LabelName -> LabelName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: LabelName
mempty :: LabelName
$cmappend :: LabelName -> LabelName -> LabelName
mappend :: LabelName -> LabelName -> LabelName
$cmconcat :: [LabelName] -> LabelName
mconcat :: [LabelName] -> LabelName
Monoid, Eq LabelName
Eq LabelName =>
(LabelName -> LabelName -> Ordering)
-> (LabelName -> LabelName -> Bool)
-> (LabelName -> LabelName -> Bool)
-> (LabelName -> LabelName -> Bool)
-> (LabelName -> LabelName -> Bool)
-> (LabelName -> LabelName -> LabelName)
-> (LabelName -> LabelName -> LabelName)
-> Ord LabelName
LabelName -> LabelName -> Bool
LabelName -> LabelName -> Ordering
LabelName -> LabelName -> LabelName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LabelName -> LabelName -> Ordering
compare :: LabelName -> LabelName -> Ordering
$c< :: LabelName -> LabelName -> Bool
< :: LabelName -> LabelName -> Bool
$c<= :: LabelName -> LabelName -> Bool
<= :: LabelName -> LabelName -> Bool
$c> :: LabelName -> LabelName -> Bool
> :: LabelName -> LabelName -> Bool
$c>= :: LabelName -> LabelName -> Bool
>= :: LabelName -> LabelName -> Bool
$cmax :: LabelName -> LabelName -> LabelName
max :: LabelName -> LabelName -> LabelName
$cmin :: LabelName -> LabelName -> LabelName
min :: LabelName -> LabelName -> LabelName
Ord, NonEmpty LabelName -> LabelName
LabelName -> LabelName -> LabelName
(LabelName -> LabelName -> LabelName)
-> (NonEmpty LabelName -> LabelName)
-> (forall b. Integral b => b -> LabelName -> LabelName)
-> Semigroup LabelName
forall b. Integral b => b -> LabelName -> LabelName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: LabelName -> LabelName -> LabelName
<> :: LabelName -> LabelName -> LabelName
$csconcat :: NonEmpty LabelName -> LabelName
sconcat :: NonEmpty LabelName -> LabelName
$cstimes :: forall b. Integral b => b -> LabelName -> LabelName
stimes :: forall b. Integral b => b -> LabelName -> LabelName
Semigroup, Int -> LabelName -> String -> String
[LabelName] -> String -> String
LabelName -> String
(Int -> LabelName -> String -> String)
-> (LabelName -> String)
-> ([LabelName] -> String -> String)
-> Show LabelName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LabelName -> String -> String
showsPrec :: Int -> LabelName -> String -> String
$cshow :: LabelName -> String
show :: LabelName -> String
$cshowList :: [LabelName] -> String -> String
showList :: [LabelName] -> String -> String
Show, String -> LabelName
(String -> LabelName) -> IsString LabelName
forall a. (String -> a) -> IsString a
$cfromString :: String -> LabelName
fromString :: String -> LabelName
IsString)
data Label a =
MkLabel {
forall a. Label a -> LabelName
labelName :: !LabelName
, forall a. Label a -> Maybe Span
labelLocation :: !(Maybe Span)
, forall a. Label a -> CoverPercentage
labelMinimum :: !CoverPercentage
, forall a. Label a -> a
labelAnnotation :: !a
} deriving (Label a -> Label a -> Bool
(Label a -> Label a -> Bool)
-> (Label a -> Label a -> Bool) -> Eq (Label a)
forall a. Eq a => Label a -> Label a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Label a -> Label a -> Bool
== :: Label a -> Label a -> Bool
$c/= :: forall a. Eq a => Label a -> Label a -> Bool
/= :: Label a -> Label a -> Bool
Eq, Int -> Label a -> String -> String
[Label a] -> String -> String
Label a -> String
(Int -> Label a -> String -> String)
-> (Label a -> String)
-> ([Label a] -> String -> String)
-> Show (Label a)
forall a. Show a => Int -> Label a -> String -> String
forall a. Show a => [Label a] -> String -> String
forall a. Show a => Label a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Label a -> String -> String
showsPrec :: Int -> Label a -> String -> String
$cshow :: forall a. Show a => Label a -> String
show :: Label a -> String
$cshowList :: forall a. Show a => [Label a] -> String -> String
showList :: [Label a] -> String -> String
Show, (forall a b. (a -> b) -> Label a -> Label b)
-> (forall a b. a -> Label b -> Label a) -> Functor Label
forall a b. a -> Label b -> Label a
forall a b. (a -> b) -> Label a -> Label 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) -> Label a -> Label b
fmap :: forall a b. (a -> b) -> Label a -> Label b
$c<$ :: forall a b. a -> Label b -> Label a
<$ :: forall a b. a -> Label b -> Label a
Functor, (forall m. Monoid m => Label m -> m)
-> (forall m a. Monoid m => (a -> m) -> Label a -> m)
-> (forall m a. Monoid m => (a -> m) -> Label a -> m)
-> (forall a b. (a -> b -> b) -> b -> Label a -> b)
-> (forall a b. (a -> b -> b) -> b -> Label a -> b)
-> (forall b a. (b -> a -> b) -> b -> Label a -> b)
-> (forall b a. (b -> a -> b) -> b -> Label a -> b)
-> (forall a. (a -> a -> a) -> Label a -> a)
-> (forall a. (a -> a -> a) -> Label a -> a)
-> (forall a. Label a -> [a])
-> (forall a. Label a -> Bool)
-> (forall a. Label a -> Int)
-> (forall a. Eq a => a -> Label a -> Bool)
-> (forall a. Ord a => Label a -> a)
-> (forall a. Ord a => Label a -> a)
-> (forall a. Num a => Label a -> a)
-> (forall a. Num a => Label a -> a)
-> Foldable Label
forall a. Eq a => a -> Label a -> Bool
forall a. Num a => Label a -> a
forall a. Ord a => Label a -> a
forall m. Monoid m => Label m -> m
forall a. Label a -> Bool
forall a. Label a -> Int
forall a. Label a -> [a]
forall a. (a -> a -> a) -> Label a -> a
forall m a. Monoid m => (a -> m) -> Label a -> m
forall b a. (b -> a -> b) -> b -> Label a -> b
forall a b. (a -> b -> b) -> b -> Label a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Label m -> m
fold :: forall m. Monoid m => Label m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Label a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Label a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Label a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Label a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Label a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Label a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Label a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Label a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Label a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Label a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Label a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Label a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Label a -> a
foldr1 :: forall a. (a -> a -> a) -> Label a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Label a -> a
foldl1 :: forall a. (a -> a -> a) -> Label a -> a
$ctoList :: forall a. Label a -> [a]
toList :: forall a. Label a -> [a]
$cnull :: forall a. Label a -> Bool
null :: forall a. Label a -> Bool
$clength :: forall a. Label a -> Int
length :: forall a. Label a -> Int
$celem :: forall a. Eq a => a -> Label a -> Bool
elem :: forall a. Eq a => a -> Label a -> Bool
$cmaximum :: forall a. Ord a => Label a -> a
maximum :: forall a. Ord a => Label a -> a
$cminimum :: forall a. Ord a => Label a -> a
minimum :: forall a. Ord a => Label a -> a
$csum :: forall a. Num a => Label a -> a
sum :: forall a. Num a => Label a -> a
$cproduct :: forall a. Num a => Label a -> a
product :: forall a. Num a => Label a -> a
Foldable, Functor Label
Foldable Label
(Functor Label, Foldable Label) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Label a -> f (Label b))
-> (forall (f :: * -> *) a.
Applicative f =>
Label (f a) -> f (Label a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Label a -> m (Label b))
-> (forall (m :: * -> *) a. Monad m => Label (m a) -> m (Label a))
-> Traversable Label
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Label (m a) -> m (Label a)
forall (f :: * -> *) a. Applicative f => Label (f a) -> f (Label a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Label a -> m (Label b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Label a -> f (Label b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Label a -> f (Label b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Label a -> f (Label b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Label (f a) -> f (Label a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Label (f a) -> f (Label a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Label a -> m (Label b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Label a -> m (Label b)
$csequence :: forall (m :: * -> *) a. Monad m => Label (m a) -> m (Label a)
sequence :: forall (m :: * -> *) a. Monad m => Label (m a) -> m (Label a)
Traversable)
newtype Coverage a =
Coverage {
forall a. Coverage a -> Map LabelName (Label a)
coverageLabels :: Map LabelName (Label a)
} deriving (Coverage a -> Coverage a -> Bool
(Coverage a -> Coverage a -> Bool)
-> (Coverage a -> Coverage a -> Bool) -> Eq (Coverage a)
forall a. Eq a => Coverage a -> Coverage a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Coverage a -> Coverage a -> Bool
== :: Coverage a -> Coverage a -> Bool
$c/= :: forall a. Eq a => Coverage a -> Coverage a -> Bool
/= :: Coverage a -> Coverage a -> Bool
Eq, Int -> Coverage a -> String -> String
[Coverage a] -> String -> String
Coverage a -> String
(Int -> Coverage a -> String -> String)
-> (Coverage a -> String)
-> ([Coverage a] -> String -> String)
-> Show (Coverage a)
forall a. Show a => Int -> Coverage a -> String -> String
forall a. Show a => [Coverage a] -> String -> String
forall a. Show a => Coverage a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Coverage a -> String -> String
showsPrec :: Int -> Coverage a -> String -> String
$cshow :: forall a. Show a => Coverage a -> String
show :: Coverage a -> String
$cshowList :: forall a. Show a => [Coverage a] -> String -> String
showList :: [Coverage a] -> String -> String
Show, (forall a b. (a -> b) -> Coverage a -> Coverage b)
-> (forall a b. a -> Coverage b -> Coverage a) -> Functor Coverage
forall a b. a -> Coverage b -> Coverage a
forall a b. (a -> b) -> Coverage a -> Coverage 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) -> Coverage a -> Coverage b
fmap :: forall a b. (a -> b) -> Coverage a -> Coverage b
$c<$ :: forall a b. a -> Coverage b -> Coverage a
<$ :: forall a b. a -> Coverage b -> Coverage a
Functor, (forall m. Monoid m => Coverage m -> m)
-> (forall m a. Monoid m => (a -> m) -> Coverage a -> m)
-> (forall m a. Monoid m => (a -> m) -> Coverage a -> m)
-> (forall a b. (a -> b -> b) -> b -> Coverage a -> b)
-> (forall a b. (a -> b -> b) -> b -> Coverage a -> b)
-> (forall b a. (b -> a -> b) -> b -> Coverage a -> b)
-> (forall b a. (b -> a -> b) -> b -> Coverage a -> b)
-> (forall a. (a -> a -> a) -> Coverage a -> a)
-> (forall a. (a -> a -> a) -> Coverage a -> a)
-> (forall a. Coverage a -> [a])
-> (forall a. Coverage a -> Bool)
-> (forall a. Coverage a -> Int)
-> (forall a. Eq a => a -> Coverage a -> Bool)
-> (forall a. Ord a => Coverage a -> a)
-> (forall a. Ord a => Coverage a -> a)
-> (forall a. Num a => Coverage a -> a)
-> (forall a. Num a => Coverage a -> a)
-> Foldable Coverage
forall a. Eq a => a -> Coverage a -> Bool
forall a. Num a => Coverage a -> a
forall a. Ord a => Coverage a -> a
forall m. Monoid m => Coverage m -> m
forall a. Coverage a -> Bool
forall a. Coverage a -> Int
forall a. Coverage a -> [a]
forall a. (a -> a -> a) -> Coverage a -> a
forall m a. Monoid m => (a -> m) -> Coverage a -> m
forall b a. (b -> a -> b) -> b -> Coverage a -> b
forall a b. (a -> b -> b) -> b -> Coverage a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Coverage m -> m
fold :: forall m. Monoid m => Coverage m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Coverage a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Coverage a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Coverage a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Coverage a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Coverage a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Coverage a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Coverage a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Coverage a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Coverage a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Coverage a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Coverage a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Coverage a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Coverage a -> a
foldr1 :: forall a. (a -> a -> a) -> Coverage a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Coverage a -> a
foldl1 :: forall a. (a -> a -> a) -> Coverage a -> a
$ctoList :: forall a. Coverage a -> [a]
toList :: forall a. Coverage a -> [a]
$cnull :: forall a. Coverage a -> Bool
null :: forall a. Coverage a -> Bool
$clength :: forall a. Coverage a -> Int
length :: forall a. Coverage a -> Int
$celem :: forall a. Eq a => a -> Coverage a -> Bool
elem :: forall a. Eq a => a -> Coverage a -> Bool
$cmaximum :: forall a. Ord a => Coverage a -> a
maximum :: forall a. Ord a => Coverage a -> a
$cminimum :: forall a. Ord a => Coverage a -> a
minimum :: forall a. Ord a => Coverage a -> a
$csum :: forall a. Num a => Coverage a -> a
sum :: forall a. Num a => Coverage a -> a
$cproduct :: forall a. Num a => Coverage a -> a
product :: forall a. Num a => Coverage a -> a
Foldable, Functor Coverage
Foldable Coverage
(Functor Coverage, Foldable Coverage) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Coverage a -> f (Coverage b))
-> (forall (f :: * -> *) a.
Applicative f =>
Coverage (f a) -> f (Coverage a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Coverage a -> m (Coverage b))
-> (forall (m :: * -> *) a.
Monad m =>
Coverage (m a) -> m (Coverage a))
-> Traversable Coverage
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Coverage (m a) -> m (Coverage a)
forall (f :: * -> *) a.
Applicative f =>
Coverage (f a) -> f (Coverage a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Coverage a -> m (Coverage b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Coverage a -> f (Coverage b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Coverage a -> f (Coverage b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Coverage a -> f (Coverage b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Coverage (f a) -> f (Coverage a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Coverage (f a) -> f (Coverage a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Coverage a -> m (Coverage b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Coverage a -> m (Coverage b)
$csequence :: forall (m :: * -> *) a. Monad m => Coverage (m a) -> m (Coverage a)
sequence :: forall (m :: * -> *) a. Monad m => Coverage (m a) -> m (Coverage a)
Traversable)
instance Monad m => Monad (TestT m) where
return :: forall a. a -> TestT m a
return =
a -> TestT m a
forall a. a -> TestT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: forall a b. TestT m a -> (a -> TestT m b) -> TestT m b
(>>=) TestT m a
m a -> TestT m b
k =
ExceptT Failure (WriterT Journal m) b -> TestT m b
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (ExceptT Failure (WriterT Journal m) b -> TestT m b)
-> ExceptT Failure (WriterT Journal m) b -> TestT m b
forall a b. (a -> b) -> a -> b
$
TestT m a -> ExceptT Failure (WriterT Journal m) a
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest TestT m a
m ExceptT Failure (WriterT Journal m) a
-> (a -> ExceptT Failure (WriterT Journal m) b)
-> ExceptT Failure (WriterT Journal m) b
forall a b.
ExceptT Failure (WriterT Journal m) a
-> (a -> ExceptT Failure (WriterT Journal m) b)
-> ExceptT Failure (WriterT Journal m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
TestT m b -> ExceptT Failure (WriterT Journal m) b
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest (TestT m b -> ExceptT Failure (WriterT Journal m) b)
-> (a -> TestT m b) -> a -> ExceptT Failure (WriterT Journal m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TestT m b
k
instance Monad m => MonadFail (TestT m) where
fail :: forall a. String -> TestT m a
fail String
err =
ExceptT Failure (WriterT Journal m) a -> TestT m a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (ExceptT Failure (WriterT Journal m) a -> TestT m a)
-> (Failure -> ExceptT Failure (WriterT Journal m) a)
-> Failure
-> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a)
-> (Failure -> WriterT Journal m (Either Failure a))
-> Failure
-> ExceptT Failure (WriterT Journal m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Failure a -> WriterT Journal m (Either Failure a)
forall a. a -> WriterT Journal m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure a -> WriterT Journal m (Either Failure a))
-> (Failure -> Either Failure a)
-> Failure
-> WriterT Journal m (Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure a
forall a b. a -> Either a b
Left (Failure -> TestT m a) -> Failure -> TestT m a
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Maybe Diff -> Failure
Failure Maybe Span
forall a. Maybe a
Nothing String
err Maybe Diff
forall a. Maybe a
Nothing
instance MonadTrans TestT where
lift :: forall (m :: * -> *) a. Monad m => m a -> TestT m a
lift =
ExceptT Failure (WriterT Journal m) a -> TestT m a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (ExceptT Failure (WriterT Journal m) a -> TestT m a)
-> (m a -> ExceptT Failure (WriterT Journal m) a)
-> m a
-> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Journal m a -> ExceptT Failure (WriterT Journal m) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT Failure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT Journal m a -> ExceptT Failure (WriterT Journal m) a)
-> (m a -> WriterT Journal m a)
-> m a
-> ExceptT Failure (WriterT Journal m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> WriterT Journal m a
forall (m :: * -> *) a. Monad m => m a -> WriterT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MFunctor TestT where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TestT m b -> TestT n b
hoist forall a. m a -> n a
f =
ExceptT Failure (WriterT Journal n) b -> TestT n b
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (ExceptT Failure (WriterT Journal n) b -> TestT n b)
-> (TestT m b -> ExceptT Failure (WriterT Journal n) b)
-> TestT m b
-> TestT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. WriterT Journal m a -> WriterT Journal n a)
-> ExceptT Failure (WriterT Journal m) b
-> ExceptT Failure (WriterT Journal n) b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT Failure m b -> ExceptT Failure n b
hoist ((forall a. m a -> n a)
-> WriterT Journal m a -> WriterT Journal n a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> WriterT Journal m b -> WriterT Journal n b
hoist m a -> n a
forall a. m a -> n a
f) (ExceptT Failure (WriterT Journal m) b
-> ExceptT Failure (WriterT Journal n) b)
-> (TestT m b -> ExceptT Failure (WriterT Journal m) b)
-> TestT m b
-> ExceptT Failure (WriterT Journal n) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestT m b -> ExceptT Failure (WriterT Journal m) b
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest
instance MonadTransDistributive TestT where
type Transformer t TestT m = (
Transformer t (Lazy.WriterT Journal) m
, Transformer t (ExceptT Failure) (Lazy.WriterT Journal m)
)
distributeT :: forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f TestT m =>
TestT (f m) a -> f (TestT m) a
distributeT =
(forall a. ExceptT Failure (WriterT Journal m) a -> TestT m a)
-> f (ExceptT Failure (WriterT Journal m)) a -> f (TestT m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> f m b -> f n b
hoist ExceptT Failure (WriterT Journal m) a -> TestT m a
forall a. ExceptT Failure (WriterT Journal m) a -> TestT m a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (f (ExceptT Failure (WriterT Journal m)) a -> f (TestT m) a)
-> (TestT (f m) a -> f (ExceptT Failure (WriterT Journal m)) a)
-> TestT (f m) a
-> f (TestT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ExceptT Failure (f (WriterT Journal m)) a
-> f (ExceptT Failure (WriterT Journal m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f (ExceptT Failure) m =>
ExceptT Failure (f m) a -> f (ExceptT Failure m) a
distributeT (ExceptT Failure (f (WriterT Journal m)) a
-> f (ExceptT Failure (WriterT Journal m)) a)
-> (TestT (f m) a -> ExceptT Failure (f (WriterT Journal m)) a)
-> TestT (f m) a
-> f (ExceptT Failure (WriterT Journal m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. WriterT Journal (f m) a -> f (WriterT Journal m) a)
-> ExceptT Failure (WriterT Journal (f m)) a
-> ExceptT Failure (f (WriterT Journal m)) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT Failure m b -> ExceptT Failure n b
hoist WriterT Journal (f m) a -> f (WriterT Journal m) a
forall a. WriterT Journal (f m) a -> f (WriterT Journal m) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f (WriterT Journal) m =>
WriterT Journal (f m) a -> f (WriterT Journal m) a
distributeT (ExceptT Failure (WriterT Journal (f m)) a
-> ExceptT Failure (f (WriterT Journal m)) a)
-> (TestT (f m) a -> ExceptT Failure (WriterT Journal (f m)) a)
-> TestT (f m) a
-> ExceptT Failure (f (WriterT Journal m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TestT (f m) a -> ExceptT Failure (WriterT Journal (f m)) a
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest
instance PrimMonad m => PrimMonad (TestT m) where
type PrimState (TestT m) =
PrimState m
primitive :: forall a.
(State# (PrimState (TestT m))
-> (# State# (PrimState (TestT m)), a #))
-> TestT m a
primitive =
m a -> TestT m a
forall (m :: * -> *) a. Monad m => m a -> TestT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TestT m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance MonadError e m => MonadError e (TestT m) where
throwError :: forall a. e -> TestT m a
throwError =
m a -> TestT m a
forall (m :: * -> *) a. Monad m => m a -> TestT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TestT m a) -> (e -> m a) -> e -> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: forall a. TestT m a -> (e -> TestT m a) -> TestT m a
catchError TestT m a
m e -> TestT m a
onErr =
ExceptT Failure (WriterT Journal m) a -> TestT m a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (ExceptT Failure (WriterT Journal m) a -> TestT m a)
-> (WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a)
-> WriterT Journal m (Either Failure a)
-> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT Journal m (Either Failure a) -> TestT m a)
-> WriterT Journal m (Either Failure a) -> TestT m a
forall a b. (a -> b) -> a -> b
$
(ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a))
-> ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a)
forall a b. (a -> b) -> a -> b
$ TestT m a -> ExceptT Failure (WriterT Journal m) a
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest TestT m a
m) WriterT Journal m (Either Failure a)
-> (e -> WriterT Journal m (Either Failure a))
-> WriterT Journal m (Either Failure a)
forall a.
WriterT Journal m a
-> (e -> WriterT Journal m a) -> WriterT Journal m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError`
(ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a))
-> (e -> ExceptT Failure (WriterT Journal m) a)
-> e
-> WriterT Journal m (Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestT m a -> ExceptT Failure (WriterT Journal m) a
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest (TestT m a -> ExceptT Failure (WriterT Journal m) a)
-> (e -> TestT m a) -> e -> ExceptT Failure (WriterT Journal m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TestT m a
onErr)
instance MonadResource m => MonadResource (TestT m) where
liftResourceT :: forall a. ResourceT IO a -> TestT m a
liftResourceT =
m a -> TestT m a
forall (m :: * -> *) a. Monad m => m a -> TestT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TestT m a)
-> (ResourceT IO a -> m a) -> ResourceT IO a -> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO a -> m a
forall a. ResourceT IO a -> m a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT
instance MonadTransControl TestT where
type StT TestT a =
(Either Failure a, Journal)
liftWith :: forall (m :: * -> *) a. Monad m => (Run TestT -> m a) -> TestT m a
liftWith Run TestT -> m a
f =
m (Either Failure a, Journal) -> TestT m a
forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT (m (Either Failure a, Journal) -> TestT m a)
-> (m a -> m (Either Failure a, Journal)) -> m a -> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Failure a -> (Either Failure a, Journal))
-> m (Either Failure a) -> m (Either Failure a, Journal)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Journal
forall a. Monoid a => a
mempty) (m (Either Failure a) -> m (Either Failure a, Journal))
-> (m a -> m (Either Failure a))
-> m a
-> m (Either Failure a, Journal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either Failure a) -> m a -> m (Either Failure a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Failure a
forall a b. b -> Either a b
Right (m a -> TestT m a) -> m a -> TestT m a
forall a b. (a -> b) -> a -> b
$ Run TestT -> m a
f (Run TestT -> m a) -> Run TestT -> m a
forall a b. (a -> b) -> a -> b
$ TestT n b -> n (Either Failure b, Journal)
TestT n b -> n (StT TestT b)
Run TestT
forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT
restoreT :: forall (m :: * -> *) a. Monad m => m (StT TestT a) -> TestT m a
restoreT =
m (Either Failure a, Journal) -> TestT m a
m (StT TestT a) -> TestT m a
forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT
instance MonadBaseControl b m => MonadBaseControl b (TestT m) where
type StM (TestT m) a =
ComposeSt TestT m a
liftBaseWith :: forall a. (RunInBase (TestT m) b -> b a) -> TestT m a
liftBaseWith =
(RunInBaseDefault TestT m b -> b a) -> TestT m a
(RunInBase (TestT m) b -> b a) -> TestT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: forall a. StM (TestT m) a -> TestT m a
restoreM =
ComposeSt TestT m a -> TestT m a
StM (TestT m) a -> TestT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
class Monad m => MonadTest m where
liftTest :: Test a -> m a
instance Monad m => MonadTest (TestT m) where
liftTest :: forall a. Test a -> TestT m a
liftTest =
(forall a. Identity a -> m a) -> TestT Identity a -> TestT m a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TestT m b -> TestT n b
hoist (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)
instance MonadTest m => MonadTest (IdentityT m) where
liftTest :: forall a. Test a -> IdentityT m a
liftTest =
m a -> IdentityT m a
forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> (Test a -> m a) -> Test a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (MaybeT m) where
liftTest :: forall a. Test a -> MaybeT m a
liftTest =
m a -> MaybeT m a
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a) -> (Test a -> m a) -> Test a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (ExceptT x m) where
liftTest :: forall a. Test a -> ExceptT x m a
liftTest =
m a -> ExceptT x m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT x m a)
-> (Test a -> m a) -> Test a -> ExceptT x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (ReaderT r m) where
liftTest :: forall a. Test a -> ReaderT r m a
liftTest =
m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (Test a -> m a) -> Test a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (Lazy.StateT s m) where
liftTest :: forall a. Test a -> StateT s m a
liftTest =
m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (Test a -> m a) -> Test a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (Strict.StateT s m) where
liftTest :: forall a. Test a -> StateT s m a
liftTest =
m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (Test a -> m a) -> Test a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance (MonadTest m, Monoid w) => MonadTest (Lazy.WriterT w m) where
liftTest :: forall a. Test a -> WriterT w m a
liftTest =
m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (Test a -> m a) -> Test a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance (MonadTest m, Monoid w) => MonadTest (Strict.WriterT w m) where
liftTest :: forall a. Test a -> WriterT w m a
liftTest =
m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (Test a -> m a) -> Test a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance (MonadTest m, Monoid w) => MonadTest (Lazy.RWST r w s m) where
liftTest :: forall a. Test a -> RWST r w s m a
liftTest =
m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (Test a -> m a) -> Test a -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance (MonadTest m, Monoid w) => MonadTest (Strict.RWST r w s m) where
liftTest :: forall a. Test a -> RWST r w s m a
liftTest =
m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (Test a -> m a) -> Test a -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (ContT r m) where
liftTest :: forall a. Test a -> ContT r m a
liftTest =
m a -> ContT r m a
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContT r m a) -> (Test a -> m a) -> Test a -> ContT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
instance MonadTest m => MonadTest (ResourceT m) where
liftTest :: forall a. Test a -> ResourceT m a
liftTest =
m a -> ResourceT m a
forall (m :: * -> *) a. Monad m => m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ResourceT m a)
-> (Test a -> m a) -> Test a -> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest
mkTestT :: m (Either Failure a, Journal) -> TestT m a
mkTestT :: forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT =
ExceptT Failure (WriterT Journal m) a -> TestT m a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (ExceptT Failure (WriterT Journal m) a -> TestT m a)
-> (m (Either Failure a, Journal)
-> ExceptT Failure (WriterT Journal m) a)
-> m (Either Failure a, Journal)
-> TestT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a)
-> (m (Either Failure a, Journal)
-> WriterT Journal m (Either Failure a))
-> m (Either Failure a, Journal)
-> ExceptT Failure (WriterT Journal m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either Failure a, Journal)
-> WriterT Journal m (Either Failure a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT
mkTest :: (Either Failure a, Journal) -> Test a
mkTest :: forall a. (Either Failure a, Journal) -> Test a
mkTest =
Identity (Either Failure a, Journal) -> TestT Identity a
forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT (Identity (Either Failure a, Journal) -> TestT Identity a)
-> ((Either Failure a, Journal)
-> Identity (Either Failure a, Journal))
-> (Either Failure a, Journal)
-> TestT Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Failure a, Journal) -> Identity (Either Failure a, Journal)
forall a. a -> Identity a
Identity
runTestT :: TestT m a -> m (Either Failure a, Journal)
runTestT :: forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT =
WriterT Journal m (Either Failure a)
-> m (Either Failure a, Journal)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (WriterT Journal m (Either Failure a)
-> m (Either Failure a, Journal))
-> (TestT m a -> WriterT Journal m (Either Failure a))
-> TestT m a
-> m (Either Failure a, Journal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure (WriterT Journal m) a
-> WriterT Journal m (Either Failure a))
-> (TestT m a -> ExceptT Failure (WriterT Journal m) a)
-> TestT m a
-> WriterT Journal m (Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestT m a -> ExceptT Failure (WriterT Journal m) a
forall (m :: * -> *) a.
TestT m a -> ExceptT Failure (WriterT Journal m) a
unTest
runTest :: Test a -> (Either Failure a, Journal)
runTest :: forall a. Test a -> (Either Failure a, Journal)
runTest =
Identity (Either Failure a, Journal) -> (Either Failure a, Journal)
forall a. Identity a -> a
runIdentity (Identity (Either Failure a, Journal)
-> (Either Failure a, Journal))
-> (Test a -> Identity (Either Failure a, Journal))
-> Test a
-> (Either Failure a, Journal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test a -> Identity (Either Failure a, Journal)
forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT
writeLog :: MonadTest m => Log -> m ()
writeLog :: forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog Log
x =
Test () -> m ()
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest (Test () -> m ()) -> Test () -> m ()
forall a b. (a -> b) -> a -> b
$ (Either Failure (), Journal) -> Test ()
forall a. (Either Failure a, Journal) -> Test a
mkTest (() -> Either Failure ()
forall a. a -> Either Failure a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), ([Log] -> Journal
Journal [Log
x]))
failWith :: (MonadTest m, HasCallStack) => Maybe Diff -> String -> m a
failWith :: forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
mdiff String
msg =
Test a -> m a
forall a. Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest (Test a -> m a) -> Test a -> m a
forall a b. (a -> b) -> a -> b
$ (Either Failure a, Journal) -> Test a
forall a. (Either Failure a, Journal) -> Test a
mkTest (Failure -> Either Failure a
forall a b. a -> Either a b
Left (Failure -> Either Failure a) -> Failure -> Either Failure a
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Maybe Diff -> Failure
Failure (CallStack -> Maybe Span
getCaller CallStack
HasCallStack => CallStack
callStack) String
msg Maybe Diff
mdiff, Journal
forall a. Monoid a => a
mempty)
annotate :: (MonadTest m, HasCallStack) => String -> m ()
annotate :: forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
annotate String
x = do
Log -> m ()
forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog (Log -> m ()) -> Log -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Log
Annotation (CallStack -> Maybe Span
getCaller CallStack
HasCallStack => CallStack
callStack) String
x
annotateShow :: (MonadTest m, Show a, HasCallStack) => a -> m ()
annotateShow :: forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
annotateShow a
x = do
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
annotate (a -> String
forall a. Show a => a -> String
showPretty a
x)
footnote :: MonadTest m => String -> m ()
=
Log -> m ()
forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog (Log -> m ()) -> (String -> Log) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Log
Footnote
footnoteShow :: (MonadTest m, Show a) => a -> m ()
=
Log -> m ()
forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog (Log -> m ()) -> (a -> Log) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Log
Footnote (String -> Log) -> (a -> String) -> a -> Log
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
showPretty
failDiff :: (MonadTest m, Show a, Show b, HasCallStack) => a -> b -> m ()
failDiff :: forall (m :: * -> *) a b.
(MonadTest m, Show a, Show b, HasCallStack) =>
a -> b -> m ()
failDiff a
x b
y =
case Value -> Value -> ValueDiff
valueDiff (Value -> Value -> ValueDiff)
-> Maybe Value -> Maybe (Value -> ValueDiff)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Value
forall a. Show a => a -> Maybe Value
mkValue a
x Maybe (Value -> ValueDiff) -> Maybe Value -> Maybe ValueDiff
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Value
forall a. Show a => a -> Maybe Value
mkValue b
y of
Maybe ValueDiff
Nothing ->
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Diff -> String -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [
String
"Failed"
, String
"━━ lhs ━━"
, a -> String
forall a. Show a => a -> String
showPretty a
x
, String
"━━ rhs ━━"
, b -> String
forall a. Show a => a -> String
showPretty b
y
]
Just vdiff :: ValueDiff
vdiff@(ValueSame Value
_) ->
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Diff -> String -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith (Diff -> Maybe Diff
forall a. a -> Maybe a
Just (Diff -> Maybe Diff) -> Diff -> Maybe Diff
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> String -> String -> ValueDiff -> Diff
Diff String
"━━━ Failed (" String
"" String
"no differences" String
"" String
") ━━━" ValueDiff
vdiff) String
""
Just ValueDiff
vdiff ->
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Diff -> String -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith (Diff -> Maybe Diff
forall a. a -> Maybe a
Just (Diff -> Maybe Diff) -> Diff -> Maybe Diff
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> String -> String -> ValueDiff -> Diff
Diff String
"━━━ Failed (" String
"- lhs" String
") (" String
"+ rhs" String
") ━━━" ValueDiff
vdiff) String
""
failException :: (MonadTest m, HasCallStack) => SomeException -> m a
failException :: forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
SomeException -> m a
failException SomeException
x =
(HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$
[String] -> SomeException -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
[String] -> SomeException -> m a
failExceptionWith [] SomeException
x
failExceptionWith :: (MonadTest m, HasCallStack) => [String] -> SomeException -> m a
failExceptionWith :: forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
[String] -> SomeException -> m a
failExceptionWith [String]
messages (SomeException e
x) =
(HasCallStack => Maybe Diff -> String -> m a)
-> Maybe Diff -> String -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
HasCallStack => Maybe Diff -> String -> m a
Maybe Diff -> String -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
messages [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [
String
"━━━ Exception (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ━━━"
, (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
Char.isSpace (e -> String
forall e. Exception e => e -> String
displayException e
x)
]
failure :: (MonadTest m, HasCallStack) => m a
failure :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure =
(HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$ Maybe Diff -> String -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing String
""
success :: MonadTest m => m ()
success :: forall (m :: * -> *). MonadTest m => m ()
success =
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
assert :: (MonadTest m, HasCallStack) => Bool -> m ()
assert :: forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert Bool
b = do
Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
eval Bool
b
if Bool
ok then
m ()
forall (m :: * -> *). MonadTest m => m ()
success
else
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack m ()
HasCallStack => m ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure
diff :: (MonadTest m, Show a, Show b, HasCallStack) => a -> (a -> b -> Bool) -> b -> m ()
diff :: forall (m :: * -> *) a b.
(MonadTest m, Show a, Show b, HasCallStack) =>
a -> (a -> b -> Bool) -> b -> m ()
diff a
x a -> b -> Bool
op b
y = do
Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
eval (a
x a -> b -> Bool
`op` b
y)
if Bool
ok then
m ()
forall (m :: * -> *). MonadTest m => m ()
success
else
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ a -> b -> m ()
forall (m :: * -> *) a b.
(MonadTest m, Show a, Show b, HasCallStack) =>
a -> b -> m ()
failDiff a
x b
y
infix 4 ===
(===) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m ()
=== :: forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
(===) a
x a
y =
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
a -> (a -> a -> Bool) -> a -> m ()
forall (m :: * -> *) a b.
(MonadTest m, Show a, Show b, HasCallStack) =>
a -> (a -> b -> Bool) -> b -> m ()
diff a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) a
y
infix 4 /==
(/==) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m ()
/== :: forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
(/==) a
x a
y =
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
a -> (a -> a -> Bool) -> a -> m ()
forall (m :: * -> *) a b.
(MonadTest m, Show a, Show b, HasCallStack) =>
a -> (a -> b -> Bool) -> b -> m ()
diff a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) a
y
eval :: (MonadTest m, HasCallStack) => a -> m a
eval :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
eval a
x =
(SomeException -> m a)
-> (a -> m a) -> Either SomeException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((HasCallStack => SomeException -> m a) -> SomeException -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => SomeException -> m a
SomeException -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
SomeException -> m a
failException) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either SomeException a
forall a. a -> Either SomeException a
tryEvaluate a
x)
evalNF :: (MonadTest m, NFData a, HasCallStack) => a -> m a
evalNF :: forall (m :: * -> *) a.
(MonadTest m, NFData a, HasCallStack) =>
a -> m a
evalNF a
x =
let
messages :: [String]
messages =
[String
"━━━ Value could not be evaluated to normal form ━━━"]
in
(SomeException -> m ())
-> (() -> m ()) -> Either SomeException () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((HasCallStack => SomeException -> m ()) -> SomeException -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ([String] -> SomeException -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
[String] -> SomeException -> m a
failExceptionWith [String]
messages)) () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either SomeException ()
forall a. a -> Either SomeException a
tryEvaluate (a -> ()
forall a. NFData a => a -> ()
rnf a
x)) m () -> a -> m a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
x
evalM :: (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a
evalM :: forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
evalM m a
m =
(SomeException -> m a)
-> (a -> m a) -> Either SomeException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((HasCallStack => SomeException -> m a) -> SomeException -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => SomeException -> m a
SomeException -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
SomeException -> m a
failException) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m a)
-> m (Either SomeException a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a -> m (Either SomeException a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAll m a
m
evalIO :: (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a
evalIO :: forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
evalIO IO a
m =
(SomeException -> m a)
-> (a -> m a) -> Either SomeException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((HasCallStack => SomeException -> m a) -> SomeException -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => SomeException -> m a
SomeException -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
SomeException -> m a
failException) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m a)
-> m (Either SomeException a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either SomeException a) -> m (Either SomeException a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAll IO a
m)
evalEither :: (MonadTest m, Show x, HasCallStack) => Either x a -> m a
evalEither :: forall (m :: * -> *) x a.
(MonadTest m, Show x, HasCallStack) =>
Either x a -> m a
evalEither = \case
Left x
x ->
(HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$ Maybe Diff -> String -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ x -> String
forall a. Show a => a -> String
showPretty x
x
Right a
x ->
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
evalEitherM :: (MonadTest m, Show x, MonadCatch m, HasCallStack) => m (Either x a) -> m a
evalEitherM :: forall (m :: * -> *) x a.
(MonadTest m, Show x, MonadCatch m, HasCallStack) =>
m (Either x a) -> m a
evalEitherM =
Either x a -> m a
forall (m :: * -> *) x a.
(MonadTest m, Show x, HasCallStack) =>
Either x a -> m a
evalEither (Either x a -> m a)
-> (m (Either x a) -> m (Either x a)) -> m (Either x a) -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m (Either x a) -> m (Either x a)
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
evalM
evalExceptT :: (MonadTest m, Show x, HasCallStack) => ExceptT x m a -> m a
evalExceptT :: forall (m :: * -> *) x a.
(MonadTest m, Show x, HasCallStack) =>
ExceptT x m a -> m a
evalExceptT ExceptT x m a
m =
(HasCallStack => Either x a -> m a) -> Either x a -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => Either x a -> m a
Either x a -> m a
forall (m :: * -> *) x a.
(MonadTest m, Show x, HasCallStack) =>
Either x a -> m a
evalEither (Either x a -> m a) -> m (Either x a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptT x m a -> m (Either x a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT x m a
m
evalMaybe :: (MonadTest m, Show a, HasCallStack) => Maybe a -> m a
evalMaybe :: forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
Maybe a -> m a
evalMaybe = \case
Maybe a
Nothing ->
(HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$ Maybe Diff -> String -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing String
"the value was Nothing"
Just a
x ->
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
evalMaybeM :: (MonadTest m, Show a, MonadCatch m, HasCallStack) => m (Maybe a) -> m a
evalMaybeM :: forall (m :: * -> *) a.
(MonadTest m, Show a, MonadCatch m, HasCallStack) =>
m (Maybe a) -> m a
evalMaybeM =
Maybe a -> m a
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
Maybe a -> m a
evalMaybe (Maybe a -> m a)
-> (m (Maybe a) -> m (Maybe a)) -> m (Maybe a) -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
evalM
instance MonadTrans PropertyT where
lift :: forall (m :: * -> *) a. Monad m => m a -> PropertyT m a
lift =
TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT m) a -> PropertyT m a)
-> (m a -> TestT (GenT m) a) -> m a -> PropertyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT m a -> TestT (GenT m) a
forall (m :: * -> *) a. Monad m => m a -> TestT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GenT m a -> TestT (GenT m) a)
-> (m a -> GenT m a) -> m a -> TestT (GenT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> GenT m a
forall (m :: * -> *) a. Monad m => m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance Monad m => MonadFail (PropertyT m) where
fail :: forall a. String -> PropertyT m a
fail String
err =
TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (String -> TestT (GenT m) a
forall a. String -> TestT (GenT m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
err)
instance MFunctor PropertyT where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> PropertyT m b -> PropertyT n b
hoist forall a. m a -> n a
f =
TestT (GenT n) b -> PropertyT n b
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT n) b -> PropertyT n b)
-> (PropertyT m b -> TestT (GenT n) b)
-> PropertyT m b
-> PropertyT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. GenT m a -> GenT n a)
-> TestT (GenT m) b -> TestT (GenT n) b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TestT m b -> TestT n b
hoist ((forall a. m a -> n a) -> GenT m a -> GenT n a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> GenT m b -> GenT n b
hoist m a -> n a
forall a. m a -> n a
f) (TestT (GenT m) b -> TestT (GenT n) b)
-> (PropertyT m b -> TestT (GenT m) b)
-> PropertyT m b
-> TestT (GenT n) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyT m b -> TestT (GenT m) b
forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
unPropertyT
instance MonadTransDistributive PropertyT where
type Transformer t PropertyT m = (
Transformer t GenT m
, Transformer t TestT (GenT m)
)
distributeT :: forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f PropertyT m =>
PropertyT (f m) a -> f (PropertyT m) a
distributeT =
(forall a. TestT (GenT m) a -> PropertyT m a)
-> f (TestT (GenT m)) a -> f (PropertyT m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> f m b -> f n b
hoist TestT (GenT m) a -> PropertyT m a
forall a. TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (f (TestT (GenT m)) a -> f (PropertyT m) a)
-> (PropertyT (f m) a -> f (TestT (GenT m)) a)
-> PropertyT (f m) a
-> f (PropertyT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TestT (f (GenT m)) a -> f (TestT (GenT m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f TestT m =>
TestT (f m) a -> f (TestT m) a
distributeT (TestT (f (GenT m)) a -> f (TestT (GenT m)) a)
-> (PropertyT (f m) a -> TestT (f (GenT m)) a)
-> PropertyT (f m) a
-> f (TestT (GenT m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. GenT (f m) a -> f (GenT m) a)
-> TestT (GenT (f m)) a -> TestT (f (GenT m)) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TestT m b -> TestT n b
hoist GenT (f m) a -> f (GenT m) a
forall a. GenT (f m) a -> f (GenT m) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
(m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f GenT m =>
GenT (f m) a -> f (GenT m) a
distributeT (TestT (GenT (f m)) a -> TestT (f (GenT m)) a)
-> (PropertyT (f m) a -> TestT (GenT (f m)) a)
-> PropertyT (f m) a
-> TestT (f (GenT m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
PropertyT (f m) a -> TestT (GenT (f m)) a
forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
unPropertyT
instance PrimMonad m => PrimMonad (PropertyT m) where
type PrimState (PropertyT m) =
PrimState m
primitive :: forall a.
(State# (PrimState (PropertyT m))
-> (# State# (PrimState (PropertyT m)), a #))
-> PropertyT m a
primitive =
m a -> PropertyT m a
forall (m :: * -> *) a. Monad m => m a -> PropertyT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PropertyT m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> PropertyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance Monad m => MonadTest (PropertyT m) where
liftTest :: forall a. Test a -> PropertyT m a
liftTest =
TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT m) a -> PropertyT m a)
-> (Test a -> TestT (GenT m) a) -> Test a -> PropertyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Identity a -> GenT m a) -> Test a -> TestT (GenT m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TestT m b -> TestT n b
hoist (a -> GenT m a
forall a. a -> GenT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> GenT m a) -> (Identity a -> a) -> Identity a -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)
instance MonadPlus m => MonadPlus (PropertyT m) where
mzero :: forall a. PropertyT m a
mzero =
PropertyT m a
forall (m :: * -> *) a. Monad m => PropertyT m a
discard
mplus :: forall a. PropertyT m a -> PropertyT m a -> PropertyT m a
mplus (PropertyT TestT (GenT m) a
x) (PropertyT TestT (GenT m) a
y) =
TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT m) a -> PropertyT m a)
-> (GenT m (Either Failure a, Journal) -> TestT (GenT m) a)
-> GenT m (Either Failure a, Journal)
-> PropertyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT m (Either Failure a, Journal) -> TestT (GenT m) a
forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT (GenT m (Either Failure a, Journal) -> PropertyT m a)
-> GenT m (Either Failure a, Journal) -> PropertyT m a
forall a b. (a -> b) -> a -> b
$
GenT m (Either Failure a, Journal)
-> GenT m (Either Failure a, Journal)
-> GenT m (Either Failure a, Journal)
forall a. GenT m a -> GenT m a -> GenT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (TestT (GenT m) a -> GenT m (Either Failure a, Journal)
forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT TestT (GenT m) a
x) (TestT (GenT m) a -> GenT m (Either Failure a, Journal)
forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT TestT (GenT m) a
y)
instance MonadPlus m => Alternative (PropertyT m) where
empty :: forall a. PropertyT m a
empty =
PropertyT m a
forall a. PropertyT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. PropertyT m a -> PropertyT m a -> PropertyT m a
(<|>) =
PropertyT m a -> PropertyT m a -> PropertyT m a
forall a. PropertyT m a -> PropertyT m a -> PropertyT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
forAllWithT :: (Monad m, HasCallStack) => (a -> String) -> GenT m a -> PropertyT m a
forAllWithT :: forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> GenT m a -> PropertyT m a
forAllWithT a -> String
render GenT m a
gen = do
a
x <- TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT m) a -> PropertyT m a)
-> TestT (GenT m) a -> PropertyT m a
forall a b. (a -> b) -> a -> b
$ GenT m a -> TestT (GenT m) a
forall (m :: * -> *) a. Monad m => m a -> TestT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GenT m a
gen
(HasCallStack => PropertyT m ()) -> PropertyT m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => PropertyT m ()) -> PropertyT m ())
-> (HasCallStack => PropertyT m ()) -> PropertyT m ()
forall a b. (a -> b) -> a -> b
$ String -> PropertyT m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
annotate (a -> String
render a
x)
return a
x
forAllWith :: (Monad m, HasCallStack) => (a -> String) -> Gen a -> PropertyT m a
forAllWith :: forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> Gen a -> PropertyT m a
forAllWith a -> String
render Gen a
gen =
(HasCallStack => PropertyT m a) -> PropertyT m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => PropertyT m a) -> PropertyT m a)
-> (HasCallStack => PropertyT m a) -> PropertyT m a
forall a b. (a -> b) -> a -> b
$ (a -> String) -> GenT m a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> GenT m a -> PropertyT m a
forAllWithT a -> String
render (GenT m a -> PropertyT m a) -> GenT m a -> PropertyT m a
forall a b. (a -> b) -> a -> b
$ Gen a -> GenT m a
forall (m :: * -> *) a. Monad m => Gen a -> GenT m a
Gen.generalize Gen a
gen
forAllT :: (Monad m, Show a, HasCallStack) => GenT m a -> PropertyT m a
forAllT :: forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
GenT m a -> PropertyT m a
forAllT GenT m a
gen =
(HasCallStack => PropertyT m a) -> PropertyT m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => PropertyT m a) -> PropertyT m a)
-> (HasCallStack => PropertyT m a) -> PropertyT m a
forall a b. (a -> b) -> a -> b
$ (a -> String) -> GenT m a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> GenT m a -> PropertyT m a
forAllWithT a -> String
forall a. Show a => a -> String
showPretty GenT m a
gen
forAll :: (Monad m, Show a, HasCallStack) => Gen a -> PropertyT m a
forAll :: forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen =
(HasCallStack => PropertyT m a) -> PropertyT m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => PropertyT m a) -> PropertyT m a)
-> (HasCallStack => PropertyT m a) -> PropertyT m a
forall a b. (a -> b) -> a -> b
$ (a -> String) -> Gen a -> PropertyT m a
forall (m :: * -> *) a.
(Monad m, HasCallStack) =>
(a -> String) -> Gen a -> PropertyT m a
forAllWith a -> String
forall a. Show a => a -> String
showPretty Gen a
gen
discard :: Monad m => PropertyT m a
discard :: forall (m :: * -> *) a. Monad m => PropertyT m a
discard =
TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT m) a -> PropertyT m a)
-> TestT (GenT m) a -> PropertyT m a
forall a b. (a -> b) -> a -> b
$ GenT m a -> TestT (GenT m) a
forall (m :: * -> *) a. Monad m => m a -> TestT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen a -> GenT m a
forall (m :: * -> *) a. Monad m => Gen a -> GenT m a
Gen.generalize Gen a
forall (m :: * -> *) a. MonadGen m => m a
Gen.discard)
test :: Monad m => TestT m a -> PropertyT m a
test :: forall (m :: * -> *) a. Monad m => TestT m a -> PropertyT m a
test =
TestT (GenT m) a -> PropertyT m a
forall (m :: * -> *) a. TestT (GenT m) a -> PropertyT m a
PropertyT (TestT (GenT m) a -> PropertyT m a)
-> (TestT m a -> TestT (GenT m) a) -> TestT m a -> PropertyT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT m a) -> TestT m a -> TestT (GenT m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TestT m b -> TestT n b
hoist m a -> GenT m a
forall a. m a -> GenT m a
forall (m :: * -> *) a. Monad m => m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
defaultConfig :: PropertyConfig
defaultConfig :: PropertyConfig
defaultConfig =
PropertyConfig {
propertyDiscardLimit :: DiscardLimit
propertyDiscardLimit =
DiscardLimit
100
, propertyShrinkLimit :: ShrinkLimit
propertyShrinkLimit =
ShrinkLimit
1000
, propertyShrinkRetries :: ShrinkRetries
propertyShrinkRetries =
ShrinkRetries
0
, propertyTerminationCriteria :: TerminationCriteria
propertyTerminationCriteria =
TestLimit -> TerminationCriteria
NoConfidenceTermination TestLimit
defaultMinTests
, propertySkip :: Maybe Skip
propertySkip =
Maybe Skip
forall a. Maybe a
Nothing
}
defaultMinTests :: TestLimit
defaultMinTests :: TestLimit
defaultMinTests = TestLimit
100
defaultConfidence :: Confidence
defaultConfidence :: Confidence
defaultConfidence = Confidence
10 Confidence -> Int -> Confidence
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
9 :: Int)
mapConfig :: (PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig :: (PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig PropertyConfig -> PropertyConfig
f (Property PropertyConfig
cfg PropertyT IO ()
t) =
PropertyConfig -> PropertyT IO () -> Property
Property (PropertyConfig -> PropertyConfig
f PropertyConfig
cfg) PropertyT IO ()
t
withConfidence :: Confidence -> Property -> Property
withConfidence :: Confidence -> Property -> Property
withConfidence Confidence
c =
let
setConfidence :: TerminationCriteria -> TerminationCriteria
setConfidence = \case
NoEarlyTermination Confidence
_ TestLimit
tests -> Confidence -> TestLimit -> TerminationCriteria
NoEarlyTermination Confidence
c TestLimit
tests
NoConfidenceTermination TestLimit
tests -> Confidence -> TestLimit -> TerminationCriteria
NoEarlyTermination Confidence
c TestLimit
tests
EarlyTermination Confidence
_ TestLimit
tests -> Confidence -> TestLimit -> TerminationCriteria
EarlyTermination Confidence
c TestLimit
tests
in
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \config :: PropertyConfig
config@PropertyConfig{Maybe Skip
TerminationCriteria
ShrinkRetries
ShrinkLimit
DiscardLimit
propertyDiscardLimit :: PropertyConfig -> DiscardLimit
propertyShrinkLimit :: PropertyConfig -> ShrinkLimit
propertyShrinkRetries :: PropertyConfig -> ShrinkRetries
propertyTerminationCriteria :: PropertyConfig -> TerminationCriteria
propertySkip :: PropertyConfig -> Maybe Skip
propertyDiscardLimit :: DiscardLimit
propertyShrinkLimit :: ShrinkLimit
propertyShrinkRetries :: ShrinkRetries
propertyTerminationCriteria :: TerminationCriteria
propertySkip :: Maybe Skip
..} ->
PropertyConfig
config
{ propertyTerminationCriteria =
setConfidence propertyTerminationCriteria
}
verifiedTermination :: Property -> Property
verifiedTermination :: Property -> Property
verifiedTermination =
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \config :: PropertyConfig
config@PropertyConfig{Maybe Skip
TerminationCriteria
ShrinkRetries
ShrinkLimit
DiscardLimit
propertyDiscardLimit :: PropertyConfig -> DiscardLimit
propertyShrinkLimit :: PropertyConfig -> ShrinkLimit
propertyShrinkRetries :: PropertyConfig -> ShrinkRetries
propertyTerminationCriteria :: PropertyConfig -> TerminationCriteria
propertySkip :: PropertyConfig -> Maybe Skip
propertyDiscardLimit :: DiscardLimit
propertyShrinkLimit :: ShrinkLimit
propertyShrinkRetries :: ShrinkRetries
propertyTerminationCriteria :: TerminationCriteria
propertySkip :: Maybe Skip
..} ->
let
newTerminationCriteria :: TerminationCriteria
newTerminationCriteria = case TerminationCriteria
propertyTerminationCriteria of
NoEarlyTermination Confidence
c TestLimit
tests -> Confidence -> TestLimit -> TerminationCriteria
EarlyTermination Confidence
c TestLimit
tests
NoConfidenceTermination TestLimit
tests -> Confidence -> TestLimit -> TerminationCriteria
EarlyTermination Confidence
defaultConfidence TestLimit
tests
EarlyTermination Confidence
c TestLimit
tests -> Confidence -> TestLimit -> TerminationCriteria
EarlyTermination Confidence
c TestLimit
tests
in
PropertyConfig
config { propertyTerminationCriteria = newTerminationCriteria }
withTests :: TestLimit -> Property -> Property
withTests :: TestLimit -> Property -> Property
withTests TestLimit
n =
let
setTestLimit :: TestLimit -> TerminationCriteria -> TerminationCriteria
setTestLimit TestLimit
tests = \case
NoEarlyTermination Confidence
c TestLimit
_ -> Confidence -> TestLimit -> TerminationCriteria
NoEarlyTermination Confidence
c TestLimit
tests
NoConfidenceTermination TestLimit
_ -> TestLimit -> TerminationCriteria
NoConfidenceTermination TestLimit
tests
EarlyTermination Confidence
c TestLimit
_ -> Confidence -> TestLimit -> TerminationCriteria
EarlyTermination Confidence
c TestLimit
tests
in
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \config :: PropertyConfig
config@PropertyConfig{Maybe Skip
TerminationCriteria
ShrinkRetries
ShrinkLimit
DiscardLimit
propertyDiscardLimit :: PropertyConfig -> DiscardLimit
propertyShrinkLimit :: PropertyConfig -> ShrinkLimit
propertyShrinkRetries :: PropertyConfig -> ShrinkRetries
propertyTerminationCriteria :: PropertyConfig -> TerminationCriteria
propertySkip :: PropertyConfig -> Maybe Skip
propertyDiscardLimit :: DiscardLimit
propertyShrinkLimit :: ShrinkLimit
propertyShrinkRetries :: ShrinkRetries
propertyTerminationCriteria :: TerminationCriteria
propertySkip :: Maybe Skip
..} ->
PropertyConfig
config { propertyTerminationCriteria = setTestLimit n propertyTerminationCriteria }
withDiscards :: DiscardLimit -> Property -> Property
withDiscards :: DiscardLimit -> Property -> Property
withDiscards DiscardLimit
n =
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \PropertyConfig
config -> PropertyConfig
config { propertyDiscardLimit = n }
withShrinks :: ShrinkLimit -> Property -> Property
withShrinks :: ShrinkLimit -> Property -> Property
withShrinks ShrinkLimit
n =
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \PropertyConfig
config -> PropertyConfig
config { propertyShrinkLimit = n }
withRetries :: ShrinkRetries -> Property -> Property
withRetries :: ShrinkRetries -> Property -> Property
withRetries ShrinkRetries
n =
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \PropertyConfig
config -> PropertyConfig
config { propertyShrinkRetries = n }
withSkip :: Skip -> Property -> Property
withSkip :: Skip -> Property -> Property
withSkip Skip
s =
(PropertyConfig -> PropertyConfig) -> Property -> Property
mapConfig ((PropertyConfig -> PropertyConfig) -> Property -> Property)
-> (PropertyConfig -> PropertyConfig) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ \PropertyConfig
config -> PropertyConfig
config { propertySkip = Just s }
property :: HasCallStack => PropertyT IO () -> Property
property :: HasCallStack => PropertyT IO () -> Property
property PropertyT IO ()
m =
PropertyConfig -> PropertyT IO () -> Property
Property PropertyConfig
defaultConfig (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$
(HasCallStack => PropertyT IO ()) -> PropertyT IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (PropertyT IO () -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, MonadCatch m, HasCallStack) =>
m a -> m a
evalM PropertyT IO ()
m)
instance Semigroup Cover where
<> :: Cover -> Cover -> Cover
(<>) Cover
NoCover Cover
NoCover =
Cover
NoCover
(<>) Cover
_ Cover
_ =
Cover
Cover
instance Monoid Cover where
mempty :: Cover
mempty =
Cover
NoCover
mappend :: Cover -> Cover -> Cover
mappend =
Cover -> Cover -> Cover
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup CoverCount where
<> :: CoverCount -> CoverCount -> CoverCount
(<>) (CoverCount Int
n0) (CoverCount Int
n1) =
Int -> CoverCount
CoverCount (Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1)
instance Monoid CoverCount where
mempty :: CoverCount
mempty =
Int -> CoverCount
CoverCount Int
0
mappend :: CoverCount -> CoverCount -> CoverCount
mappend =
CoverCount -> CoverCount -> CoverCount
forall a. Semigroup a => a -> a -> a
(<>)
toCoverCount :: Cover -> CoverCount
toCoverCount :: Cover -> CoverCount
toCoverCount = \case
Cover
NoCover ->
Int -> CoverCount
CoverCount Int
0
Cover
Cover ->
Int -> CoverCount
CoverCount Int
1
instance Semigroup a => Semigroup (Label a) where
<> :: Label a -> Label a -> Label a
(<>) (MkLabel LabelName
_ Maybe Span
_ CoverPercentage
_ a
m0) (MkLabel LabelName
name Maybe Span
location CoverPercentage
percentage a
m1) =
LabelName -> Maybe Span -> CoverPercentage -> a -> Label a
forall a.
LabelName -> Maybe Span -> CoverPercentage -> a -> Label a
MkLabel LabelName
name Maybe Span
location CoverPercentage
percentage (a
m0 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
m1)
instance Semigroup a => Semigroup (Coverage a) where
<> :: Coverage a -> Coverage a -> Coverage a
(<>) (Coverage Map LabelName (Label a)
c0) (Coverage Map LabelName (Label a)
c1) =
Map LabelName (Label a) -> Coverage a
forall a. Map LabelName (Label a) -> Coverage a
Coverage (Map LabelName (Label a) -> Coverage a)
-> Map LabelName (Label a) -> Coverage a
forall a b. (a -> b) -> a -> b
$
(LabelName
-> Label a -> Map LabelName (Label a) -> Map LabelName (Label a))
-> Map LabelName (Label a)
-> Map LabelName (Label a)
-> Map LabelName (Label a)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey ((Label a -> Label a -> Label a)
-> LabelName
-> Label a
-> Map LabelName (Label a)
-> Map LabelName (Label a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Label a -> Label a -> Label a
forall a. Semigroup a => a -> a -> a
(<>)) Map LabelName (Label a)
c0 Map LabelName (Label a)
c1
instance (Semigroup a, Monoid a) => Monoid (Coverage a) where
mempty :: Coverage a
mempty =
Map LabelName (Label a) -> Coverage a
forall a. Map LabelName (Label a) -> Coverage a
Coverage Map LabelName (Label a)
forall a. Monoid a => a
mempty
mappend :: Coverage a -> Coverage a -> Coverage a
mappend =
Coverage a -> Coverage a -> Coverage a
forall a. Semigroup a => a -> a -> a
(<>)
coverPercentage :: TestCount -> CoverCount -> CoverPercentage
coverPercentage :: TestCount -> CoverCount -> CoverPercentage
coverPercentage (TestCount Int
tests) (CoverCount Int
count) =
let
percentage :: Double
percentage :: Double
percentage =
Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tests Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
thousandths :: Int
thousandths :: Int
thousandths =
Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
percentage Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10
in
Double -> CoverPercentage
CoverPercentage (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
thousandths Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10)
labelCovered :: TestCount -> Label CoverCount -> Bool
labelCovered :: TestCount -> Label CoverCount -> Bool
labelCovered TestCount
tests (MkLabel LabelName
_ Maybe Span
_ CoverPercentage
minimum_ CoverCount
population) =
TestCount -> CoverCount -> CoverPercentage
coverPercentage TestCount
tests CoverCount
population CoverPercentage -> CoverPercentage -> Bool
forall a. Ord a => a -> a -> Bool
>= CoverPercentage
minimum_
coverageSuccess :: TestCount -> Coverage CoverCount -> Bool
coverageSuccess :: TestCount -> Coverage CoverCount -> Bool
coverageSuccess TestCount
tests =
[Label CoverCount] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Label CoverCount] -> Bool)
-> (Coverage CoverCount -> [Label CoverCount])
-> Coverage CoverCount
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestCount -> Coverage CoverCount -> [Label CoverCount]
coverageFailures TestCount
tests
coverageFailures :: TestCount -> Coverage CoverCount -> [Label CoverCount]
coverageFailures :: TestCount -> Coverage CoverCount -> [Label CoverCount]
coverageFailures TestCount
tests (Coverage Map LabelName (Label CoverCount)
kvs) =
(Label CoverCount -> Bool)
-> [Label CoverCount] -> [Label CoverCount]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool)
-> (Label CoverCount -> Bool) -> Label CoverCount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestCount -> Label CoverCount -> Bool
labelCovered TestCount
tests) (Map LabelName (Label CoverCount) -> [Label CoverCount]
forall k a. Map k a -> [a]
Map.elems Map LabelName (Label CoverCount)
kvs)
confidenceSuccess :: TestCount -> Confidence -> Coverage CoverCount -> Bool
confidenceSuccess :: TestCount -> Confidence -> Coverage CoverCount -> Bool
confidenceSuccess TestCount
tests Confidence
confidence =
let
assertLow :: Label CoverCount -> Bool
assertLow :: Label CoverCount -> Bool
assertLow coverCount :: Label CoverCount
coverCount@MkLabel{Maybe Span
LabelName
CoverPercentage
CoverCount
labelName :: forall a. Label a -> LabelName
labelLocation :: forall a. Label a -> Maybe Span
labelMinimum :: forall a. Label a -> CoverPercentage
labelAnnotation :: forall a. Label a -> a
labelName :: LabelName
labelLocation :: Maybe Span
labelMinimum :: CoverPercentage
labelAnnotation :: CoverCount
..} =
(Double, Double) -> Double
forall a b. (a, b) -> a
fst (TestCount -> Confidence -> Label CoverCount -> (Double, Double)
boundsForLabel TestCount
tests Confidence
confidence Label CoverCount
coverCount)
Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= CoverPercentage -> Double
unCoverPercentage CoverPercentage
labelMinimum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0
in
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool)
-> (Coverage CoverCount -> [Bool]) -> Coverage CoverCount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Label CoverCount -> Bool) -> [Label CoverCount] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Label CoverCount -> Bool
assertLow ([Label CoverCount] -> [Bool])
-> (Coverage CoverCount -> [Label CoverCount])
-> Coverage CoverCount
-> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map LabelName (Label CoverCount) -> [Label CoverCount]
forall k a. Map k a -> [a]
Map.elems (Map LabelName (Label CoverCount) -> [Label CoverCount])
-> (Coverage CoverCount -> Map LabelName (Label CoverCount))
-> Coverage CoverCount
-> [Label CoverCount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coverage CoverCount -> Map LabelName (Label CoverCount)
forall a. Coverage a -> Map LabelName (Label a)
coverageLabels
confidenceFailure :: TestCount -> Confidence -> Coverage CoverCount -> Bool
confidenceFailure :: TestCount -> Confidence -> Coverage CoverCount -> Bool
confidenceFailure TestCount
tests Confidence
confidence =
let
assertHigh :: Label CoverCount -> Bool
assertHigh :: Label CoverCount -> Bool
assertHigh coverCount :: Label CoverCount
coverCount@MkLabel{Maybe Span
LabelName
CoverPercentage
CoverCount
labelName :: forall a. Label a -> LabelName
labelLocation :: forall a. Label a -> Maybe Span
labelMinimum :: forall a. Label a -> CoverPercentage
labelAnnotation :: forall a. Label a -> a
labelName :: LabelName
labelLocation :: Maybe Span
labelMinimum :: CoverPercentage
labelAnnotation :: CoverCount
..} =
(Double, Double) -> Double
forall a b. (a, b) -> b
snd (TestCount -> Confidence -> Label CoverCount -> (Double, Double)
boundsForLabel TestCount
tests Confidence
confidence Label CoverCount
coverCount)
Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (CoverPercentage -> Double
unCoverPercentage CoverPercentage
labelMinimum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0)
in
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> (Coverage CoverCount -> [Bool]) -> Coverage CoverCount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Label CoverCount -> Bool) -> [Label CoverCount] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Label CoverCount -> Bool
assertHigh ([Label CoverCount] -> [Bool])
-> (Coverage CoverCount -> [Label CoverCount])
-> Coverage CoverCount
-> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map LabelName (Label CoverCount) -> [Label CoverCount]
forall k a. Map k a -> [a]
Map.elems (Map LabelName (Label CoverCount) -> [Label CoverCount])
-> (Coverage CoverCount -> Map LabelName (Label CoverCount))
-> Coverage CoverCount
-> [Label CoverCount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coverage CoverCount -> Map LabelName (Label CoverCount)
forall a. Coverage a -> Map LabelName (Label a)
coverageLabels
boundsForLabel :: TestCount -> Confidence -> Label CoverCount -> (Double, Double)
boundsForLabel :: TestCount -> Confidence -> Label CoverCount -> (Double, Double)
boundsForLabel TestCount
tests Confidence
confidence MkLabel{Maybe Span
LabelName
CoverPercentage
CoverCount
labelName :: forall a. Label a -> LabelName
labelLocation :: forall a. Label a -> Maybe Span
labelMinimum :: forall a. Label a -> CoverPercentage
labelAnnotation :: forall a. Label a -> a
labelName :: LabelName
labelLocation :: Maybe Span
labelMinimum :: CoverPercentage
labelAnnotation :: CoverCount
..} =
Integer -> Integer -> Double -> (Double, Double)
wilsonBounds
(Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ CoverCount -> Int
unCoverCount CoverCount
labelAnnotation)
(TestCount -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral TestCount
tests)
(Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Confidence -> Int64
unConfidence Confidence
confidence))
wilsonBounds :: Integer -> Integer -> Double -> (Double, Double)
wilsonBounds :: Integer -> Integer -> Double -> (Double, Double)
wilsonBounds Integer
positives Integer
count Double
acceptance =
let
p :: Double
p =
Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Integer
positives Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
count
n :: Double
n =
Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count
z :: Double
z =
Double -> Double
forall a. InvErf a => a -> a
invnormcdf (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
acceptance Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
midpoint :: Double
midpoint =
Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n)
offset :: Double
offset =
Double
z Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt (Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2))
denominator :: Double
denominator =
Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n
low :: Double
low =
(Double
midpoint Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
offset) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
denominator
high :: Double
high =
(Double
midpoint Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
offset) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
denominator
in
(Double
low, Double
high)
fromLabel :: Label a -> Coverage a
fromLabel :: forall a. Label a -> Coverage a
fromLabel Label a
x =
Map LabelName (Label a) -> Coverage a
forall a. Map LabelName (Label a) -> Coverage a
Coverage (Map LabelName (Label a) -> Coverage a)
-> Map LabelName (Label a) -> Coverage a
forall a b. (a -> b) -> a -> b
$
LabelName -> Label a -> Map LabelName (Label a)
forall k a. k -> a -> Map k a
Map.singleton (Label a -> LabelName
forall a. Label a -> LabelName
labelName Label a
x) Label a
x
unionsCoverage :: Semigroup a => [Coverage a] -> Coverage a
unionsCoverage :: forall a. Semigroup a => [Coverage a] -> Coverage a
unionsCoverage =
Map LabelName (Label a) -> Coverage a
forall a. Map LabelName (Label a) -> Coverage a
Coverage (Map LabelName (Label a) -> Coverage a)
-> ([Coverage a] -> Map LabelName (Label a))
-> [Coverage a]
-> Coverage a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Label a -> Label a -> Label a)
-> [Map LabelName (Label a)] -> Map LabelName (Label a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Label a -> Label a -> Label a
forall a. Semigroup a => a -> a -> a
(<>) ([Map LabelName (Label a)] -> Map LabelName (Label a))
-> ([Coverage a] -> [Map LabelName (Label a)])
-> [Coverage a]
-> Map LabelName (Label a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Coverage a -> Map LabelName (Label a))
-> [Coverage a] -> [Map LabelName (Label a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coverage a -> Map LabelName (Label a)
forall a. Coverage a -> Map LabelName (Label a)
coverageLabels
journalCoverage :: Journal -> Coverage CoverCount
journalCoverage :: Journal -> Coverage CoverCount
journalCoverage (Journal [Log]
logs) =
(Cover -> CoverCount) -> Coverage Cover -> Coverage CoverCount
forall a b. (a -> b) -> Coverage a -> Coverage b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cover -> CoverCount
toCoverCount (Coverage Cover -> Coverage CoverCount)
-> ([Coverage Cover] -> Coverage Cover)
-> [Coverage Cover]
-> Coverage CoverCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Coverage Cover] -> Coverage Cover
forall a. Semigroup a => [Coverage a] -> Coverage a
unionsCoverage ([Coverage Cover] -> Coverage CoverCount)
-> [Coverage Cover] -> Coverage CoverCount
forall a b. (a -> b) -> a -> b
$ do
Label Label Cover
x <- [Log]
logs
Coverage Cover -> [Coverage Cover]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Label Cover -> Coverage Cover
forall a. Label a -> Coverage a
fromLabel Label Cover
x)
cover :: (MonadTest m, HasCallStack) => CoverPercentage -> LabelName -> Bool -> m ()
cover :: forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
minimum_ LabelName
name Bool
covered =
let
cover_ :: Cover
cover_ =
if Bool
covered then
Cover
Cover
else
Cover
NoCover
in
Log -> m ()
forall (m :: * -> *). MonadTest m => Log -> m ()
writeLog (Log -> m ()) -> (Label Cover -> Log) -> Label Cover -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label Cover -> Log
Label (Label Cover -> m ()) -> Label Cover -> m ()
forall a b. (a -> b) -> a -> b
$
LabelName -> Maybe Span -> CoverPercentage -> Cover -> Label Cover
forall a.
LabelName -> Maybe Span -> CoverPercentage -> a -> Label a
MkLabel LabelName
name (CallStack -> Maybe Span
getCaller CallStack
HasCallStack => CallStack
callStack) CoverPercentage
minimum_ Cover
cover_
classify :: (MonadTest m, HasCallStack) => LabelName -> Bool -> m ()
classify :: forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> Bool -> m ()
classify LabelName
name Bool
covered =
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
CoverPercentage -> LabelName -> Bool -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
0 LabelName
name Bool
covered
label :: (MonadTest m, HasCallStack) => LabelName -> m ()
label :: forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
LabelName -> m ()
label LabelName
name =
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
CoverPercentage -> LabelName -> Bool -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
0 LabelName
name Bool
True
collect :: (MonadTest m, Show a, HasCallStack) => a -> m ()
collect :: forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
collect a
x =
(HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
CoverPercentage -> LabelName -> Bool -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
0 (String -> LabelName
LabelName (a -> String
forall a. Show a => a -> String
show a
x)) Bool
True