-- | Utilities for interaction with falsify in ghci
module Test.Falsify.Interactive (
    -- * Top-level driver
    falsify
  , falsify'
    -- * Investigating generators
  , sample
  , sampleUsing
  , shrink
  , shrink'
    -- * Re-exports
  , ReplaySeed(..)
  ) where

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

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

import qualified Test.Falsify.Driver     as Driver
import qualified Test.Falsify.SampleTree as SampleTree

{-------------------------------------------------------------------------------
  Top-level driver
-------------------------------------------------------------------------------}

-- | 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 = (TestOutcome' e a -> Maybe e)
-> IO (TestOutcome' e a) -> IO (Maybe e)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ReplaySeed, e) -> e) -> Maybe (ReplaySeed, e) -> Maybe e
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReplaySeed, e) -> e
forall a b. (a, b) -> b
snd (Maybe (ReplaySeed, e) -> Maybe e)
-> (TestOutcome' e a -> Maybe (ReplaySeed, e))
-> TestOutcome' e a
-> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestOutcome' e a -> Maybe (ReplaySeed, e)
forall e a. TestOutcome' e a -> Maybe (ReplaySeed, e)
Driver.failure) (IO (TestOutcome' e a) -> IO (Maybe e))
-> (Property' e a -> IO (TestOutcome' e a))
-> Property' e a
-> IO (Maybe e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Property' e a -> IO (TestOutcome' e a)
forall e a. Options -> Property' e a -> IO (TestOutcome' e a)
Driver.falsify Options
forall a. Default a => a
def

-- | 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' = (TestOutcome' e a -> Maybe (NonEmpty e))
-> IO (TestOutcome' e a) -> IO (Maybe (NonEmpty e))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ReplaySeed, NonEmpty e) -> NonEmpty e)
-> Maybe (ReplaySeed, NonEmpty e) -> Maybe (NonEmpty e)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReplaySeed, NonEmpty e) -> NonEmpty e
forall a b. (a, b) -> b
snd (Maybe (ReplaySeed, NonEmpty e) -> Maybe (NonEmpty e))
-> (TestOutcome' e a -> Maybe (ReplaySeed, NonEmpty e))
-> TestOutcome' e a
-> Maybe (NonEmpty 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)
Driver.failure') (IO (TestOutcome' e a) -> IO (Maybe (NonEmpty e)))
-> (Property' e a -> IO (TestOutcome' e a))
-> Property' e a
-> IO (Maybe (NonEmpty e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Property' e a -> IO (TestOutcome' e a)
forall e a. Options -> Property' e a -> IO (TestOutcome' e a)
Driver.falsify Options
forall a. Default a => a
def

{-------------------------------------------------------------------------------
  Investigating generators
-------------------------------------------------------------------------------}

-- | Sample generator
sample :: Gen a -> IO a
sample :: forall a. Gen a -> IO a
sample Gen a
g = ((SMGen -> Gen a -> a) -> Gen a -> SMGen -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip SMGen -> Gen a -> a
forall a. SMGen -> Gen a -> a
sampleUsing' Gen a
g) (SMGen -> a) -> IO SMGen -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SMGen
initSMGen

-- | Sample generator using the specified seed
sampleUsing :: ReplaySeed -> Gen a -> a
sampleUsing :: forall a. ReplaySeed -> Gen a -> a
sampleUsing ReplaySeed{Word64
replaySeed :: Word64
replaySeed :: ReplaySeed -> Word64
replaySeed, Word64
replayGamma :: Word64
replayGamma :: ReplaySeed -> Word64
replayGamma} =
    SMGen -> Gen a -> a
forall a. SMGen -> Gen a -> a
sampleUsing' (SMGen -> Gen a -> a) -> SMGen -> Gen a -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> SMGen
seedSMGen Word64
replaySeed Word64
replayGamma

-- | Internal generalization of 'sample' and 'sampleUsing'
sampleUsing' :: SMGen -> Gen a -> a
sampleUsing' :: forall a. SMGen -> Gen a -> a
sampleUsing' SMGen
prng Gen a
g = (a, [SampleTree]) -> a
forall a b. (a, b) -> a
fst ((a, [SampleTree]) -> a) -> (a, [SampleTree]) -> a
forall a b. (a -> b) -> a -> b
$ Gen a -> SampleTree -> (a, [SampleTree])
forall a. Gen a -> SampleTree -> (a, [SampleTree])
runGen Gen a
g (SMGen -> SampleTree
SampleTree.fromPRNG SMGen
prng)

-- | 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 = Property' a () -> IO (Maybe a)
forall e a. Property' e a -> IO (Maybe e)
falsify (Property' a () -> IO (Maybe a)) -> Property' a () -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Either a ()) -> Gen a -> Property' a ()
forall e a b. (a -> Either e b) -> Gen a -> Property' e b
testGen' (\a
x -> a -> Bool -> Either a ()
aux a
x (Bool -> Either a ()) -> Bool -> Either a ()
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  = () -> Either a ()
forall a b. b -> Either a b
Right ()
    aux a
x Bool
False = a -> Either a ()
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 = Property' e () -> IO (Maybe (NonEmpty e))
forall e a. Property' e a -> IO (Maybe (NonEmpty e))
falsify' (Property' e () -> IO (Maybe (NonEmpty e)))
-> Property' e () -> IO (Maybe (NonEmpty e))
forall a b. (a -> b) -> a -> b
$ (a -> Either e ()) -> Gen a -> Property' e ()
forall e a b. (a -> Either e b) -> Gen a -> Property' e b
testGen' (Maybe e -> Either e ()
aux (Maybe e -> Either e ()) -> (a -> Maybe e) -> a -> Either e ()
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  = () -> Either e ()
forall a b. b -> Either a b
Right ()
    aux (Just e
x) = e -> Either e ()
forall a b. a -> Either a b
Left e
x