-- | The main @falsify@ driver
--
-- The main entrypoint into @falsify@ is the 'falsify' function, which attempts
-- to falsify the t'Test.Falsify.Property'' it is given.
-- However, most users don't need to use this module directly; it is primarily
-- intended for integration of @falsify@ in test frameworks such as @tasty@.
-- For the case of @tasty@ /specifically/, see the @tasty-falsify@ package.
module Test.Falsify.Driver (
    falsify
    -- * Options
  , Options(..)
  , ReplaySeed(..)
  , ExpectFailure(..)
  , Verbose(..)
  , parseReplaySeed
    -- * Results
  , TestOutcome -- opaque
  , TestOutcome'
  , RenderedTestOutcome(..)
  , renderTestOutcome
    -- ** Additional accessors
  , successes
  , discarded
  , failure
  , failure'
  ) where

import Data.Bifunctor
import Data.List.NonEmpty (NonEmpty)

import qualified Data.List.NonEmpty as NE

import Test.Falsify.Internal.Driver
import Test.Falsify.Internal.Driver.ReplaySeed
import Test.Falsify.Internal.Property
import Test.Falsify.Internal.Shrinking

{-------------------------------------------------------------------------------
  Additional public accessors for 'TestOutcome'

  'TestOutcome' has quite a bit of @falsify@-internal detail; here we provide
  some accessors that may be useful in user code, without having to expose all
  of those internals.
-------------------------------------------------------------------------------}

-- | Successful test outcomes
--
-- NOTE: Normally the @a@ parameter for a top-level property is instantiated to
-- unit (@()@), in which case it's really only the /length/ of the list of
-- successes that is relevant.
successes :: forall e a. TestOutcome' e a -> [(ReplaySeed, a)]
successes :: forall e a. TestOutcome' e a -> [(ReplaySeed, a)]
successes TestOutcome{[Success a]
testSuccesses :: [Success a]
testSuccesses :: forall e a. TestOutcome' e a -> [Success a]
testSuccesses} = (Success a -> (ReplaySeed, a)) -> [Success a] -> [(ReplaySeed, a)]
forall a b. (a -> b) -> [a] -> [b]
map Success a -> (ReplaySeed, a)
aux [Success a]
testSuccesses
  where
    -- Drops the 'TestRun'
    aux :: Success a -> (ReplaySeed, a)
    aux :: Success a -> (ReplaySeed, a)
aux Success{ReplaySeed
successSeed :: ReplaySeed
successSeed :: forall a. Success a -> ReplaySeed
successSeed, a
successResult :: a
successResult :: forall a. Success a -> a
successResult} = (ReplaySeed
successSeed, a
successResult)

-- | Number of discarded test
discarded :: TestOutcome' e a -> Word
discarded :: forall e a. TestOutcome' e a -> Word
discarded TestOutcome{Word
testDiscarded :: Word
testDiscarded :: forall e a. TestOutcome' e a -> Word
testDiscarded} = Word
testDiscarded

-- | Failing test, if any
--
-- Returns the error after shrinking
failure :: TestOutcome' e a -> Maybe (ReplaySeed, e)
failure :: forall e a. TestOutcome' e a -> Maybe (ReplaySeed, e)
failure = ((ReplaySeed, NonEmpty e) -> (ReplaySeed, e))
-> Maybe (ReplaySeed, NonEmpty e) -> Maybe (ReplaySeed, e)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty e -> e) -> (ReplaySeed, NonEmpty e) -> (ReplaySeed, e)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NonEmpty e -> e
forall a. NonEmpty a -> a
NE.last) (Maybe (ReplaySeed, NonEmpty e) -> Maybe (ReplaySeed, e))
-> (TestOutcome' e a -> Maybe (ReplaySeed, NonEmpty e))
-> TestOutcome' e a
-> Maybe (ReplaySeed, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestOutcome' e a -> Maybe (ReplaySeed, NonEmpty e)
forall e a. TestOutcome' e a -> Maybe (ReplaySeed, NonEmpty e)
failure'

-- | Generalization of 'failure' that returns the full shrinking history
failure' :: forall e a. TestOutcome' e a -> Maybe (ReplaySeed, NonEmpty e)
failure' :: forall e a. TestOutcome' e a -> Maybe (ReplaySeed, NonEmpty e)
failure' TestOutcome{Maybe (Failure e)
testFailure :: Maybe (Failure e)
testFailure :: forall e a. TestOutcome' e a -> Maybe (Failure e)
testFailure} = Failure e -> (ReplaySeed, NonEmpty e)
aux (Failure e -> (ReplaySeed, NonEmpty e))
-> Maybe (Failure e) -> Maybe (ReplaySeed, NonEmpty e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Failure e)
testFailure
  where
    aux :: Failure e -> (ReplaySeed, NonEmpty e)
    aux :: Failure e -> (ReplaySeed, NonEmpty e)
aux Failure{ReplaySeed
failureSeed :: ReplaySeed
failureSeed :: forall e. Failure e -> ReplaySeed
failureSeed, ShrinkExplanation (Counterexample e) TestRun
failureRun :: ShrinkExplanation (Counterexample e) TestRun
failureRun :: forall e. Failure e -> ShrinkExplanation (Counterexample e) TestRun
failureRun} = (
          ReplaySeed
failureSeed
        ,   ShrinkExplanation e TestRun -> NonEmpty e
forall p n. ShrinkExplanation p n -> NonEmpty p
shrinkHistory
          (ShrinkExplanation e TestRun -> NonEmpty e)
-> ShrinkExplanation e TestRun -> NonEmpty e
forall a b. (a -> b) -> a -> b
$ (Counterexample e -> e)
-> ShrinkExplanation (Counterexample e) TestRun
-> ShrinkExplanation e TestRun
forall a b c.
(a -> b) -> ShrinkExplanation a c -> ShrinkExplanation b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Counterexample e -> e
forall e. Counterexample e -> e
counterexampleError
          (ShrinkExplanation (Counterexample e) TestRun
 -> ShrinkExplanation e TestRun)
-> ShrinkExplanation (Counterexample e) TestRun
-> ShrinkExplanation e TestRun
forall a b. (a -> b) -> a -> b
$ ShrinkExplanation (Counterexample e) TestRun
failureRun
        )