-- | Utilities for interaction with falsify in ghci
module Test.Falsify.Interactive (
    falsify
  , falsify'
  , sample
  , shrink
  , shrink'
    -- * Re-exports
  , module Test.Falsify.Property
    -- ** Functions
  , pattern Gen.Fn
  , pattern Gen.Fn2
  , pattern Gen.Fn3
  ) where

import Data.Bifunctor
import Data.Default
import Data.List.NonEmpty (NonEmpty(..))
import System.Random.SplitMix

import qualified Data.List.NonEmpty as NE

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

import qualified Test.Falsify.Generator           as Gen
import qualified Test.Falsify.Internal.Driver     as Driver
import qualified Test.Falsify.Internal.SampleTree as SampleTree

-- | Sample generator
sample :: Gen a -> IO a
sample :: forall a. Gen a -> IO a
sample Gen a
g = do
    SMGen
prng <- IO SMGen
initSMGen
    let (a
x, [SampleTree]
_shrunk) = forall a. Gen a -> SampleTree -> (a, [SampleTree])
runGen Gen a
g (SMGen -> SampleTree
SampleTree.fromPRNG SMGen
prng)
    forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Shrink counter-example
--
-- This will run the generator repeatedly until it finds a counter-example to
-- the given property, and will then shrink it.
--
-- Returns 'Nothing' if no counter-example could be found.
shrink :: forall a. (a -> Bool) -> Gen a -> IO (Maybe a)
shrink :: forall a. (a -> Bool) -> Gen a -> IO (Maybe a)
shrink a -> Bool
p Gen a
g = forall e a. Property' e a -> IO (Maybe e)
falsify forall a b. (a -> b) -> a -> b
$ forall e a b. (a -> Either e b) -> Gen a -> Property' e b
testGen' (\a
x -> a -> Bool -> Either a ()
aux a
x forall a b. (a -> b) -> a -> b
$ a -> Bool
p a
x) Gen a
g
  where
    aux :: a -> Bool -> Either a ()
    aux :: a -> Bool -> Either a ()
aux a
_ Bool
True  = forall a b. b -> Either a b
Right ()
    aux a
x Bool
False = forall a b. a -> Either a b
Left a
x

-- | Generalization of 'shrink'. Returns the full shrink history.
shrink' :: forall e a. (a -> Maybe e) -> Gen a -> IO (Maybe (NonEmpty e))
shrink' :: forall e a. (a -> Maybe e) -> Gen a -> IO (Maybe (NonEmpty e))
shrink' a -> Maybe e
p Gen a
g = forall e a. Property' e a -> IO (Maybe (NonEmpty e))
falsify' forall a b. (a -> b) -> a -> b
$ forall e a b. (a -> Either e b) -> Gen a -> Property' e b
testGen' (Maybe e -> Either e ()
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe e
p) Gen a
g
  where
    aux :: Maybe e -> Either e ()
    aux :: Maybe e -> Either e ()
aux Maybe e
Nothing  = forall a b. b -> Either a b
Right ()
    aux (Just e
x) = forall a b. a -> Either a b
Left e
x

-- | Try to falsify the given property
--
-- Reports the counter-example, if we find any.
falsify :: forall e a. Property' e a -> IO (Maybe e)
falsify :: forall e a. Property' e a -> IO (Maybe e)
falsify = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NonEmpty a -> a
NE.last) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Property' e a -> IO (Maybe (NonEmpty e))
falsify'

-- | Generalization of 'falsify' that reports the full shrink history
falsify' :: forall e a. Property' e a -> IO (Maybe (NonEmpty e))
falsify' :: forall e a. Property' e a -> IO (Maybe (NonEmpty e))
falsify' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReplaySeed, [Success a], TotalDiscarded, Maybe (Failure e))
-> Maybe (NonEmpty e)
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a.
Options
-> Property' e a
-> IO (ReplaySeed, [Success a], TotalDiscarded, Maybe (Failure e))
Driver.falsify forall a. Default a => a
def
  where
    aux ::
         ( ReplaySeed
         , [Driver.Success a]
         , Driver.TotalDiscarded
         , Maybe (Driver.Failure e)
         )
      -> Maybe (NonEmpty e)
    aux :: (ReplaySeed, [Success a], TotalDiscarded, Maybe (Failure e))
-> Maybe (NonEmpty e)
aux (ReplaySeed
_seed, [Success a]
_successes, TotalDiscarded
_discarded, Maybe (Failure e)
failure) =
        case Maybe (Failure e)
failure of
          Maybe (Failure e)
Nothing -> forall a. Maybe a
Nothing
          Just Failure e
f  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall p n. ShrinkExplanation p n -> NonEmpty p
shrinkHistory forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall e. Failure e -> ShrinkExplanation (e, TestRun) TestRun
Driver.failureRun Failure e
f