-- | Sample tree
--
-- Intended for qualified import.
--
-- > import Test.Falsify.SampleTree (SampleTree(..), pattern Inf, Sample(..))
-- > import qualified Test.Falsify.SampleTree as SampleTree
module Test.Falsify.SampleTree (
    -- * Definition
    SampleTree(..)
  , Sample(..)
  , pattern Inf
  , sampleValue
    -- * Construction
  , fromPRNG
  , fromSeed
  , minimal
  , constant
    -- * Combinators
  , map
  , mod
  ) where

import Prelude hiding (map, mod)
import qualified Prelude

import Data.Word
import System.Random.SplitMix

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Sample tree
--
-- A sample tree is a (conceptually and sometimes actually) infinite tree
-- representing drawing values from and splitting a PRNG.
data SampleTree =
    -- | Default constructor
    --
    -- The type of ST is really
    --
    -- > ST :: Word64 & (SampleTree * SampleTree) -> SampleTree
    --
    -- where @(&)@ is the additive conjunction from linear logic. In other
    -- words, the intention is that /either/ the @Word64@ is used, /or/
    -- the pair of subtrees; put another way, we /either/ draw a value from the
    -- PRNG, /or/ split it into two new PRNGs.
    SampleTree Sample SampleTree SampleTree

    -- | Minimal tree (0 everywhere)
    --
    -- This constructor allows us to represent an infinite tree in a finite way
    -- and, importantly, /recognize/ a tree that is minimal everywhere. This is
    -- necessary when shrinking in the context of generators that generate
    -- infinitely large values.
  | Minimal
  deriving (Int -> SampleTree -> ShowS
[SampleTree] -> ShowS
SampleTree -> String
(Int -> SampleTree -> ShowS)
-> (SampleTree -> String)
-> ([SampleTree] -> ShowS)
-> Show SampleTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SampleTree -> ShowS
showsPrec :: Int -> SampleTree -> ShowS
$cshow :: SampleTree -> String
show :: SampleTree -> String
$cshowList :: [SampleTree] -> ShowS
showList :: [SampleTree] -> ShowS
Show)

-- | Sample
--
-- The samples in the t'SampleTree' record if they were the originally produced
-- sample, or whether they have been shrunk.
data Sample =
    NotShrunk Word64
  | Shrunk    Word64
  deriving (Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> String
(Int -> Sample -> ShowS)
-> (Sample -> String) -> ([Sample] -> ShowS) -> Show Sample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sample -> ShowS
showsPrec :: Int -> Sample -> ShowS
$cshow :: Sample -> String
show :: Sample -> String
$cshowList :: [Sample] -> ShowS
showList :: [Sample] -> ShowS
Show, Sample -> Sample -> Bool
(Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool) -> Eq Sample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
/= :: Sample -> Sample -> Bool
Eq, Eq Sample
Eq Sample =>
(Sample -> Sample -> Ordering)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Sample)
-> (Sample -> Sample -> Sample)
-> Ord Sample
Sample -> Sample -> Bool
Sample -> Sample -> Ordering
Sample -> Sample -> Sample
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sample -> Sample -> Ordering
compare :: Sample -> Sample -> Ordering
$c< :: Sample -> Sample -> Bool
< :: Sample -> Sample -> Bool
$c<= :: Sample -> Sample -> Bool
<= :: Sample -> Sample -> Bool
$c> :: Sample -> Sample -> Bool
> :: Sample -> Sample -> Bool
$c>= :: Sample -> Sample -> Bool
>= :: Sample -> Sample -> Bool
$cmax :: Sample -> Sample -> Sample
max :: Sample -> Sample -> Sample
$cmin :: Sample -> Sample -> Sample
min :: Sample -> Sample -> Sample
Ord)

{-------------------------------------------------------------------------------
  Views
-------------------------------------------------------------------------------}

-- | Value of the sample
--
-- Samples differentiate between 'NotShrunk' and 'Shrunk', but for most use
-- cases this distinction does not matter.
sampleValue :: Sample -> Word64
sampleValue :: Sample -> Word64
sampleValue (NotShrunk Word64
s) = Word64
s
sampleValue (Shrunk    Word64
s) = Word64
s

