-----------------------------------------------------------------------------
-- |
-- Module      :  Disco.Property
-- Copyright   :  disco team and contributors
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Properties of disco functions.
--
-----------------------------------------------------------------------------

module Disco.Property
       where

import qualified Data.Enumeration.Invertible as E
import qualified Test.QuickCheck             as QC

import           Disco.Effects.Random
import           Polysemy

import           Disco.Value

-- | Toggles which outcome (finding or not finding the thing being
--   searched for) qualifies as success, without changing the thing
--   being searched for.
invertMotive :: SearchMotive -> SearchMotive
invertMotive :: SearchMotive -> SearchMotive
invertMotive (SearchMotive (Bool
a, Bool
b)) = (Bool, Bool) -> SearchMotive
SearchMotive (Bool -> Bool
not Bool
a, Bool
b)

-- | Flips the success or failure status of a @PropResult@, leaving
--   the explanation unchanged.
invertPropResult :: TestResult -> TestResult
invertPropResult :: TestResult -> TestResult
invertPropResult res :: TestResult
res@(TestResult Bool
b TestReason
r TestEnv
env)
  | TestRuntimeError EvalError
_ <- TestReason
r = TestResult
res
  | Bool
otherwise               = Bool -> TestReason -> TestEnv -> TestResult
TestResult (Bool -> Bool
not Bool
b) TestReason
r TestEnv
env

-- | Select samples from an enumeration according to a search type. Also returns
--   a 'SearchType' describing the results, which may be 'Exhaustive' if the
--   enumeration is no larger than the number of samples requested.
generateSamples :: Member Random r => SearchType -> E.IEnumeration a -> Sem r ([a], SearchType)
generateSamples :: SearchType -> IEnumeration a -> Sem r ([a], SearchType)
generateSamples SearchType
Exhaustive IEnumeration a
e           = ([a], SearchType) -> Sem r ([a], SearchType)
forall (m :: * -> *) a. Monad m => a -> m a
return (IEnumeration a -> [a]
forall a. IEnumeration a -> [a]
E.enumerate IEnumeration a
e, SearchType
Exhaustive)
generateSamples (Randomized Integer
n Integer
m) IEnumeration a
e
  | E.Finite Integer
k <- IEnumeration a -> Cardinality
forall a. IEnumeration a -> Cardinality
E.card IEnumeration a
e, Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m = ([a], SearchType) -> Sem r ([a], SearchType)
forall (m :: * -> *) a. Monad m => a -> m a
return (IEnumeration a -> [a]
forall a. IEnumeration a -> [a]
E.enumerate IEnumeration a
e, SearchType
Exhaustive)
  | Bool
otherwise                          = do
    let small :: [Integer]
small = [Integer
0 .. Integer
n]
    [Integer]
rs <- Gen [Integer] -> Sem r [Integer]
forall (r :: EffectRow) a. Member Random r => Gen a -> Sem r a
runGen (Gen [Integer] -> Sem r [Integer])
-> ([Integer] -> Gen [Integer]) -> [Integer] -> Sem r [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Gen Integer) -> [Integer] -> Gen [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Integer -> Gen Integer
forall a a. (Integral a, Integral a) => a -> Gen a
sizedNat ([Integer] -> Sem r [Integer]) -> [Integer] -> Sem r [Integer]
forall a b. (a -> b) -> a -> b
$ [Integer
n .. Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m]
    let samples :: [a]
samples = (Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (IEnumeration a -> Integer -> a
forall a. IEnumeration a -> Integer -> a
E.select IEnumeration a
e) ([Integer] -> [a]) -> [Integer] -> [a]
forall a b. (a -> b) -> a -> b
$ [Integer]
small [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer]
rs
    ([a], SearchType) -> Sem r ([a], SearchType)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
samples, Integer -> Integer -> SearchType
Randomized Integer
n Integer
m)
  where
    sizedNat :: a -> Gen a
sizedNat a
k = Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
QC.resize (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k) Gen a
forall a. Integral a => Gen a
QC.arbitrarySizedNatural

-- XXX do shrinking for randomly generated test cases?