{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : MonusWeightedSearch.Internal.TestHelpers
-- Copyright   : (c) Donnacha Oisín Kidney 2021
-- Maintainer  : mail@doisinkidney.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Some utility functions for implementing 'Arbitrary' etc.

module MonusWeightedSearch.Internal.TestHelpers where

import Test.QuickCheck
import Numeric.Natural
import System.Random

-- $setup
-- >>> import Test.QuickCheck

-- | @'sumsTo' n@ generates a list that sums to @n@.
--
-- prop> n >= 0 ==> forAll (sumsTo n) (\xs -> sum xs === n)
sumsTo :: Int -> Gen [Int]
sumsTo :: Int -> Gen [Int]
sumsTo Int
n = [Int] -> Int -> Gen [Int]
forall {t}. (Ord t, Num t, Random t) => [t] -> t -> Gen [t]
go [] Int
n Gen [Int] -> ([Int] -> Gen [Int]) -> Gen [Int]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Gen [Int]
forall a. [a] -> Gen [a]
shuffle
  where
    go :: [t] -> t -> Gen [t]
go [t]
ks t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [t] -> Gen [t]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [t]
ks
      | Bool
otherwise = do
          t
m <- (t, t) -> Gen t
forall a. Random a => (a, a) -> Gen a
choose (t
1, t
n)
          [t] -> t -> Gen [t]
go (t
m t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ks) (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
m)

instance Arbitrary Natural where
  arbitrary :: Gen Natural
arbitrary = Gen Natural
forall a. Integral a => Gen a
arbitrarySizedNatural
  shrink :: Natural -> [Natural]
shrink = (Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Natural])
-> (Natural -> [Integer]) -> Natural -> [Natural]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer
0Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=) ([Integer] -> [Integer])
-> (Natural -> [Integer]) -> Natural -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> [Integer])
-> (Natural -> Integer) -> Natural -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | @'percentageChance' n@ is 'True' @n@% of the time, and 'False' the rest
-- of the time.
percentageChance :: Word -> Gen Bool
percentageChance :: Word -> Gen Bool
percentageChance Word
n = (Word -> Bool) -> Gen Word -> Gen Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word
nWord -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>) ((Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
0,Word
99))

-- | @'percentageChanceIO' n@ is 'True' @n@% of the time, and 'False' the rest
-- of the time.
percentageChanceIO :: Word -> IO Bool
percentageChanceIO :: Word -> IO Bool
percentageChanceIO Word
n = (Word -> Bool) -> IO Word -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word
nWord -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>) ((Word, Word) -> IO Word
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Word
0,Word
99))
{-# INLINE percentageChanceIO #-}