view :: SampleTree -> (Sample, SampleTree, SampleTree)
view :: SampleTree -> (Sample, SampleTree, SampleTree)
view SampleTree
Minimal            = (Word64 -> Sample
Shrunk Word64
0, SampleTree
Minimal, SampleTree
Minimal)
view (SampleTree Sample
s SampleTree
l SampleTree
r) = (Sample
s, SampleTree
l, SampleTree
r)

-- | Pattern synonym for treating the sample tree as infinite
pattern Inf :: Sample -> SampleTree -> SampleTree -> SampleTree
pattern $mInf :: forall {r}.
SampleTree
-> (Sample -> SampleTree -> SampleTree -> r) -> ((# #) -> r) -> r
Inf s l r <- (view -> (s, l, r))

{-# COMPLETE Inf #-}

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Construct t'SampleTree' from splittable PRNG
fromPRNG :: SMGen -> SampleTree
fromPRNG :: SMGen -> SampleTree
fromPRNG = SMGen -> SampleTree
go
  where
    go :: SMGen -> SampleTree
    go :: SMGen -> SampleTree
go SMGen
g =
        let (Word64
n, SMGen
_) = SMGen -> (Word64, SMGen)
nextWord64 SMGen
g
            (SMGen
l, SMGen
r) = SMGen -> (SMGen, SMGen)
splitSMGen SMGen
g
        in Sample -> SampleTree -> SampleTree -> SampleTree
SampleTree (Word64 -> Sample
NotShrunk Word64
n) (SMGen -> SampleTree
go SMGen
l) (SMGen -> SampleTree
go SMGen
r)

-- | Consruct t'SampleTree' from initial seed
--
-- The seed will be used to initialize an 'SMGen'
fromSeed :: Word64 -> SampleTree
fromSeed :: Word64 -> SampleTree
fromSeed = SMGen -> SampleTree
fromPRNG (SMGen -> SampleTree) -> (Word64 -> SMGen) -> Word64 -> SampleTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SMGen
mkSMGen

-- | Minimal sample tree
--
-- Generators should produce the \"simplest\" value when given this tree,
-- for some suitable application-specific definition of \"simple\".
minimal :: SampleTree
minimal :: SampleTree
minimal = SampleTree
Minimal

-- | Sample tree that is the given value everywhere
--
-- This is primarily useful for debugging.
constant :: Word64 -> SampleTree
constant :: Word64 -> SampleTree
constant Word64
s = SampleTree
go
  where
    go :: SampleTree
    go :: SampleTree
go = Sample -> SampleTree -> SampleTree -> SampleTree
SampleTree (Word64 -> Sample
NotShrunk Word64
s) SampleTree
go SampleTree
go

{-------------------------------------------------------------------------------
  Combinators
-------------------------------------------------------------------------------}

-- | Map function over all random samples in the tree
--
-- Precondition: the function must preserve zeros:
--
-- > f 0 == 0
--
-- This means that we have
--
-- > map f M == M
--
-- This is primarily useful for debugging.
map :: (Word64 -> Word64) -> SampleTree -> SampleTree
map :: (Word64 -> Word64) -> SampleTree -> SampleTree
map Word64 -> Word64
f = SampleTree -> SampleTree
go
  where
    go :: SampleTree -> SampleTree
    go :: SampleTree -> SampleTree
go (SampleTree Sample
s SampleTree
l SampleTree
r) = Sample -> SampleTree -> SampleTree -> SampleTree
SampleTree (Sample -> Sample
mapSample Sample
s) (SampleTree -> SampleTree
go SampleTree
l) (SampleTree -> SampleTree
go SampleTree
r)
    go SampleTree
Minimal            = SampleTree
Minimal

    mapSample :: Sample -> Sample
    mapSample :: Sample -> Sample
mapSample (NotShrunk Word64
s) = Word64 -> Sample
NotShrunk (Word64 -> Word64
f Word64
s)
    mapSample (Shrunk    Word64
s) = Word64 -> Sample
Shrunk    (Word64 -> Word64
f Word64
s)

-- | Apply @mod m@ at every sample in the tree
--
-- This is primarily useful for debugging.
mod :: Word64 -> SampleTree -> SampleTree
mod :: Word64 -> SampleTree -> SampleTree
mod Word64
m = (Word64 -> Word64) -> SampleTree -> SampleTree
map (\Word64
s -> Word64
s Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`Prelude.mod` Word64
m)