    {-# OPTIONS_HADDOCK hide #-}
    -- | Combinators for constructing properties.
    {-# LANGUAGE CPP #-}
    #ifndef NO_TYPEABLE
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE ExistentialQuantification #-}
    #endif
    #ifndef NO_SAFE_HASKELL
    {-# LANGUAGE Safe #-}
    #endif
    module Test.QuickCheck.Property where

    --------------------------------------------------------------------------
    -- imports

    import Test.QuickCheck.Gen
    import Test.QuickCheck.Gen.Unsafe
    import Test.QuickCheck.Arbitrary
    import Test.QuickCheck.Text( isOneLine, putLine )
    import Test.QuickCheck.Exception
    import Test.QuickCheck.State( State(terminal), Confidence(..) )

    #ifndef NO_TIMEOUT
    import System.Timeout(timeout)
    #endif
    import Data.Maybe
    import Control.Applicative
    import Control.Monad
    import qualified Data.Map as Map
    import Data.Map(Map)
    import qualified Data.Set as Set
    import Data.Set(Set)
    #ifndef NO_DEEPSEQ
    import Control.DeepSeq
    #endif
    #ifndef NO_TYPEABLE
    import Data.Typeable (Typeable, cast)
    #endif
    import Data.Maybe

    --------------------------------------------------------------------------
    -- fixities

    infixr 0 ==>
    infixr 1 .&.
    infixr 1 .&&.
    infixr 1 .||.

    -- The story for exception handling:
    --
    -- To avoid insanity, we have rules about which terms can throw
    -- exceptions when we evaluate them:
    --   * A rose tree must evaluate to WHNF without throwing an exception
    --   * The 'ok' component of a Result must evaluate to Just True or
    --     Just False or Nothing rather than raise an exception
    --   * IORose _ must never throw an exception when executed
    --
    -- Both rose trees and Results may loop when we evaluate them, though,
    -- so we have to be careful not to force them unnecessarily.
    --
    -- We also have to be careful when we use fmap or >>= in the Rose
    -- monad that the function we supply is total, or else use
    -- protectResults afterwards to install exception handlers. The
    -- mapResult function on Properties installs an exception handler for
    -- us, though.
    --
    -- Of course, the user is free to write "error "ha ha" :: Result" if
    -- they feel like it. We have to make sure that any user-supplied Rose
    -- Results or Results get wrapped in exception handlers, which we do by:
    --   * Making the 'property' function install an exception handler
    --     round its argument. This function always gets called in the
    --     right places, because all our Property-accepting functions are
    --     actually polymorphic over the Testable class so they have to
    --     call 'property'.
    --   * Installing an exception handler round a Result before we put it
    --     in a rose tree (the only place Results can end up).

    --------------------------------------------------------------------------
    -- * Property and Testable types

    -- | The type of properties.
    newtype Property = MkProperty { Property -> Gen Prop
    unProperty :: Gen Prop }
    #ifndef NO_TYPEABLE
      deriving (Typeable)
    #endif

    -- | The class of properties, i.e., types which QuickCheck knows how to test.
    -- Typically a property will be a function returning 'Bool' or 'Property'.
    class Testable prop where
      -- | Convert the thing to a property.
      property :: prop -> Property

      -- | Optional; used internally in order to improve shrinking.
      -- Tests a property but also quantifies over an extra value
      -- (with a custom shrink and show function).
      -- The 'Testable' instance for functions defines
      -- @propertyForAllShrinkShow@ in a way that improves shrinking.
      propertyForAllShrinkShow :: Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
      propertyForAllShrinkShow Gen a
    gen a -> [a]
    shr a -> [String]
    shw a -> prop
    f =
        Gen a -> (a -> [a]) -> (a -> Property) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrinkBlind Gen a
    gen a -> [a]
    shr ((a -> Property) -> Property) -> (a -> Property) -> Property
    forall a b. (a -> b) -> a -> b
    $
          \a
    x -> (String -> Property -> Property)
    -> Property -> [String] -> Property
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr String -> Property -> Property
    forall prop. Testable prop => String -> prop -> Property
    counterexample (prop -> Property
    forall prop. Testable prop => prop -> Property
    property (a -> prop
    f a
    x)) (a -> [String]
    shw a
    x)

    -- | If a property returns 'Discard', the current test case is discarded,
    -- the same as if a precondition was false.
    --
    -- An example is the definition of '==>':
    --
    -- > (==>) :: Testable prop => Bool -> prop -> Property
    -- > False ==> _ = property Discard
    -- > True  ==> p = property p
    data Discard = Discard

    instance Testable Discard where
      property :: Discard -> Property
    property Discard
    _ = Result -> Property
    forall prop. Testable prop => prop -> Property
    property Result
    rejected

    -- This instance is here to make it easier to turn IO () into a Property.
    instance Testable () where
      property :: () -> Property
    property = Result -> Property
    forall prop. Testable prop => prop -> Property
    property (Result -> Property) -> (() -> Result) -> () -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . () -> Result
    liftUnit
        where
          -- N.B. the unit gets forced only inside 'property',
          -- so that we turn exceptions into test failures
          liftUnit :: () -> Result
    liftUnit () = Result
    succeeded

    instance Testable prop => Testable (Maybe prop) where
      property :: Maybe prop -> Property
    property = Property -> Property
    forall prop. Testable prop => prop -> Property
    property (Property -> Property)
    -> (Maybe prop -> Property) -> Maybe prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe prop -> Property
    forall prop. Testable prop => Maybe prop -> Property
    liftMaybe
        where
          -- See comment for liftUnit above
          liftMaybe :: Maybe prop -> Property
    liftMaybe Maybe prop
    Nothing = Discard -> Property
    forall prop. Testable prop => prop -> Property
    property Discard
    Discard
          liftMaybe (Just prop
    prop) = prop -> Property
    forall prop. Testable prop => prop -> Property
    property prop
    prop

    instance Testable Bool where
      property :: Bool -> Property
    property = Result -> Property
    forall prop. Testable prop => prop -> Property
    property (Result -> Property) -> (Bool -> Result) -> Bool -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Result
    liftBool

    instance Testable Result where
      property :: Result -> Property
    property = Gen Prop -> Property
    MkProperty (Gen Prop -> Property)
    -> (Result -> Gen Prop) -> Result -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Prop -> Gen Prop
    forall a. a -> Gen a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Prop -> Gen Prop) -> (Result -> Prop) -> Result -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rose Result -> Prop
    MkProp (Rose Result -> Prop) -> (Result -> Rose Result) -> Result -> Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rose Result -> Rose Result
    protectResults (Rose Result -> Rose Result)
    -> (Result -> Rose Result) -> Result -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    instance Testable Prop where
      property :: Prop -> Property
    property Prop
    p = Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> (Prop -> Gen Prop) -> Prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Prop -> Gen Prop
    forall a. a -> Gen a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Prop -> Gen Prop) -> (Prop -> Prop) -> Prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Prop -> Prop
    protectProp (Prop -> Property) -> Prop -> Property
    forall a b. (a -> b) -> a -> b
    $ Prop
    p

    instance Testable prop => Testable (Gen prop) where
      property :: Gen prop -> Property
    property Gen prop
    mp = Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
    forall a b. (a -> b) -> a -> b
    $ do p <- Gen prop
    mp; unProperty (property p)

    instance Testable Property where
      property :: Property -> Property
    property (MkProperty Gen Prop
    mp) = Gen Prop -> Property
    MkProperty ((Prop -> Prop) -> Gen Prop -> Gen Prop
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Prop -> Prop
    protectProp Gen Prop
    mp)

    -- | Do I/O inside a property.
    {-# DEPRECATED morallyDubiousIOProperty "Use 'ioProperty' instead" #-}
    morallyDubiousIOProperty :: Testable prop => IO prop -> Property
    morallyDubiousIOProperty :: forall prop. Testable prop => IO prop -> Property
    morallyDubiousIOProperty = IO prop -> Property
    forall prop. Testable prop => IO prop -> Property
    ioProperty

    -- | Do I/O inside a property.
    --
    -- Warning: any random values generated inside of the argument to @ioProperty@
    -- will not currently be shrunk. For best results, generate all random values
    -- before calling @ioProperty@, or use 'idempotentIOProperty' if that is safe.
    ioProperty :: Testable prop => IO prop -> Property
    ioProperty :: forall prop. Testable prop => IO prop -> Property
    ioProperty IO prop
    prop = IO Property -> Property
    forall prop. Testable prop => IO prop -> Property
    idempotentIOProperty ((prop -> Property) -> IO prop -> IO Property
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap prop -> Property
    forall prop. Testable prop => prop -> Property
    noShrinking IO prop
    prop)

    -- | Do I/O inside a property.
    --
    -- Warning: during shrinking, the I/O may not always be re-executed.
    -- Instead, the I/O may be executed once and then its result retained.
    -- If this is not acceptable, use 'ioProperty' instead.
    idempotentIOProperty :: Testable prop => IO prop -> Property
    idempotentIOProperty :: forall prop. Testable prop => IO prop -> Property
    idempotentIOProperty =
      Gen Prop -> Property
    MkProperty (Gen Prop -> Property)
    -> (IO prop -> Gen Prop) -> IO prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IO Prop -> Prop) -> Gen (IO Prop) -> Gen Prop
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Rose Result -> Prop
    MkProp (Rose Result -> Prop)
    -> (IO Prop -> Rose Result) -> IO Prop -> Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Rose Result) -> Rose Result
    ioRose (IO (Rose Result) -> Rose Result)
    -> (IO Prop -> IO (Rose Result)) -> IO Prop -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Prop -> Rose Result) -> IO Prop -> IO (Rose Result)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Prop -> Rose Result
    unProp) (Gen (IO Prop) -> Gen Prop)
    -> (IO prop -> Gen (IO Prop)) -> IO prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      IO (Gen Prop) -> Gen (IO Prop)
    forall (m :: * -> *) a. Monad m => m (Gen a) -> Gen (m a)
    promote (IO (Gen Prop) -> Gen (IO Prop))
    -> (IO prop -> IO (Gen Prop)) -> IO prop -> Gen (IO Prop)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (prop -> Gen Prop) -> IO prop -> IO (Gen Prop)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> (prop -> Property) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . prop -> Property
    forall prop. Testable prop => prop -> Property
    property)

    instance (Arbitrary a, Show a, Testable prop) => Testable (a -> prop) where
      property :: (a -> prop) -> Property
    property a -> prop
    f =
        Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
    forall a.
    Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
    propertyForAllShrinkShow Gen a
    forall a. Arbitrary a => Gen a
    arbitrary a -> [a]
    forall a. Arbitrary a => a -> [a]
    shrink (String -> [String]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> [String]) -> (a -> String) -> a -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show) a -> prop
    f
      propertyForAllShrinkShow :: forall a.
    Gen a
    -> (a -> [a]) -> (a -> [String]) -> (a -> a -> prop) -> Property
    propertyForAllShrinkShow Gen a
    gen a -> [a]
    shr a -> [String]
    shw a -> a -> prop
    f =
        -- gen :: Gen b, shr :: b -> [b], f :: b -> a -> prop
        -- Idea: Generate and shrink (b, a) as a pair
        Gen (a, a)
    -> ((a, a) -> [(a, a)])
    -> ((a, a) -> [String])
    -> ((a, a) -> prop)
    -> Property
    forall a.
    Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
    propertyForAllShrinkShow
          ((a -> a -> (a, a)) -> Gen a -> Gen a -> Gen (a, a)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) Gen a
    gen Gen a
    forall a. Arbitrary a => Gen a
    arbitrary)
          ((a -> [a]) -> (a -> [a]) -> (a, a) -> [(a, a)]
    forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
    forall (f :: * -> * -> *) a b.
    Arbitrary2 f =>
    (a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
    liftShrink2 a -> [a]
    shr a -> [a]
    forall a. Arbitrary a => a -> [a]
    shrink)
          (\(a
    x, a
    y) -> a -> [String]
    shw a
    x [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [a -> String
    forall a. Show a => a -> String
    show a
    y])
          ((a -> a -> prop) -> (a, a) -> prop
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry a -> a -> prop
    f)

    -- ** Exception handling
    protect :: (AnException -> a) -> IO a -> IO a
    protect :: forall a. (AnException -> a) -> IO a -> IO a
    protect AnException -> a
    f IO a
    x = (AnException -> a) -> (a -> a) -> Either AnException a -> a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either AnException -> a
    f a -> a
    forall a. a -> a
    id (Either AnException a -> a) -> IO (Either AnException a) -> IO a
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` IO a -> IO (Either AnException a)
    forall a. IO a -> IO (Either AnException a)
    tryEvaluateIO IO a
    x

    --------------------------------------------------------------------------
    -- ** Type Prop

    newtype Prop = MkProp{ Prop -> Rose Result
    unProp :: Rose Result }

    -- ** type Rose

    data Rose a = MkRose a [Rose a] | IORose (IO (Rose a))
    -- Only use IORose if you know that the argument is not going to throw an exception!
    -- Otherwise, try ioRose.
    ioRose :: IO (Rose Result) -> Rose Result
    ioRose :: IO (Rose Result) -> Rose Result
    ioRose = IO (Rose Result) -> Rose Result
    forall a. IO (Rose a) -> Rose a
    IORose (IO (Rose Result) -> Rose Result)
    -> (IO (Rose Result) -> IO (Rose Result))
    -> IO (Rose Result)
    -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Rose Result) -> IO (Rose Result)
    protectRose

    joinRose :: Rose (Rose a) -> Rose a
    joinRose :: forall a. Rose (Rose a) -> Rose a
    joinRose (IORose IO (Rose (Rose a))
    rs) = IO (Rose a) -> Rose a
    forall a. IO (Rose a) -> Rose a
    IORose ((Rose (Rose a) -> Rose a) -> IO (Rose (Rose a)) -> IO (Rose a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Rose (Rose a) -> Rose a
    forall a. Rose (Rose a) -> Rose a
    joinRose IO (Rose (Rose a))
    rs)
    joinRose (MkRose (IORose IO (Rose a)
    rm) [Rose (Rose a)]
    rs) = IO (Rose a) -> Rose a
    forall a. IO (Rose a) -> Rose a
    IORose (IO (Rose a) -> Rose a) -> IO (Rose a) -> Rose a
    forall a b. (a -> b) -> a -> b
    $ do r <- IO (Rose a)
    rm; return (joinRose (MkRose r rs))
    joinRose (MkRose (MkRose a
    x [Rose a]
    ts) [Rose (Rose a)]
    tts) =
      -- first shrinks outer quantification; makes most sense
      a -> [Rose a] -> Rose a
    forall a. a -> [Rose a] -> Rose a
    MkRose a
    x ((Rose (Rose a) -> Rose a) -> [Rose (Rose a)] -> [Rose a]
    forall a b. (a -> b) -> [a] -> [b]
    map Rose (Rose a) -> Rose a
    forall a. Rose (Rose a) -> Rose a
    joinRose [Rose (Rose a)]
    tts [Rose a] -> [Rose a] -> [Rose a]
    forall a. [a] -> [a] -> [a]
    ++ [Rose a]
    ts)
      -- first shrinks inner quantification: terrible
      --MkRose x (ts ++ map joinRose tts)

    instance Functor Rose where
      -- f must be total
      fmap :: forall a b. (a -> b) -> Rose a -> Rose b
    fmap a -> b
    f (IORose IO (Rose a)
    rs)   = IO (Rose b) -> Rose b
    forall a. IO (Rose a) -> Rose a
    IORose ((Rose a -> Rose b) -> IO (Rose a) -> IO (Rose b)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> Rose a -> Rose b
    forall a b. (a -> b) -> Rose a -> Rose b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) IO (Rose a)
    rs)
      fmap a -> b
    f (MkRose a
    x [Rose a]
    rs) = b -> [Rose b] -> Rose b
    forall a. a -> [Rose a] -> Rose a
    MkRose (a -> b
    f a
    x) [ (a -> b) -> Rose a -> Rose b
    forall a b. (a -> b) -> Rose a -> Rose b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Rose a
    r | Rose a
    r <- [Rose a]
    rs ]

    instance Applicative Rose where
      pure :: forall a. a -> Rose a
    pure a
    x = a -> [Rose a] -> Rose a
    forall a. a -> [Rose a] -> Rose a
    MkRose a
    x []
      -- f must be total
      <*> :: forall a b. Rose (a -> b) -> Rose a -> Rose b
    (<*>) = ((a -> b) -> a -> b) -> Rose (a -> b) -> Rose a -> Rose b
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    ($)

    instance Monad Rose where
      return :: forall a. a -> Rose a
    return = a -> Rose a
    forall a. a -> Rose a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      -- k must be total
      Rose a
    m >>= :: forall a b. Rose a -> (a -> Rose b) -> Rose b
    >>= a -> Rose b
    k  = Rose (Rose b) -> Rose b
    forall a. Rose (Rose a) -> Rose a
    joinRose ((a -> Rose b) -> Rose a -> Rose (Rose b)
    forall a b. (a -> b) -> Rose a -> Rose b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Rose b
    k Rose a
    m)

    -- | Execute the "IORose" bits of a rose tree, returning a tree
    -- constructed by MkRose.
    reduceRose :: Rose Result -> IO (Rose Result)
    reduceRose :: Rose Result -> IO (Rose Result)
    reduceRose r :: Rose Result
    r@(MkRose Result
    _ [Rose Result]
    _) = Rose Result -> IO (Rose Result)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Rose Result
    r
    reduceRose (IORose IO (Rose Result)
    m) = IO (Rose Result)
    m IO (Rose Result)
    -> (Rose Result -> IO (Rose Result)) -> IO (Rose Result)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Rose Result -> IO (Rose Result)
    reduceRose

    -- | Apply a function to the outermost MkRose constructor of a rose tree.
    -- The function must be total!
    onRose :: (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
    onRose :: forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
    onRose a -> [Rose a] -> Rose a
    f (MkRose a
    x [Rose a]
    rs) = a -> [Rose a] -> Rose a
    f a
    x [Rose a]
    rs
    onRose a -> [Rose a] -> Rose a
    f (IORose IO (Rose a)
    m) = IO (Rose a) -> Rose a
    forall a. IO (Rose a) -> Rose a
    IORose ((Rose a -> Rose a) -> IO (Rose a) -> IO (Rose a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> [Rose a] -> Rose a) -> Rose a -> Rose a
    forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
    onRose a -> [Rose a] -> Rose a
    f) IO (Rose a)
    m)

    -- | Wrap a rose tree in an exception handler.
    protectRose :: IO (Rose Result) -> IO (Rose Result)
    protectRose :: IO (Rose Result) -> IO (Rose Result)
    protectRose = (AnException -> Rose Result)
    -> IO (Rose Result) -> IO (Rose Result)
    forall a. (AnException -> a) -> IO a -> IO a
    protect (Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> Rose Result)
    -> (AnException -> Result) -> AnException -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> AnException -> Result
    exception String
    "Exception")

    -- | Wrap the top level of a 'Prop' in an exception handler.
    protectProp :: Prop -> Prop
    protectProp :: Prop -> Prop
    protectProp (MkProp Rose Result
    r) = Rose Result -> Prop
    MkProp (IO (Rose Result) -> Rose Result
    forall a. IO (Rose a) -> Rose a
    IORose (IO (Rose Result) -> Rose Result)
    -> (Rose Result -> IO (Rose Result)) -> Rose Result -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Rose Result) -> IO (Rose Result)
    protectRose (IO (Rose Result) -> IO (Rose Result))
    -> (Rose Result -> IO (Rose Result))
    -> Rose Result
    -> IO (Rose Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rose Result -> IO (Rose Result)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Rose Result -> Rose Result) -> Rose Result -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ Rose Result
    r)

    -- | Wrap all the Results in a rose tree in exception handlers.
    protectResults :: Rose Result -> Rose Result
    protectResults :: Rose Result -> Rose Result
    protectResults = (Result -> [Rose Result] -> Rose Result)
    -> Rose Result -> Rose Result
    forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
    onRose ((Result -> [Rose Result] -> Rose Result)
     -> Rose Result -> Rose Result)
    -> (Result -> [Rose Result] -> Rose Result)
    -> Rose Result
    -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ \Result
    x [Rose Result]
    rs ->
      IO (Rose Result) -> Rose Result
    forall a. IO (Rose a) -> Rose a
    IORose (IO (Rose Result) -> Rose Result)
    -> IO (Rose Result) -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ do
        y <- IO Result -> IO Result
    protectResult (Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    x)
        return (MkRose y (map protectResults rs))

    -- ** Result type

    -- | Different kinds of callbacks
    data Callback
      = PostTest CallbackKind (State -> Result -> IO ())         -- ^ Called just after a test
      | PostFinalFailure CallbackKind (State -> Result -> IO ()) -- ^ Called with the final failing test-case
    data CallbackKind = Counterexample    -- ^ Affected by the 'verbose' combinator
                      | NotCounterexample -- ^ Not affected by the 'verbose' combinator

    #ifndef NO_TYPEABLE
    data Witness = forall a. (Typeable a, Show a) => Wit a

    instance Show Witness where
      show :: Witness -> String
    show (Wit a
    a) = a -> String
    forall a. Show a => a -> String
    show a
    a

    coerceWitness :: Typeable a => Witness -> a
    coerceWitness :: forall a. Typeable a => Witness -> a
    coerceWitness (Wit a
    a) = case a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a of
      Maybe a
    Nothing -> String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "Can't coerceWitness " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    a
      Just a
    a -> a
    a

    castWitness :: Typeable a => Witness -> Maybe a
    castWitness :: forall a. Typeable a => Witness -> Maybe a
    castWitness (Wit a
    a) = a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a

    #define WITNESSES(a) , theWitnesses a
    #else
    #define WITNESSES(a)
    #endif

    -- | The result of a single test.
    data Result
      = MkResult
      { Result -> Maybe Bool
    ok                  :: Maybe Bool
        -- ^ result of the test case; Nothing = discard
      , Result -> Bool
    expect              :: Bool
        -- ^ indicates what the expected result of the property is
      , Result -> String
    reason              :: String
        -- ^ a message indicating what went wrong
      , Result -> Maybe AnException
    theException        :: Maybe AnException
        -- ^ the exception thrown, if any
      , Result -> Bool
    abort               :: Bool
        -- ^ if True, the test should not be repeated
      , Result -> Maybe Int
    maybeNumTests       :: Maybe Int
        -- ^ stop after this many tests
      , Result -> Maybe Confidence
    maybeCheckCoverage  :: Maybe Confidence
        -- ^ required coverage confidence
      , Result -> Maybe Int
    maybeDiscardedRatio :: Maybe Int
        -- ^ maximum number of discarded tests per successful test
      , Result -> Maybe Int
    maybeMaxShrinks     :: Maybe Int
        -- ^ maximum number of shrinks
      , Result -> Maybe Int
    maybeMaxTestSize    :: Maybe Int
        -- ^ maximum test size
      , Result -> [String]
    labels              :: [String]
        -- ^ test case labels
      , Result -> [(String, Bool)]
    classes             :: [(String, Bool)]
        -- ^ test case classes
      , Result -> [(String, String)]
    tables              :: [(String, String)]
        -- ^ test case tables
      , Result -> [(Maybe String, String, Double)]
    requiredCoverage    :: [(Maybe String, String, Double)]
        -- ^ required coverage
      , Result -> [Callback]
    callbacks           :: [Callback]
        -- ^ the callbacks for this test case
      , Result -> [String]
    testCase            :: [String]
        -- ^ the generated test case
      WITNESSES(:: [Witness])
      }

    exception :: String -> AnException -> Result
    exception :: String -> AnException -> Result
    exception String
    msg AnException
    err
      | AnException -> Bool
    isDiscard AnException
    err = Result
    rejected
      | Bool
    otherwise = Result
    failed{ reason = formatException msg err,
                            theException = Just err }

    formatException :: String -> AnException -> String
    formatException :: String -> AnException -> String
    formatException String
    msg AnException
    err = String
    msg String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    format (AnException -> String
    forall a. Show a => a -> String
    show AnException
    err)
      where format :: ShowS
    format String
    xs | String -> Bool
    isOneLine String
    xs = String
    " '" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    xs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
                      | Bool
    otherwise = String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines [ String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    l | String
    l <- String -> [String]
    lines String
    xs ]

    protectResult :: IO Result -> IO Result
    protectResult :: IO Result -> IO Result
    protectResult = (AnException -> Result) -> IO Result -> IO Result
    forall a. (AnException -> a) -> IO a -> IO a
    protect (String -> AnException -> Result
    exception String
    "Exception")

    succeeded, failed, rejected :: Result
    (Result
    succeeded, Result
    failed, Result
    rejected) =
      (Result
    result{ ok = Just True },
       Result
    result{ ok = Just False },
       Result
    result{ ok = Nothing })
      where
        result :: Result
    result =
          MkResult
          { ok :: Maybe Bool
    ok                  = Maybe Bool
    forall a. HasCallStack => a
    undefined
          , expect :: Bool
    expect              = Bool
    True
          , reason :: String
    reason              = String
    ""
          , theException :: Maybe AnException
    theException        = Maybe AnException
    forall a. Maybe a
    Nothing
          , abort :: Bool
    abort               = Bool
    False
          , maybeNumTests :: Maybe Int
    maybeNumTests       = Maybe Int
    forall a. Maybe a
    Nothing
          , maybeCheckCoverage :: Maybe Confidence
    maybeCheckCoverage  = Maybe Confidence
    forall a. Maybe a
    Nothing
          , maybeDiscardedRatio :: Maybe Int
    maybeDiscardedRatio = Maybe Int
    forall a. Maybe a
    Nothing
          , maybeMaxShrinks :: Maybe Int
    maybeMaxShrinks     = Maybe Int
    forall a. Maybe a
    Nothing
          , maybeMaxTestSize :: Maybe Int
    maybeMaxTestSize    = Maybe Int
    forall a. Maybe a
    Nothing
          , labels :: [String]
    labels              = []
          , classes :: [(String, Bool)]
    classes             = []
          , tables :: [(String, String)]
    tables              = []
          , requiredCoverage :: [(Maybe String, String, Double)]
    requiredCoverage    = []
          , callbacks :: [Callback]
    callbacks           = []
          , testCase :: [String]
    testCase            = []
          WITNESSES(= [])
          }

    --------------------------------------------------------------------------
    -- ** Lifting and mapping functions

    liftBool :: Bool -> Result
    liftBool :: Bool -> Result
    liftBool Bool
    True = Result
    succeeded
    liftBool Bool
    False = Result
    failed { reason = "Falsified" }

    mapResult :: Testable prop => (Result -> Result) -> prop -> Property
    mapResult :: forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapResult Result -> Result
    f = (Rose Result -> Rose Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Rose Result -> Rose Result) -> prop -> Property
    mapRoseResult (Rose Result -> Rose Result
    protectResults (Rose Result -> Rose Result)
    -> (Rose Result -> Rose Result) -> Rose Result -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Result -> Result) -> Rose Result -> Rose Result
    forall a b. (a -> b) -> Rose a -> Rose b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Result -> Result
    f)

    mapTotalResult :: Testable prop => (Result -> Result) -> prop -> Property
    mapTotalResult :: forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult Result -> Result
    f = (Rose Result -> Rose Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Rose Result -> Rose Result) -> prop -> Property
    mapRoseResult ((Result -> Result) -> Rose Result -> Rose Result
    forall a b. (a -> b) -> Rose a -> Rose b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Result -> Result
    f)

    -- f here mustn't throw an exception (rose tree invariant).
    mapRoseResult :: Testable prop => (Rose Result -> Rose Result) -> prop -> Property
    mapRoseResult :: forall prop.
    Testable prop =>
    (Rose Result -> Rose Result) -> prop -> Property
    mapRoseResult Rose Result -> Rose Result
    f = (Prop -> Prop) -> prop -> Property
    forall prop. Testable prop => (Prop -> Prop) -> prop -> Property
    mapProp (\(MkProp Rose Result
    t) -> Rose Result -> Prop
    MkProp (Rose Result -> Rose Result
    f Rose Result
    t))

    mapProp :: Testable prop => (Prop -> Prop) -> prop -> Property
    mapProp :: forall prop. Testable prop => (Prop -> Prop) -> prop -> Property
    mapProp Prop -> Prop
    f = Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> (prop -> Gen Prop) -> prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Prop -> Prop) -> Gen Prop -> Gen Prop
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Prop -> Prop
    f (Gen Prop -> Gen Prop) -> (prop -> Gen Prop) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> (prop -> Property) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . prop -> Property
    forall prop. Testable prop => prop -> Property
    property

    --------------------------------------------------------------------------
    -- ** Property combinators

    -- | Adjust the test case size for a property, by transforming it with the given
    -- function.
    mapSize :: Testable prop => (Int -> Int) -> prop -> Property
    mapSize :: forall prop. Testable prop => (Int -> Int) -> prop -> Property
    mapSize Int -> Int
    f = Gen Prop -> Property
    forall prop. Testable prop => prop -> Property
    property (Gen Prop -> Property) -> (prop -> Gen Prop) -> prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int) -> Gen Prop -> Gen Prop
    forall a. (Int -> Int) -> Gen a -> Gen a
    scale Int -> Int
    f (Gen Prop -> Gen Prop) -> (prop -> Gen Prop) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> (prop -> Property) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . prop -> Property
    forall prop. Testable prop => prop -> Property
    property

    -- | Shrinks the argument to a property if it fails. Shrinking is done
    -- automatically for most types. This function is only needed when you want to
    -- override the default behavior.
    shrinking :: Testable prop =>
                 (a -> [a])  -- ^ 'shrink'-like function.
              -> a           -- ^ The original argument
              -> (a -> prop) -> Property
    shrinking :: forall prop a.
    Testable prop =>
    (a -> [a]) -> a -> (a -> prop) -> Property
    shrinking a -> [a]
    shrinker a
    x0 a -> prop
    pf = Gen Prop -> Property
    MkProperty ((Rose Prop -> Prop) -> Gen (Rose Prop) -> Gen Prop
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Rose Result -> Prop
    MkProp (Rose Result -> Prop)
    -> (Rose Prop -> Rose Result) -> Rose Prop -> Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rose (Rose Result) -> Rose Result
    forall a. Rose (Rose a) -> Rose a
    joinRose (Rose (Rose Result) -> Rose Result)
    -> (Rose Prop -> Rose (Rose Result)) -> Rose Prop -> Rose Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Prop -> Rose Result) -> Rose Prop -> Rose (Rose Result)
    forall a b. (a -> b) -> Rose a -> Rose b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Prop -> Rose Result
    unProp) (Rose (Gen Prop) -> Gen (Rose Prop)
    forall (m :: * -> *) a. Monad m => m (Gen a) -> Gen (m a)
    promote (a -> Rose (Gen Prop)
    props a
    x0)))
     where
      props :: a -> Rose (Gen Prop)
    props a
    x =
        Gen Prop -> [Rose (Gen Prop)] -> Rose (Gen Prop)
    forall a. a -> [Rose a] -> Rose a
    MkRose (Property -> Gen Prop
    unProperty (prop -> Property
    forall prop. Testable prop => prop -> Property
    property (a -> prop
    pf a
    x))) [ a -> Rose (Gen Prop)
    props a
    x' | a
    x' <- a -> [a]
    shrinker a
    x ]

    -- | Disables shrinking for a property altogether.
    -- Only quantification /inside/ the call to 'noShrinking' is affected.
    noShrinking :: Testable prop => prop -> Property
    noShrinking :: forall prop. Testable prop => prop -> Property
    noShrinking = (Rose Result -> Rose Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Rose Result -> Rose Result) -> prop -> Property
    mapRoseResult ((Result -> [Rose Result] -> Rose Result)
    -> Rose Result -> Rose Result
    forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
    onRose (\Result
    res [Rose Result]
    _ -> Result -> [Rose Result] -> Rose Result
    forall a. a -> [Rose a] -> Rose a
    MkRose Result
    res []))

    -- | Adds a callback
    callback :: Testable prop => Callback -> prop -> Property
    callback :: forall prop. Testable prop => Callback -> prop -> Property
    callback Callback
    cb = (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ callbacks = cb : callbacks res })

    -- | Adds the given string to the counterexample if the property fails.
    counterexample :: Testable prop => String -> prop -> Property
    counterexample :: forall prop. Testable prop => String -> prop -> Property
    counterexample String
    s =
      (Result -> Result) -> Property -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ testCase = s:testCase res }) (Property -> Property) -> (prop -> Property) -> prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Callback -> prop -> Property
    forall prop. Testable prop => Callback -> prop -> Property
    callback (CallbackKind -> (State -> Result -> IO ()) -> Callback
    PostFinalFailure CallbackKind
    Counterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $ \State
    st Result
    _res -> do
        s <- String -> IO String
    showCounterexample String
    s
        putLine (terminal st) s)

    showCounterexample :: String -> IO String
    showCounterexample :: String -> IO String
    showCounterexample String
    s = do
      let force :: [a] -> m ()
    force [] = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          force (a
    x:[a]
    xs) = a
    x a -> m () -> m ()
    forall a b. a -> b -> b
    `seq` [a] -> m ()
    force [a]
    xs
      res <- IO () -> IO (Either AnException ())
    forall a. IO a -> IO (Either AnException a)
    tryEvaluateIO (String -> IO ()
    forall {m :: * -> *} {a}. Monad m => [a] -> m ()
    force String
    s)
      return $
        case res of
          Left AnException
    err ->
            String -> AnException -> String
    formatException String
    "Exception thrown while showing test case" AnException
    err
          Right () ->
            String
    s

    -- | Adds the given string to the counterexample if the property fails.
    {-# DEPRECATED printTestCase "Use counterexample instead" #-}
    printTestCase :: Testable prop => String -> prop -> Property
    printTestCase :: forall prop. Testable prop => String -> prop -> Property
    printTestCase = String -> prop -> Property
    forall prop. Testable prop => String -> prop -> Property
    counterexample

    -- | Performs an 'IO' action after the last failure of a property.
    whenFail :: Testable prop => IO () -> prop -> Property
    whenFail :: forall prop. Testable prop => IO () -> prop -> Property
    whenFail IO ()
    m =
      Callback -> prop -> Property
    forall prop. Testable prop => Callback -> prop -> Property
    callback (Callback -> prop -> Property) -> Callback -> prop -> Property
    forall a b. (a -> b) -> a -> b
    $ CallbackKind -> (State -> Result -> IO ()) -> Callback
    PostFinalFailure CallbackKind
    NotCounterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $ \State
    _st Result
    _res ->
        IO ()
    m

    -- | Performs an 'IO' action every time a property fails. Thus,
    -- if shrinking is done, this can be used to keep track of the
    -- failures along the way.
    whenFail' :: Testable prop => IO () -> prop -> Property
    whenFail' :: forall prop. Testable prop => IO () -> prop -> Property
    whenFail' IO ()
    m =
      Callback -> prop -> Property
    forall prop. Testable prop => Callback -> prop -> Property
    callback (Callback -> prop -> Property) -> Callback -> prop -> Property
    forall a b. (a -> b) -> a -> b
    $ CallbackKind -> (State -> Result -> IO ()) -> Callback
    PostTest CallbackKind
    NotCounterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $ \State
    _st Result
    res ->
        if Result -> Maybe Bool
    ok Result
    res Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
          then IO ()
    m
          else () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Prints out the generated test case every time the property is tested.
    -- Only variables quantified over /inside/ the 'verbose' are printed.
    --
    -- Note: for technical reasons, the test case is printed out /after/
    -- the property is tested. To debug a property that goes into an
    -- infinite loop, use 'within' to add a timeout instead.
    verbose :: Testable prop => prop -> Property
    verbose :: forall prop. Testable prop => prop -> Property
    verbose = (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapResult (\Result
    res -> Result
    res { callbacks = newCallback (callbacks res):callbacks res })
      where newCallback :: [Callback] -> Callback
    newCallback [Callback]
    cbs =
              CallbackKind -> (State -> Result -> IO ()) -> Callback
    PostTest CallbackKind
    Counterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $ \State
    st Result
    res -> do
                Terminal -> String -> IO ()
    putLine (State -> Terminal
    terminal State
    st) (Result -> String
    status Result
    res String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":")
                [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ State -> Result -> IO ()
    f State
    st Result
    res | PostFinalFailure CallbackKind
    Counterexample State -> Result -> IO ()
    f <- [Callback]
    cbs ]
                Terminal -> String -> IO ()
    putLine (State -> Terminal
    terminal State
    st) String
    ""
            status :: Result -> String
    status MkResult{ok :: Result -> Maybe Bool
    ok = Just Bool
    True} = String
    "Passed"
            status MkResult{ok :: Result -> Maybe Bool
    ok = Just Bool
    False} = String
    "Failed"
            status MkResult{ok :: Result -> Maybe Bool
    ok = Maybe Bool
    Nothing} = String
    "Skipped (precondition false)"

    -- | Prints out the generated test case every time the property fails, including during shrinking.
    -- Only variables quantified over /inside/ the 'verboseShrinking' are printed.
    --
    -- Note: for technical reasons, the test case is printed out /after/
    -- the property is tested. To debug a property that goes into an
    -- infinite loop, use 'within' to add a timeout instead.
    verboseShrinking :: Testable prop => prop -> Property
    verboseShrinking :: forall prop. Testable prop => prop -> Property
    verboseShrinking = (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapResult (\Result
    res -> Result
    res { callbacks = newCallback (callbacks res):callbacks res })
      where newCallback :: [Callback] -> Callback
    newCallback [Callback]
    cbs =
              CallbackKind -> (State -> Result -> IO ()) -> Callback
    PostTest CallbackKind
    Counterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $ \State
    st Result
    res ->
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Result -> Maybe Bool
    ok Result
    res Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                  Terminal -> String -> IO ()
    putLine (State -> Terminal
    terminal State
    st) String
    "Failed:"
                  [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ State -> Result -> IO ()
    f State
    st Result
    res | PostFinalFailure CallbackKind
    Counterexample State -> Result -> IO ()
    f <- [Callback]
    cbs ]
                  Terminal -> String -> IO ()
    putLine (State -> Terminal
    terminal State
    st) String
    ""

    -- | Indicates that a property is supposed to fail.
    -- QuickCheck will report an error if it does not fail.
    expectFailure :: Testable prop => prop -> Property
    expectFailure :: forall prop. Testable prop => prop -> Property
    expectFailure = (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ expect = False })

    -- | Modifies a property so that it only will be tested once.
    -- Opposite of 'again'.
    once :: Testable prop => prop -> Property
    once :: forall prop. Testable prop => prop -> Property
    once = (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ abort = True })

    -- | Modifies a property so that it will be tested repeatedly.
    -- Opposite of 'once'.
    again :: Testable prop => prop -> Property
    again :: forall prop. Testable prop => prop -> Property
    again = (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ abort = False })

    -- | Configures how many times a property will be tested.
    --
    -- For example,
    --
    -- > quickCheck (withMaxSuccess 1000 p)
    --
    -- will test @p@ up to 1000 times.
    withMaxSuccess :: Testable prop => Int -> prop -> Property
    withMaxSuccess :: forall prop. Testable prop => Int -> prop -> Property
    withMaxSuccess Int
    n = Int
    n Int -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq` (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ maybeNumTests = Just n })

    -- | Configures how many times a property is allowed to be discarded before failing.
    --
    -- For example,
    --
    -- > quickCheck (withDiscardRatio 10 p)
    --
    -- will allow @p@ to fail up to 10 times per successful test.
    withDiscardRatio :: Testable prop => Int -> prop -> Property
    withDiscardRatio :: forall prop. Testable prop => Int -> prop -> Property
    withDiscardRatio Int
    n = Int
    n Int -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq` (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ maybeDiscardedRatio = Just n })

    -- | Configure the maximum number of times a property will be shrunk.
    --
    -- For example,
    --
    -- > quickCheck (withMaxShrinks 100 p)
    --
    -- will cause @p@ to only attempt 100 shrinks on failure.
    withMaxShrinks :: Testable prop => Int -> prop -> Property
    withMaxShrinks :: forall prop. Testable prop => Int -> prop -> Property
    withMaxShrinks Int
    n = Int
    n Int -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq` (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ maybeMaxShrinks = Just n })

    -- | Configure the maximum size a property will be tested at.
    withMaxSize :: Testable prop => Int -> prop -> Property
    withMaxSize :: forall prop. Testable prop => Int -> prop -> Property
    withMaxSize Int
    n = Int
    n Int -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq` (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ maybeMaxTestSize = Just n })

    #ifndef NO_TYPEABLE
    -- | Return a value in the 'witnesses' field of the 'Result' returned by 'quickCheckResult'. Witnesses
    -- are returned outer-most first.
    --
    -- In ghci, for example:
    --
    -- >>> [Wit x] <- fmap witnesses . quickCheckResult $ \ x -> witness x $ x == (0 :: Int)
    -- *** Failed! Falsified (after 2 tests):
    -- 1
    -- >>> x
    -- 1
    -- >>> :t x
    -- x :: Int
    witness :: (Typeable a, Show a, Testable prop) => a -> prop -> Property
    witness :: forall a prop.
    (Typeable a, Show a, Testable prop) =>
    a -> prop -> Property
    witness a
    a = a
    a a -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq` (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ theWitnesses = Wit a : theWitnesses res })
    #endif

    -- | Check that all coverage requirements defined by 'cover' and 'coverTable'
    -- are met, using a statistically sound test, and fail if they are not met.
    --
    -- Ordinarily, a failed coverage check does not cause the property to fail.
    -- This is because the coverage requirement is not tested in a statistically
    -- sound way. If you use 'cover' to express that a certain value must appear 20%
    -- of the time, QuickCheck will warn you if the value only appears in 19 out of
    -- 100 test cases - but since the coverage varies randomly, you may have just
    -- been unlucky, and there may not be any real problem with your test
    -- generation.
    --
    -- When you use 'checkCoverage', QuickCheck uses a statistical test to account
    -- for the role of luck in coverage failures. It will run as many tests as
    -- needed until it is sure about whether the coverage requirements are met. If a
    -- coverage requirement is not met, the property fails.
    --
    -- Example:
    --
    -- > quickCheck (checkCoverage prop_foo)
    checkCoverage :: Testable prop => prop -> Property
    checkCoverage :: forall prop. Testable prop => prop -> Property
    checkCoverage = Confidence -> prop -> Property
    forall prop. Testable prop => Confidence -> prop -> Property
    checkCoverageWith Confidence
    stdConfidence

    -- | Check coverage requirements using a custom confidence level.
    -- See 'stdConfidence'.
    --
    -- An example of making the statistical test less stringent in order to improve
    -- performance:
    --
    -- > quickCheck (checkCoverageWith stdConfidence{certainty = 10^6} prop_foo)
    checkCoverageWith :: Testable prop => Confidence -> prop -> Property
    checkCoverageWith :: forall prop. Testable prop => Confidence -> prop -> Property
    checkCoverageWith Confidence
    confidence =
      Confidence -> Integer
    certainty Confidence
    confidence Integer -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq`
      Confidence -> Double
    tolerance Confidence
    confidence Double -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq`
      (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult (\Result
    res -> Result
    res{ maybeCheckCoverage = Just confidence })

    -- | The standard parameters used by 'checkCoverage': @certainty = 10^9@,
    -- @tolerance = 0.9@. See 'Confidence' for the meaning of the parameters.
    stdConfidence :: Confidence
    stdConfidence :: Confidence
    stdConfidence =
      Confidence {
        certainty :: Integer
    certainty = Integer
    10Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Integer
    9,
        tolerance :: Double
    tolerance = Double
    0.9 }

    -- | Attaches a label to a test case. This is used for reporting
    -- test case distribution.
    --
    -- For example:
    --
    -- > prop_reverse_reverse :: [Int] -> Property
    -- > prop_reverse_reverse xs =
    -- >   label ("length of input is " ++ show (length xs)) $
    -- >     reverse (reverse xs) === xs
    --
    -- >>> quickCheck prop_reverse_reverse
    -- +++ OK, passed 100 tests:
    -- 7% length of input is 7
    -- 6% length of input is 3
    -- 5% length of input is 4
    -- 4% length of input is 6
    -- ...
    --
    -- Each use of 'label' in your property results in a separate
    -- table of test case distribution in the output. If this is
    -- not what you want, use 'tabulate'.
    label :: Testable prop => String -> prop -> Property
    label :: forall prop. Testable prop => String -> prop -> Property
    label String
    s =
    #ifndef NO_DEEPSEQ
      String
    s String -> (prop -> Property) -> prop -> Property
    forall a b. NFData a => a -> b -> b
    `deepseq`
    #endif
      (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult ((Result -> Result) -> prop -> Property)
    -> (Result -> Result) -> prop -> Property
    forall a b. (a -> b) -> a -> b
    $
        \Result
    res -> Result
    res { labels = s:labels res }

    -- | Attaches a label to a test case. This is used for reporting
    -- test case distribution.
    --
    -- > collect x = label (show x)
    --
    -- For example:
    --
    -- > prop_reverse_reverse :: [Int] -> Property
    -- > prop_reverse_reverse xs =
    -- >   collect (length xs) $
    -- >     reverse (reverse xs) === xs
    --
    -- >>> quickCheck prop_reverse_reverse
    -- +++ OK, passed 100 tests:
    -- 7% 7
    -- 6% 3
    -- 5% 4
    -- 4% 6
    -- ...
    --
    -- Each use of 'collect' in your property results in a separate
    -- table of test case distribution in the output. If this is
    -- not what you want, use 'tabulate'.
    collect :: (Show a, Testable prop) => a -> prop -> Property
    collect :: forall a prop. (Show a, Testable prop) => a -> prop -> Property
    collect a
    x = String -> prop -> Property
    forall prop. Testable prop => String -> prop -> Property
    label (a -> String
    forall a. Show a => a -> String
    show a
    x)

    -- | Reports how many test cases satisfy a given condition.
    --
    -- For example:
    --
    -- > prop_sorted_sort :: [Int] -> Property
    -- > prop_sorted_sort xs =
    -- >   sorted xs ==>
    -- >   classify (length xs > 1) "non-trivial" $
    -- >   sort xs === xs
    --
    -- >>> quickCheck prop_sorted_sort
    -- +++ OK, passed 100 tests (22% non-trivial).
    classify :: Testable prop =>
                Bool    -- ^ @True@ if the test case should be labelled.
             -> String  -- ^ Label.
             -> prop -> Property
    classify :: forall prop. Testable prop => Bool -> String -> prop -> Property
    classify Bool
    b String
    s =
    #ifndef NO_DEEPSEQ
      String
    s String -> (prop -> Property) -> prop -> Property
    forall a b. NFData a => a -> b -> b
    `deepseq`
    #endif
      Bool
    b Bool -> (prop -> Property) -> prop -> Property
    forall a b. a -> b -> b
    `seq`
      (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult ((Result -> Result) -> prop -> Property)
    -> (Result -> Result) -> prop -> Property
    forall a b. (a -> b) -> a -> b
    $
        \Result
    res -> Result
    res { classes = (s, b):classes res }

    -- | Checks that at least the given proportion of /successful/ test
    -- cases belong to the given class. Discarded tests (i.e. ones
    -- with a false precondition) do not affect coverage.
    --
    -- __Note:__ If the coverage check fails, QuickCheck prints out a warning, but
    -- the property does /not/ fail. To make the property fail, use 'checkCoverage'.
    --
    -- For example:
    --
    -- > prop_sorted_sort :: [Int] -> Property
    -- > prop_sorted_sort xs =
    -- >   sorted xs ==>
    -- >   cover 50 (length xs > 1) "non-trivial" $
    -- >   sort xs === xs
    --
    -- >>> quickCheck prop_sorted_sort
    -- +++ OK, passed 100 tests; 135 discarded (26% non-trivial).
    -- <BLANKLINE>
    -- Only 26% non-trivial, but expected 50%
    cover :: Testable prop =>
             Double -- ^ The required percentage (0-100) of test cases.
          -> Bool   -- ^ @True@ if the test case belongs to the class.
          -> String -- ^ Label for the test case class.
          -> prop -> Property
    cover :: forall prop.
    Testable prop =>
    Double -> Bool -> String -> prop -> Property
    cover Double
    p Bool
    x String
    s = (Result -> Result) -> Property -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult Result -> Result
    f (Property -> Property) -> (prop -> Property) -> prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> String -> prop -> Property
    forall prop. Testable prop => Bool -> String -> prop -> Property
    classify Bool
    x String
    s
      where
        f :: Result -> Result
    f Result
    res = Result
    res { requiredCoverage = (Nothing, s, p/100):requiredCoverage res }

    -- | Collects information about test case distribution into a table.
    -- The arguments to 'tabulate' are the table's name and a list of values
    -- associated with the current test case. After testing, QuickCheck prints the
    -- frequency of all collected values. The frequencies are expressed as a
    -- percentage of the total number of values collected.
    --
    -- You should prefer 'tabulate' to 'label' when each test case is associated
    -- with a varying number of values. Here is a (not terribly useful) example,
    -- where the test data is a list of integers and we record all values that
    -- occur in the list:
    --
    -- > prop_sorted_sort :: [Int] -> Property
    -- > prop_sorted_sort xs =
    -- >   sorted xs ==>
    -- >   tabulate "List elements" (map show xs) $
    -- >   sort xs === xs
    --
    -- >>> quickCheck prop_sorted_sort
    -- +++ OK, passed 100 tests; 1684 discarded.
    -- <BLANKLINE>
    -- List elements (109 in total):
    --  3.7% 0
    --  3.7% 17
    --  3.7% 2
    --  3.7% 6
    --  2.8% -6
    --  2.8% -7
    --
    -- Here is a more useful example. We are testing a chatroom, where the user can
    -- log in, log out, or send a message:
    --
    -- > data Command = LogIn | LogOut | SendMessage String deriving (Data, Show)
    -- > instance Arbitrary Command where ...
    --
    -- There are some restrictions on command sequences; for example, the user must
    -- log in before doing anything else. The function @valid :: [Command] -> Bool@
    -- checks that a command sequence is allowed. Our property then has the form:
    --
    -- > prop_chatroom :: [Command] -> Property
    -- > prop_chatroom cmds =
    -- >   valid cmds ==>
    -- >     ...
    --
    -- The use of '==>' may skew test case distribution. We use 'collect' to see the
    -- length of the command sequences, and 'tabulate' to get the frequencies of the
    -- individual commands:
    --
    -- > prop_chatroom :: [Command] -> Property
    -- > prop_chatroom cmds =
    -- >   wellFormed cmds LoggedOut ==>
    -- >   'collect' (length cmds) $
    -- >   'tabulate' "Commands" (map (show . 'Data.Data.toConstr') cmds) $
    -- >     ...
    --
    -- >>> quickCheckWith stdArgs{maxDiscardRatio = 1000} prop_chatroom
    -- +++ OK, passed 100 tests; 2775 discarded:
    -- 60% 0
    -- 20% 1
    -- 15% 2
    --  3% 3
    --  1% 4
    --  1% 5
    -- <BLANKLINE>
    -- Commands (68 in total):
    -- 62% LogIn
    -- 22% SendMessage
    -- 16% LogOut
    tabulate :: Testable prop => String -> [String] -> prop -> Property
    tabulate :: forall prop.
    Testable prop =>
    String -> [String] -> prop -> Property
    tabulate String
    key [String]
    values =
    #ifndef NO_DEEPSEQ
      String
    key String -> (prop -> Property) -> prop -> Property
    forall a b. NFData a => a -> b -> b
    `deepseq` [String]
    values [String] -> (prop -> Property) -> prop -> Property
    forall a b. NFData a => a -> b -> b
    `deepseq`
    #endif
      (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult ((Result -> Result) -> prop -> Property)
    -> (Result -> Result) -> prop -> Property
    forall a b. (a -> b) -> a -> b
    $
        \Result
    res -> Result
    res { tables = [(key, value) | value <- values] ++ tables res }

    -- | Checks that the values in a given 'table' appear a certain proportion of
    -- the time. A call to 'coverTable' @table@ @[(x1, p1), ..., (xn, pn)]@ asserts
    -- that of the values in @table@, @x1@ should appear at least @p1@ percent of
    -- the time that @table@ appears, @x2@ at least @p2@ percent of the time that
    -- @table@ appears, and so on.
    --
    -- __Note:__ If the coverage check fails, QuickCheck prints out a warning, but
    -- the property does /not/ fail. To make the property fail, use 'checkCoverage'.
    --
    -- Continuing the example from the 'tabular' combinator...
    --
    -- > data Command = LogIn | LogOut | SendMessage String deriving (Data, Show)
    -- > prop_chatroom :: [Command] -> Property
    -- > prop_chatroom cmds =
    -- >   wellFormed cmds LoggedOut ==>
    -- >   'tabulate' "Commands" (map (show . 'Data.Data.toConstr') cmds) $
    -- >     ...
    --
    -- ...we can add a coverage requirement as follows, which checks that @LogIn@,
    -- @LogOut@ and @SendMessage@ each occur at least 25% of the time:
    --
    -- > prop_chatroom :: [Command] -> Property
    -- > prop_chatroom cmds =
    -- >   wellFormed cmds LoggedOut ==>
    -- >   coverTable "Commands" [("LogIn", 25), ("LogOut", 25), ("SendMessage", 25)] $
    -- >   'tabulate' "Commands" (map (show . 'Data.Data.toConstr') cmds) $
    -- >     ... property goes here ...
    --
    -- >>> quickCheck prop_chatroom
    -- +++ OK, passed 100 tests; 2909 discarded:
    -- 56% 0
    -- 17% 1
    -- 10% 2
    --  6% 3
    --  5% 4
    --  3% 5
    --  3% 7
    -- <BLANKLINE>
    -- Commands (111 in total):
    -- 51.4% LogIn
    -- 30.6% SendMessage
    -- 18.0% LogOut
    -- <BLANKLINE>
    -- Table 'Commands' had only 18.0% LogOut, but expected 25.0%
    coverTable :: Testable prop =>
      String -> [(String, Double)] -> prop -> Property
    coverTable :: forall prop.
    Testable prop =>
    String -> [(String, Double)] -> prop -> Property
    coverTable String
    table [(String, Double)]
    xs =
    #ifndef NO_DEEPSEQ
      String
    table String -> (prop -> Property) -> prop -> Property
    forall a b. NFData a => a -> b -> b
    `deepseq` [(String, Double)]
    xs [(String, Double)] -> (prop -> Property) -> prop -> Property
    forall a b. NFData a => a -> b -> b
    `deepseq`
    #endif
      (Result -> Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapTotalResult ((Result -> Result) -> prop -> Property)
    -> (Result -> Result) -> prop -> Property
    forall a b. (a -> b) -> a -> b
    $
        \Result
    res -> Result
    res { requiredCoverage = ys ++ requiredCoverage res }
      where
        ys :: [(Maybe String, String, Double)]
    ys = [(String -> Maybe String
    forall a. a -> Maybe a
    Just String
    table, String
    x, Double
    pDouble -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    100) | (String
    x, Double
    p) <- [(String, Double)]
    xs]

    -- | Implication for properties: The resulting property holds if
    -- the first argument is 'False' (in which case the test case is discarded),
    -- or if the given property holds. Note that using implication carelessly can
    -- severely skew test case distribution: consider using 'cover' to make sure
    -- that your test data is still good quality.
    (==>) :: Testable prop => Bool -> prop -> Property
    Bool
    False ==> :: forall prop. Testable prop => Bool -> prop -> Property
    ==> prop
    _ = Discard -> Property
    forall prop. Testable prop => prop -> Property
    property Discard
    Discard
    Bool
    True  ==> prop
    p = prop -> Property
    forall prop. Testable prop => prop -> Property
    property prop
    p

    -- | Considers a property failed if it does not complete within
    -- the given number of microseconds.
    --
    -- Note: if the property times out, variables quantified inside the
    -- `within` will not be printed. Therefore, you should use `within`
    -- only in the body of your property.
    --
    -- Good: @prop_foo a b c = within 1000000 ...@
    --
    -- Bad: @prop_foo = within 1000000 $ \\a b c -> ...@
    --
    -- Bad: @prop_foo a b c = ...; main = quickCheck (within 1000000 prop_foo)@
    within :: Testable prop => Int -> prop -> Property
    within :: forall prop. Testable prop => Int -> prop -> Property
    within Int
    n = Result -> Int -> prop -> Property
    forall prop. Testable prop => Result -> Int -> prop -> Property
    onTimeout
       (Result
    failed { reason = "Timeout of " ++ show n ++ " microseconds exceeded." })
       Int
    n

    -- | Discards the test case if it does not complete within the given
    -- number of microseconds. This can be useful when testing algorithms
    -- that have pathological cases where they run extremely slowly.
    discardAfter :: Testable prop => Int -> prop -> Property
    discardAfter :: forall prop. Testable prop => Int -> prop -> Property
    discardAfter Int
    n = Result -> Int -> prop -> Property
    forall prop. Testable prop => Result -> Int -> prop -> Property
    onTimeout
       (Result
    rejected { reason = "Timeout of " ++ show n ++ " microseconds exceeded." })
       Int
    n

    onTimeout :: Testable prop => Result -> Int -> prop -> Property
    onTimeout :: forall prop. Testable prop => Result -> Int -> prop -> Property
    onTimeout Result
    timeoutResult Int
    n = (Rose Result -> Rose Result) -> prop -> Property
    forall prop.
    Testable prop =>
    (Rose Result -> Rose Result) -> prop -> Property
    mapRoseResult Rose Result -> Rose Result
    f
      where
        f :: Rose Result -> Rose Result
    f Rose Result
    rose = IO (Rose Result) -> Rose Result
    ioRose (IO (Rose Result) -> Rose Result)
    -> IO (Rose Result) -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ do
          let f (Maybe b)
    m orError :: f (Maybe b) -> b -> f b
    `orError` b
    x = (Maybe b -> b) -> f (Maybe b) -> f b
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (b -> Maybe b -> b
    forall a. a -> Maybe a -> a
    fromMaybe b
    x) f (Maybe b)
    m
          MkRose res roses <- Int -> IO (Rose Result) -> IO (Maybe (Rose Result))
    forall a. Int -> IO a -> IO (Maybe a)
    timeout Int
    n (Rose Result -> IO (Rose Result)
    reduceRose Rose Result
    rose) IO (Maybe (Rose Result)) -> Rose Result -> IO (Rose Result)
    forall {f :: * -> *} {b}. Functor f => f (Maybe b) -> b -> f b
    `orError`
            Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    timeoutResult
          res' <- timeout n (protectResult (return res)) `orError`
            timeoutResult
          return (MkRose res' (map f roses))
    #ifdef NO_TIMEOUT
        timeout _ = fmap Just
    #endif

    -- | Explicit universal quantification: uses an explicitly given
    -- test case generator.
    forAll :: (Show a, Testable prop)
           => Gen a -> (a -> prop) -> Property
    forAll :: forall a prop.
    (Show a, Testable prop) =>
    Gen a -> (a -> prop) -> Property
    forAll Gen a
    gen a -> prop
    pf = Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forall a prop.
    (Show a, Testable prop) =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrink Gen a
    gen (\a
    _ -> []) a -> prop
    pf

    -- | Like 'forAll', but with an explicitly given show function.
    forAllShow :: Testable prop
               => Gen a -> (a -> String) -> (a -> prop) -> Property
    forAllShow :: forall prop a.
    Testable prop =>
    Gen a -> (a -> String) -> (a -> prop) -> Property
    forAllShow Gen a
    gen a -> String
    shower a -> prop
    pf = Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
    forAllShrinkShow Gen a
    gen (\a
    _ -> []) a -> String
    shower a -> prop
    pf

    -- | Like 'forAll', but without printing the generated value.
    forAllBlind :: Testable prop
               => Gen a -> (a -> prop) -> Property
    forAllBlind :: forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
    forAllBlind Gen a
    gen a -> prop
    pf = Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrinkBlind Gen a
    gen (\a
    _ -> []) a -> prop
    pf

    -- | Like 'forAll', but tries to shrink the argument for failing test cases.
    forAllShrink :: (Show a, Testable prop)
                 => Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrink :: forall a prop.
    (Show a, Testable prop) =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrink Gen a
    gen a -> [a]
    shrinker = Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
    forAllShrinkShow Gen a
    gen a -> [a]
    shrinker a -> String
    forall a. Show a => a -> String
    show

    -- | Like 'forAllShrink', but with an explicitly given show function.
    forAllShrinkShow
      :: Testable prop
      => Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
    forAllShrinkShow :: forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
    forAllShrinkShow Gen a
    gen a -> [a]
    shrinker a -> String
    shower a -> prop
    pf =
      Gen a -> (a -> [a]) -> (a -> Property) -> Property
    forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrinkBlind Gen a
    gen a -> [a]
    shrinker (\a
    x -> String -> prop -> Property
    forall prop. Testable prop => String -> prop -> Property
    counterexample (a -> String
    shower a
    x) (a -> prop
    pf a
    x))

    -- | Like 'forAllShrink', but without printing the generated value.
    forAllShrinkBlind
      :: Testable prop
      => Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrinkBlind :: forall prop a.
    Testable prop =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrinkBlind Gen a
    gen a -> [a]
    shrinker a -> prop
    pf =
      Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
    forall a b. (a -> b) -> a -> b
    $
      Gen a
    gen Gen a -> (a -> Gen Prop) -> Gen Prop
    forall a b. Gen a -> (a -> Gen b) -> Gen b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    x ->
        Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> Property -> Gen Prop
    forall a b. (a -> b) -> a -> b
    $
        (a -> [a]) -> a -> (a -> prop) -> Property
    forall prop a.
    Testable prop =>
    (a -> [a]) -> a -> (a -> prop) -> Property
    shrinking a -> [a]
    shrinker a
    x a -> prop
    pf

    -- | Nondeterministic choice: 'p1' '.&.' 'p2' picks randomly one of
    -- 'p1' and 'p2' to test. If you test the property 100 times it
    -- makes 100 random choices.
    (.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
    prop1
    p1 .&. :: forall prop1 prop2.
    (Testable prop1, Testable prop2) =>
    prop1 -> prop2 -> Property
    .&. prop2
    p2 =
      Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
    forall a b. (a -> b) -> a -> b
    $
      Gen Bool
    forall a. Arbitrary a => Gen a
    arbitrary Gen Bool -> (Bool -> Gen Prop) -> Gen Prop
    forall a b. Gen a -> (a -> Gen b) -> Gen b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    b ->
        Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> Property -> Gen Prop
    forall a b. (a -> b) -> a -> b
    $
        String -> Property -> Property
    forall prop. Testable prop => String -> prop -> Property
    counterexample (if Bool
    b then String
    "LHS" else String
    "RHS") (Property -> Property) -> Property -> Property
    forall a b. (a -> b) -> a -> b
    $
          if Bool
    b then prop1 -> Property
    forall prop. Testable prop => prop -> Property
    property prop1
    p1 else prop2 -> Property
    forall prop. Testable prop => prop -> Property
    property prop2
    p2

    -- | Conjunction: 'p1' '.&&.' 'p2' passes if both 'p1' and 'p2' pass.
    (.&&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
    prop1
    p1 .&&. :: forall prop1 prop2.
    (Testable prop1, Testable prop2) =>
    prop1 -> prop2 -> Property
    .&&. prop2
    p2 = [Property] -> Property
    forall prop. Testable prop => [prop] -> Property
    conjoin [prop1 -> Property
    forall prop. Testable prop => prop -> Property
    property prop1
    p1, prop2 -> Property
    forall prop. Testable prop => prop -> Property
    property prop2
    p2]

    -- | Take the conjunction of several properties.
    conjoin :: Testable prop => [prop] -> Property
    conjoin :: forall prop. Testable prop => [prop] -> Property
    conjoin [prop]
    ps =
      Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
    forall a b. (a -> b) -> a -> b
    $
      do roses <- (prop -> Gen (Rose Result)) -> [prop] -> Gen [Rose Result]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((Prop -> Rose Result) -> Gen Prop -> Gen (Rose Result)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Prop -> Rose Result
    unProp (Gen Prop -> Gen (Rose Result))
    -> (prop -> Gen Prop) -> prop -> Gen (Rose Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> (prop -> Property) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . prop -> Property
    forall prop. Testable prop => prop -> Property
    property) [prop]
    ps
         return (MkProp (conj id roses))
     where
      conj :: (Result -> Result) -> [Rose Result] -> Rose Result
    conj Result -> Result
    k [] =
        Result -> [Rose Result] -> Rose Result
    forall a. a -> [Rose a] -> Rose a
    MkRose (Result -> Result
    k Result
    succeeded) []

      conj Result -> Result
    k (Rose Result
    p : [Rose Result]
    ps) = IO (Rose Result) -> Rose Result
    forall a. IO (Rose a) -> Rose a
    IORose (IO (Rose Result) -> Rose Result)
    -> IO (Rose Result) -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ do
        rose@(MkRose result _) <- Rose Result -> IO (Rose Result)
    reduceRose Rose Result
    p
        case ok result of
          Maybe Bool
    _ | Bool -> Bool
    not (Result -> Bool
    expect Result
    result) ->
            Rose Result -> IO (Rose Result)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    failed { reason = "expectFailure may not occur inside a conjunction" })
          Just Bool
    True -> Rose Result -> IO (Rose Result)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Result -> Result) -> [Rose Result] -> Rose Result
    conj (Result -> Result -> Result
    addLabels Result
    result (Result -> Result) -> (Result -> Result) -> Result -> Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> Result -> Result
    addCallbacksAndCoverage Result
    result (Result -> Result) -> (Result -> Result) -> Result -> Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> Result
    k) [Rose Result]
    ps)
          Just Bool
    False -> Rose Result -> IO (Rose Result)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Rose Result
    rose
          Maybe Bool
    Nothing -> do
            rose2@(MkRose result2 _) <- Rose Result -> IO (Rose Result)
    reduceRose ((Result -> Result) -> [Rose Result] -> Rose Result
    conj (Result -> Result -> Result
    addCallbacksAndCoverage Result
    result (Result -> Result) -> (Result -> Result) -> Result -> Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> Result
    k) [Rose Result]
    ps)
            return $
              -- Nasty work to make sure we use the right callbacks
              case ok result2 of
                Just Bool
    True -> Result -> [Rose Result] -> Rose Result
    forall a. a -> [Rose a] -> Rose a
    MkRose (Result
    result2 { ok = Nothing }) []
                Just Bool
    False -> Rose Result
    rose2
                Maybe Bool
    Nothing -> Rose Result
    rose2

      addCallbacksAndCoverage :: Result -> Result -> Result
    addCallbacksAndCoverage Result
    result Result
    r =
        Result
    r { callbacks = callbacks result ++ callbacks r,
            requiredCoverage = requiredCoverage result ++ requiredCoverage r }
      addLabels :: Result -> Result -> Result
    addLabels Result
    result Result
    r =
        Result
    r { labels = labels result ++ labels r,
            classes = classes result ++ classes r,
            tables = tables result ++ tables r }

    -- | Disjunction: 'p1' '.||.' 'p2' passes unless 'p1' and 'p2' simultaneously fail.
    (.||.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
    prop1
    p1 .||. :: forall prop1 prop2.
    (Testable prop1, Testable prop2) =>
    prop1 -> prop2 -> Property
    .||. prop2
    p2 = [Property] -> Property
    forall prop. Testable prop => [prop] -> Property
    disjoin [prop1 -> Property
    forall prop. Testable prop => prop -> Property
    property prop1
    p1, prop2 -> Property
    forall prop. Testable prop => prop -> Property
    property prop2
    p2]

    -- | Take the disjunction of several properties.
    disjoin :: Testable prop => [prop] -> Property
    disjoin :: forall prop. Testable prop => [prop] -> Property
    disjoin [prop]
    ps =
      Gen Prop -> Property
    MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
    forall a b. (a -> b) -> a -> b
    $
      do roses <- (prop -> Gen (Rose Result)) -> [prop] -> Gen [Rose Result]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((Prop -> Rose Result) -> Gen Prop -> Gen (Rose Result)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Prop -> Rose Result
    unProp (Gen Prop -> Gen (Rose Result))
    -> (prop -> Gen Prop) -> prop -> Gen (Rose Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Property -> Gen Prop
    unProperty (Property -> Gen Prop) -> (prop -> Property) -> prop -> Gen Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . prop -> Property
    forall prop. Testable prop => prop -> Property
    property) [prop]
    ps
         return (MkProp (foldr disj (MkRose failed []) roses))
     where
      disj :: Rose Result -> Rose Result -> Rose Result
      disj :: Rose Result -> Rose Result -> Rose Result
    disj Rose Result
    p Rose Result
    q =
        do result1 <- Rose Result
    p
           case ok result1 of
             Maybe Bool
    _ | Bool -> Bool
    not (Result -> Bool
    expect Result
    result1) -> Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    expectFailureError
             Just Bool
    False -> do
               result2 <- Rose Result
    q
               return $
                 case ok result2 of
                   Maybe Bool
    _ | Bool -> Bool
    not (Result -> Bool
    expect Result
    result2) -> Result
    expectFailureError
                   Just Bool
    True -> Result -> Result -> Result
    addCoverage Result
    result1 Result
    result2
                   Just Bool
    False ->
                     MkResult {
                       ok :: Maybe Bool
    ok = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False,
                       expect :: Bool
    expect = Bool
    True,
                       reason :: String
    reason = String -> ShowS
    sep (Result -> String
    reason Result
    result1) (Result -> String
    reason Result
    result2),
                       theException :: Maybe AnException
    theException = Result -> Maybe AnException
    theException Result
    result1 Maybe AnException -> Maybe AnException -> Maybe AnException
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Result -> Maybe AnException
    theException Result
    result2,
                       -- The following few fields are not important because the
                       -- test case has failed anyway
                       abort :: Bool
    abort = Bool
    False,
                       maybeNumTests :: Maybe Int
    maybeNumTests = Maybe Int
    forall a. Maybe a
    Nothing,
                       maybeCheckCoverage :: Maybe Confidence
    maybeCheckCoverage = Maybe Confidence
    forall a. Maybe a
    Nothing,
                       maybeDiscardedRatio :: Maybe Int
    maybeDiscardedRatio = Maybe Int
    forall a. Maybe a
    Nothing,
                       maybeMaxShrinks :: Maybe Int
    maybeMaxShrinks = Maybe Int
    forall a. Maybe a
    Nothing,
                       maybeMaxTestSize :: Maybe Int
    maybeMaxTestSize = Maybe Int
    forall a. Maybe a
    Nothing,
                       labels :: [String]
    labels = [],
                       classes :: [(String, Bool)]
    classes = [],
                       tables :: [(String, String)]
    tables = [],
                       requiredCoverage :: [(Maybe String, String, Double)]
    requiredCoverage = [],
                       callbacks :: [Callback]
    callbacks =
                         Result -> [Callback]
    callbacks Result
    result1 [Callback] -> [Callback] -> [Callback]
    forall a. [a] -> [a] -> [a]
    ++
                         [CallbackKind -> (State -> Result -> IO ()) -> Callback
    PostFinalFailure CallbackKind
    Counterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $ \State
    st Result
    _res -> Terminal -> String -> IO ()
    putLine (State -> Terminal
    terminal State
    st) String
    ""] [Callback] -> [Callback] -> [Callback]
    forall a. [a] -> [a] -> [a]
    ++
                         Result -> [Callback]
    callbacks Result
    result2,
                       testCase :: [String]
    testCase =
                         Result -> [String]
    testCase Result
    result1 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                         Result -> [String]
    testCase Result
    result2
                       WITNESSES(= theWitnesses result1 ++ theWitnesses result2)
                       }
                   Maybe Bool
    Nothing -> Result
    result2
             -- The "obvious" semantics of .||. has:
             --   discard .||. true = true
             --   discard .||. discard = discard
             -- but this implementation gives discard .||. true = discard.
             -- This is reasonable because evaluating result2 in the case
             -- that result1 discards is just busy-work - it won't ever
             -- cause the property to fail. On the other hand, discarding
             -- instead of returning true causes us to execute one more
             -- test case - but assuming that preconditions are cheap to
             -- evaluate, this is no more work than evaluating result2
             -- would be, while (unlike evaluating result2) it might catch
             -- a bug.
             Maybe Bool
    _ -> Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    result1

      expectFailureError :: Result
    expectFailureError = Result
    failed { reason = "expectFailure may not occur inside a disjunction" }
      sep :: String -> ShowS
    sep [] String
    s = String
    s
      sep String
    s [] = String
    s
      sep String
    s String
    s' = String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s'

      addCoverage :: Result -> Result -> Result
    addCoverage Result
    result Result
    r =
        Result
    r { requiredCoverage = requiredCoverage result ++ requiredCoverage r }

    -- | Like '==', but prints a counterexample when it fails.
    infix 4 ===
    (===) :: (Eq a, Show a) => a -> a -> Property
    a
    x === :: forall a. (Eq a, Show a) => a -> a -> Property
    === a
    y =
      String -> Bool -> Property
    forall prop. Testable prop => String -> prop -> Property
    counterexample (a -> String
    forall a. Show a => a -> String
    show a
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    interpret Bool
    res String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    y) Bool
    res
      where
        res :: Bool
    res = a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y
        interpret :: Bool -> String
    interpret Bool
    True  = String
    " == "
        interpret Bool
    False = String
    " /= "

    -- | Like '/=', but prints a counterexample when it fails.
    infix 4 =/=
    (=/=) :: (Eq a, Show a) => a -> a -> Property
    a
    x =/= :: forall a. (Eq a, Show a) => a -> a -> Property
    =/= a
    y =
      String -> Bool -> Property
    forall prop. Testable prop => String -> prop -> Property
    counterexample (a -> String
    forall a. Show a => a -> String
    show a
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    interpret Bool
    res String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    y) Bool
    res
      where
        res :: Bool
    res = a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    y
        interpret :: Bool -> String
    interpret Bool
    True  = String
    " /= "
        interpret Bool
    False = String
    " == "

    #ifndef NO_DEEPSEQ
    -- | Checks that a value is total, i.e., doesn't crash when evaluated.
    total :: NFData a => a -> Property
    total :: forall a. NFData a => a -> Property
    total a
    x = () -> Property
    forall prop. Testable prop => prop -> Property
    property (a -> ()
    forall a. NFData a => a -> ()
    rnf a
    x)
    #endif

    --------------------------------------------------------------------------
    -- the end.