module Fake.Combinators where

------------------------------------------------------------------------------
import Control.Monad
import Data.List
import Data.Ord
import System.Random
------------------------------------------------------------------------------
import Fake.Types
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- ** Common generators and combinators

------------------------------------------------------------------------------
-- | Generates a random element in the given inclusive range.
fromRange :: Random a => (a,a) -> FGen a
fromRange :: (a, a) -> FGen a
fromRange (a, a)
rng = (StdGen -> a) -> FGen a
forall a. (StdGen -> a) -> FGen a
MkFGen (\StdGen
r -> let (a
x,StdGen
_) = (a, a) -> StdGen -> (a, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a, a)
rng StdGen
r in a
x)


------------------------------------------------------------------------------
-- | Generates a random element over the natural range of `a`.
pickAny :: Random a => FGen a
pickAny :: FGen a
pickAny = (StdGen -> a) -> FGen a
forall a. (StdGen -> a) -> FGen a
MkFGen (\StdGen
r -> let (a
x,StdGen
_) = StdGen -> (a, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random StdGen
r in a
x)


------------------------------------------------------------------------------
-- | Generates a value that satisfies a predicate.
suchThat :: FGen a -> (a -> Bool) -> FGen a
FGen a
gen suchThat :: FGen a -> (a -> Bool) -> FGen a
`suchThat` a -> Bool
p =
  do Maybe a
mx <- FGen a
gen FGen a -> (a -> Bool) -> FGen (Maybe a)
forall a. FGen a -> (a -> Bool) -> FGen (Maybe a)
`suchThatMaybe` a -> Bool
p
     case Maybe a
mx of
       Just a
x  -> a -> FGen a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
       Maybe a
Nothing -> FGen a
gen FGen a -> (a -> Bool) -> FGen a
forall a. FGen a -> (a -> Bool) -> FGen a
`suchThat` a -> Bool
p


------------------------------------------------------------------------------
-- | Tries to generate a value that satisfies a predicate.
suchThatMaybe :: FGen a -> (a -> Bool) -> FGen (Maybe a)
FGen a
gen suchThatMaybe :: FGen a -> (a -> Bool) -> FGen (Maybe a)
`suchThatMaybe` a -> Bool
p = do
    a
x <- FGen a
gen
    Maybe a -> FGen (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> FGen (Maybe a)) -> Maybe a -> FGen (Maybe a)
forall a b. (a -> b) -> a -> b
$ if a -> Bool
p a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Randomly uses one of the given generators. The input list
-- must be non-empty.
oneof :: [FGen a] -> FGen a
oneof :: [FGen a] -> FGen a
oneof [] = [Char] -> FGen a
forall a. HasCallStack => [Char] -> a
error [Char]
"Fake.oneof used with empty list"
oneof [FGen a]
gs = (Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (Int
0,[FGen a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FGen a]
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) FGen Int -> (Int -> FGen a) -> FGen a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([FGen a]
gs [FGen a] -> Int -> FGen a
forall a. [a] -> Int -> a
!!)


------------------------------------------------------------------------------
-- | Chooses one of the given generators, with a weighted random distribution.
-- The input list must be non-empty.
frequency :: [(Int, FGen a)] -> FGen a
frequency :: [(Int, FGen a)] -> FGen a
frequency [] = [Char] -> FGen a
forall a. HasCallStack => [Char] -> a
error [Char]
"Fake.frequency used with empty list"
frequency [(Int, FGen a)]
xs0 = (Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (Int
1, Int
tot) FGen Int -> (Int -> FGen a) -> FGen a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> [(Int, FGen a)] -> FGen a
forall t p. (Ord t, Num t) => t -> [(t, p)] -> p
`pick` [(Int, FGen a)]
xs0)
 where
  tot :: Int
tot = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, FGen a) -> Int) -> [(Int, FGen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, FGen a) -> Int
forall a b. (a, b) -> a
fst [(Int, FGen a)]
xs0)

  pick :: t -> [(t, p)] -> p
pick t
n ((t
k,p
x):[(t, p)]
xs)
    | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
k    = p
x
    | Bool
otherwise = t -> [(t, p)] -> p
pick (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
k) [(t, p)]
xs
  pick t
_ [(t, p)]
_  = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"Fake.pick used with empty list"


------------------------------------------------------------------------------
-- | Generates one of the given values. The input list must be non-empty.
elements :: [a] -> FGen a
elements :: [a] -> FGen a
elements [] = [Char] -> FGen a
forall a. HasCallStack => [Char] -> a
error [Char]
"Fake.element used with empty list"
elements [a]
xs = ([a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!!) (Int -> a) -> FGen Int -> FGen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (Int
0, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)


------------------------------------------------------------------------------
-- | Generates a random subsequence of the given list.
sublistOf :: [a] -> FGen [a]
sublistOf :: [a] -> FGen [a]
sublistOf = (a -> FGen Bool) -> [a] -> FGen [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\a
_ -> (Bool, Bool) -> FGen Bool
forall a. Random a => (a, a) -> FGen a
fromRange (Bool
False, Bool
True))


------------------------------------------------------------------------------
-- | Generates a random permutation of the given list.
shuffle :: [a] -> FGen [a]
shuffle :: [a] -> FGen [a]
shuffle [a]
xs = do
  [Int]
ns <- Int -> FGen Int -> FGen [Int]
forall a. Int -> FGen a -> FGen [a]
vectorOf ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) ((Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (Int
forall a. Bounded a => a
minBound :: Int, Int
forall a. Bounded a => a
maxBound))
  [a] -> FGen [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd (((Int, a) -> (Int, a) -> Ordering) -> [(Int, a)] -> [(Int, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, a) -> Int) -> (Int, a) -> (Int, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, a) -> Int
forall a b. (a, b) -> a
fst) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ns [a]
xs)))


------------------------------------------------------------------------------
-- | Generates a list of random length.
listUpTo :: Int -> FGen a -> FGen [a]
listUpTo :: Int -> FGen a -> FGen [a]
listUpTo Int
n FGen a
gen = do
    Int
k <- (Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (Int
0,Int
n)
    Int -> FGen a -> FGen [a]
forall a. Int -> FGen a -> FGen [a]
vectorOf Int
k FGen a
gen


------------------------------------------------------------------------------
-- | Generates a non-empty list of random length. The maximum length
-- depends on the size parameter.
listUpTo1 :: Int -> FGen a -> FGen [a]
listUpTo1 :: Int -> FGen a -> FGen [a]
listUpTo1 Int
n FGen a
gen = do
    Int
k <- (Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (Int
1,Int
1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
n)
    Int -> FGen a -> FGen [a]
forall a. Int -> FGen a -> FGen [a]
vectorOf Int
k FGen a
gen


------------------------------------------------------------------------------
-- | Generates a list of the given length.
vectorOf :: Int -> FGen a -> FGen [a]
vectorOf :: Int -> FGen a -> FGen [a]
vectorOf = Int -> FGen a -> FGen [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM


------------------------------------------------------------------------------
-- | Generates an infinite list.
infiniteListOf :: FGen a -> FGen [a]
infiniteListOf :: FGen a -> FGen [a]
infiniteListOf FGen a
gen = [FGen a] -> FGen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (FGen a -> [FGen a]
forall a. a -> [a]
repeat FGen a
gen)


------------------------------------------------------------------------------
-- | Generates an ordered list.
orderedList :: (Ord a) => Int -> FGen a -> FGen [a]
orderedList :: Int -> FGen a -> FGen [a]
orderedList Int
n FGen a
gen = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> FGen [a] -> FGen [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> FGen a -> FGen [a]
forall a. Int -> FGen a -> FGen [a]
listUpTo Int
n FGen a
gen


------------------------------------------------------------------------------
-- | Generate a value of an enumeration in the range [from, to].
fakeEnumFromTo :: Enum a => a -> a -> FGen a
fakeEnumFromTo :: a -> a -> FGen a
fakeEnumFromTo a
from a
to =
    Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> FGen Int -> FGen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> FGen Int
forall a. Random a => (a, a) -> FGen a
fromRange (a -> Int
forall a. Enum a => a -> Int
fromEnum a
from, a -> Int
forall a. Enum a => a -> Int
fromEnum a
to)


------------------------------------------------------------------------------
-- | Generate a value of an enumeration in the range [minBound, maxBound].
fakeEnum :: (Enum a, Bounded a) => FGen a
fakeEnum :: FGen a
fakeEnum = a -> a -> FGen a
forall a. Enum a => a -> a -> FGen a
fakeEnumFromTo a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound


------------------------------------------------------------------------------
-- | 'fakeEnumFromTo' specialized to Int.
fakeInt :: Int -> Int -> FGen Int
fakeInt :: Int -> Int -> FGen Int
fakeInt = Int -> Int -> FGen Int
forall a. Enum a => a -> a -> FGen a
fakeEnumFromTo


------------------------------------------------------------------------------
-- | 'fakeEnumFromTo' specialized to Int.
fakeDouble :: Double -> Double -> FGen Double
fakeDouble :: Double -> Double -> FGen Double
fakeDouble Double
a Double
b = (Double, Double) -> FGen Double
forall a. Random a => (a, a) -> FGen a
fromRange (Double
a,Double
b)


------------------------------------------------------------------------------
fakeDigit :: FGen Char
fakeDigit :: FGen Char
fakeDigit = Char -> Char -> FGen Char
forall a. Enum a => a -> a -> FGen a
fakeEnumFromTo Char
'0' Char
'9'


------------------------------------------------------------------------------
fakeDigitNonzero :: FGen Char
fakeDigitNonzero :: FGen Char
fakeDigitNonzero = Char -> Char -> FGen Char
forall a. Enum a => a -> a -> FGen a
fakeEnumFromTo Char
'1' Char
'9'


------------------------------------------------------------------------------
fakeLetter :: FGen Char
fakeLetter :: FGen Char
fakeLetter = Char -> Char -> FGen Char
forall a. Enum a => a -> a -> FGen a
fakeEnumFromTo Char
'a' Char
'z'


------------------------------------------------------------------------------
fakeCapitalLetter :: FGen Char
fakeCapitalLetter :: FGen Char
fakeCapitalLetter = Char -> Char -> FGen Char
forall a. Enum a => a -> a -> FGen a
fakeEnumFromTo Char
'A' Char
'Z'