{-# language DefaultSignatures #-}
{-# language FlexibleInstances #-}
{-# language FlexibleContexts #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language Rank2Types #-}
{-# language PolyKinds #-}
{-# language MultiParamTypeClasses #-}
{-# language MultiWayIf #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeOperators #-}
{-# language TypeFamilies #-}
{-# language TupleSections #-}
{-# language UndecidableInstances #-}
{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
module Test.LessArbitrary(
LessArbitrary(..)
, oneof
, choose
, budgetChoose
, CostGen(..)
, (<$$$>)
, ($$$?)
, currentBudget
, fasterArbitrary
, genericLessArbitrary
, genericLessArbitraryMonoid
, flatLessArbitrary
, spend
, withCost
, elements
, forAll
, sizedCost
) where
import qualified Data.HashMap.Strict as Map
import qualified Data.Set as Set
import qualified Data.Vector as Vector
import qualified Data.Text as Text
import Control.Monad(replicateM)
import Data.Scientific
import Data.Proxy
import qualified Test.QuickCheck.Gen as QC
import qualified Control.Monad.State.Strict as State
import Control.Monad.Trans.Class
import System.Random(Random)
import GHC.Generics as G
import GHC.Generics as Generic
import GHC.TypeLits
import GHC.Stack
import qualified Test.QuickCheck as QC
import Data.Hashable
import Test.LessArbitrary.Cost
newtype CostGen a =
CostGen {
CostGen a -> StateT Cost Gen a
runCostGen :: State.StateT Cost QC.Gen a }
deriving (a -> CostGen b -> CostGen a
(a -> b) -> CostGen a -> CostGen b
(forall a b. (a -> b) -> CostGen a -> CostGen b)
-> (forall a b. a -> CostGen b -> CostGen a) -> Functor CostGen
forall a b. a -> CostGen b -> CostGen a
forall a b. (a -> b) -> CostGen a -> CostGen b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CostGen b -> CostGen a
$c<$ :: forall a b. a -> CostGen b -> CostGen a
fmap :: (a -> b) -> CostGen a -> CostGen b
$cfmap :: forall a b. (a -> b) -> CostGen a -> CostGen b
Functor, Functor CostGen
a -> CostGen a
Functor CostGen
-> (forall a. a -> CostGen a)
-> (forall a b. CostGen (a -> b) -> CostGen a -> CostGen b)
-> (forall a b c.
(a -> b -> c) -> CostGen a -> CostGen b -> CostGen c)
-> (forall a b. CostGen a -> CostGen b -> CostGen b)
-> (forall a b. CostGen a -> CostGen b -> CostGen a)
-> Applicative CostGen
CostGen a -> CostGen b -> CostGen b
CostGen a -> CostGen b -> CostGen a
CostGen (a -> b) -> CostGen a -> CostGen b
(a -> b -> c) -> CostGen a -> CostGen b -> CostGen c
forall a. a -> CostGen a
forall a b. CostGen a -> CostGen b -> CostGen a
forall a b. CostGen a -> CostGen b -> CostGen b
forall a b. CostGen (a -> b) -> CostGen a -> CostGen b
forall a b c. (a -> b -> c) -> CostGen a -> CostGen b -> CostGen c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: CostGen a -> CostGen b -> CostGen a
$c<* :: forall a b. CostGen a -> CostGen b -> CostGen a
*> :: CostGen a -> CostGen b -> CostGen b
$c*> :: forall a b. CostGen a -> CostGen b -> CostGen b
liftA2 :: (a -> b -> c) -> CostGen a -> CostGen b -> CostGen c
$cliftA2 :: forall a b c. (a -> b -> c) -> CostGen a -> CostGen b -> CostGen c
<*> :: CostGen (a -> b) -> CostGen a -> CostGen b
$c<*> :: forall a b. CostGen (a -> b) -> CostGen a -> CostGen b
pure :: a -> CostGen a
$cpure :: forall a. a -> CostGen a
$cp1Applicative :: Functor CostGen
Applicative, Applicative CostGen
a -> CostGen a
Applicative CostGen
-> (forall a b. CostGen a -> (a -> CostGen b) -> CostGen b)
-> (forall a b. CostGen a -> CostGen b -> CostGen b)
-> (forall a. a -> CostGen a)
-> Monad CostGen
CostGen a -> (a -> CostGen b) -> CostGen b
CostGen a -> CostGen b -> CostGen b
forall a. a -> CostGen a
forall a b. CostGen a -> CostGen b -> CostGen b
forall a b. CostGen a -> (a -> CostGen b) -> CostGen b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CostGen a
$creturn :: forall a. a -> CostGen a
>> :: CostGen a -> CostGen b -> CostGen b
$c>> :: forall a b. CostGen a -> CostGen b -> CostGen b
>>= :: CostGen a -> (a -> CostGen b) -> CostGen b
$c>>= :: forall a b. CostGen a -> (a -> CostGen b) -> CostGen b
$cp1Monad :: Applicative CostGen
Monad, Monad CostGen
Monad CostGen
-> (forall a. (a -> CostGen a) -> CostGen a) -> MonadFix CostGen
(a -> CostGen a) -> CostGen a
forall a. (a -> CostGen a) -> CostGen a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> CostGen a) -> CostGen a
$cmfix :: forall a. (a -> CostGen a) -> CostGen a
$cp1MonadFix :: Monad CostGen
State.MonadFix)
(<$$$>) :: (a -> b) -> CostGen a -> CostGen b
a -> b
costlyConstructor <$$$> :: (a -> b) -> CostGen a -> CostGen b
<$$$> CostGen a
arg = do
Cost -> CostGen ()
spend Cost
1
a -> b
costlyConstructor (a -> b) -> CostGen a -> CostGen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen a
arg
spend :: Cost -> CostGen ()
spend :: Cost -> CostGen ()
spend Cost
c = do
StateT Cost Gen () -> CostGen ()
forall a. StateT Cost Gen a -> CostGen a
CostGen (StateT Cost Gen () -> CostGen ())
-> StateT Cost Gen () -> CostGen ()
forall a b. (a -> b) -> a -> b
$ (Cost -> Cost) -> StateT Cost Gen ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (-Cost
cCost -> Cost -> Cost
forall a. Num a => a -> a -> a
+)
CostGen ()
HasCallStack => CostGen ()
checkBudget
($$$?) :: HasCallStack
=> CostGen a
-> CostGen a
-> CostGen a
CostGen a
cheapVariants $$$? :: CostGen a -> CostGen a -> CostGen a
$$$? CostGen a
costlyVariants = do
Cost
budget <- StateT Cost Gen Cost -> CostGen Cost
forall a. StateT Cost Gen a -> CostGen a
CostGen StateT Cost Gen Cost
forall s (m :: * -> *). MonadState s m => m s
State.get
if | Cost
budget Cost -> Cost -> Bool
forall a. Ord a => a -> a -> Bool
> (Cost
0 :: Cost) -> CostGen a
costlyVariants
| Cost
budget Cost -> Cost -> Bool
forall a. Ord a => a -> a -> Bool
> -Cost
10000 -> CostGen a
cheapVariants
| Bool
otherwise -> [Char] -> CostGen a
forall a. HasCallStack => [Char] -> a
error ([Char] -> CostGen a) -> [Char] -> CostGen a
forall a b. (a -> b) -> a -> b
$
[Char]
"Recursive structure with no loop breaker."
checkBudget :: HasCallStack => CostGen ()
checkBudget :: CostGen ()
checkBudget = do
Cost
budget <- StateT Cost Gen Cost -> CostGen Cost
forall a. StateT Cost Gen a -> CostGen a
CostGen StateT Cost Gen Cost
forall s (m :: * -> *). MonadState s m => m s
State.get
if Cost
budget Cost -> Cost -> Bool
forall a. Ord a => a -> a -> Bool
< -Cost
10000
then [Char] -> CostGen ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Recursive structure with no loop breaker."
else () -> CostGen ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
currentBudget :: CostGen Cost
currentBudget :: CostGen Cost
currentBudget = StateT Cost Gen Cost -> CostGen Cost
forall a. StateT Cost Gen a -> CostGen a
CostGen StateT Cost Gen Cost
forall s (m :: * -> *). MonadState s m => m s
State.get
type family ShowType k where
ShowType (D1 ('MetaData name _ _ _) _) = name
ShowType other = "unknown type"
showType :: forall a.
(Generic a
,KnownSymbol (ShowType (Rep a)))
=> String
showType :: [Char]
showType = Proxy (ShowType (Rep a)) -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy (ShowType (Rep a))
forall k (t :: k). Proxy t
Proxy :: Proxy (ShowType (Rep a)))
withCost :: Int -> CostGen a -> QC.Gen a
withCost :: Int -> CostGen a -> Gen a
withCost Int
cost CostGen a
gen = CostGen a -> StateT Cost Gen a
forall a. CostGen a -> StateT Cost Gen a
runCostGen CostGen a
gen
StateT Cost Gen a -> Cost -> Gen a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`State.evalStateT` Int -> Cost
Cost Int
cost
type family Min m n where
Min m n = ChooseSmaller (CmpNat m n) m n
type family ChooseSmaller (o::Ordering)
(m::Nat)
(n::Nat) where
ChooseSmaller 'LT m n = m
ChooseSmaller 'EQ m n = m
ChooseSmaller 'GT m n = n
type family Cheapness a :: Nat where
Cheapness (a :*: b) =
Cheapness a + Cheapness b
Cheapness (a :+: b) =
Min (Cheapness a) (Cheapness b)
Cheapness U1 = 0
Cheapness (S1 a (Rec0 Int )) = 0
Cheapness (S1 a (Rec0 Scientific)) = 0
Cheapness (S1 a (Rec0 Double )) = 0
Cheapness (S1 a (Rec0 Bool )) = 0
Cheapness (S1 a (Rec0 Text.Text )) = 1
Cheapness (S1 a (Rec0 other )) = 1
Cheapness (K1 a other) = 1
Cheapness (C1 a other) = 1
instance GLessArbitrary f
=> GLessArbitrary (G.C1 c f) where
gLessArbitrary :: CostGen (C1 c f p)
gLessArbitrary = f p -> C1 c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (f p -> C1 c f p) -> CostGen (f p) -> CostGen (C1 c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary
cheapest :: CostGen (C1 c f p)
cheapest = f p -> C1 c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (f p -> C1 c f p) -> CostGen (f p) -> CostGen (C1 c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
instance GLessArbitrary f
=> GLessArbitrary (G.S1 c f) where
gLessArbitrary :: CostGen (S1 c f p)
gLessArbitrary = f p -> S1 c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (f p -> S1 c f p) -> CostGen (f p) -> CostGen (S1 c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary
cheapest :: CostGen (S1 c f p)
cheapest = f p -> S1 c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (f p -> S1 c f p) -> CostGen (f p) -> CostGen (S1 c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
genericLessArbitraryMonoid :: (Generic a
,GLessArbitrary (Rep a)
,Monoid a )
=> CostGen a
genericLessArbitraryMonoid :: CostGen a
genericLessArbitraryMonoid =
a -> CostGen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty CostGen a -> CostGen a -> CostGen a
forall a. HasCallStack => CostGen a -> CostGen a -> CostGen a
$$$? CostGen a
forall a. (Generic a, GLessArbitrary (Rep a)) => CostGen a
genericLessArbitrary
class GLessArbitrary datatype where
gLessArbitrary :: CostGen (datatype p)
cheapest :: CostGen (datatype p)
genericLessArbitrary :: (Generic a
,GLessArbitrary (Rep a))
=> CostGen a
genericLessArbitrary :: CostGen a
genericLessArbitrary = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
G.to (Rep a Any -> a) -> CostGen (Rep a Any) -> CostGen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (Rep a Any)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary
instance GLessArbitrary f
=> GLessArbitrary (D1 m f) where
gLessArbitrary :: CostGen (D1 m f p)
gLessArbitrary = do
Cost -> CostGen ()
spend Cost
1
f p -> D1 m f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> D1 m f p) -> CostGen (f p) -> CostGen (D1 m f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest CostGen (f p) -> CostGen (f p) -> CostGen (f p)
forall a. HasCallStack => CostGen a -> CostGen a -> CostGen a
$$$? CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary)
cheapest :: CostGen (D1 m f p)
cheapest = f p -> D1 m f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> D1 m f p) -> CostGen (f p) -> CostGen (D1 m f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (f p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
type family SumLen a :: Nat where
SumLen (a G.:+: b) = SumLen a + SumLen b
SumLen a = 1
instance GLessArbitrary G.U1 where
gLessArbitrary :: CostGen (U1 p)
gLessArbitrary = U1 p -> CostGen (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
G.U1
cheapest :: CostGen (U1 p)
cheapest = U1 p -> CostGen (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
G.U1
instance (GLessArbitrary a
,GLessArbitrary b)
=> GLessArbitrary (a G.:*: b) where
gLessArbitrary :: CostGen ((:*:) a b p)
gLessArbitrary = a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(G.:*:) (a p -> b p -> (:*:) a b p)
-> CostGen (a p) -> CostGen (b p -> (:*:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (a p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary
CostGen (b p -> (:*:) a b p)
-> CostGen (b p) -> CostGen ((:*:) a b p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CostGen (b p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary
cheapest :: CostGen ((:*:) a b p)
cheapest = a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(G.:*:) (a p -> b p -> (:*:) a b p)
-> CostGen (a p) -> CostGen (b p -> (:*:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (a p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
CostGen (b p -> (:*:) a b p)
-> CostGen (b p) -> CostGen ((:*:) a b p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CostGen (b p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
instance LessArbitrary c
=> GLessArbitrary (G.K1 i c) where
gLessArbitrary :: CostGen (K1 i c p)
gLessArbitrary = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
G.K1 (c -> K1 i c p) -> CostGen c -> CostGen (K1 i c p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen c
forall a. LessArbitrary a => CostGen a
lessArbitrary
cheapest :: CostGen (K1 i c p)
cheapest = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
G.K1 (c -> K1 i c p) -> CostGen c -> CostGen (K1 i c p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen c
forall a. LessArbitrary a => CostGen a
lessArbitrary
instance (GLessArbitrary a
,GLessArbitrary b
,KnownNat (SumLen a)
,KnownNat (SumLen b)
,KnownNat (Cheapness a)
,KnownNat (Cheapness b)
)
=> GLessArbitrary (a Generic.:+: b) where
gLessArbitrary :: CostGen ((:+:) a b p)
gLessArbitrary =
[(Int, CostGen ((:+:) a b p))] -> CostGen ((:+:) a b p)
forall a. HasCallStack => [(Int, CostGen a)] -> CostGen a
frequency
[ (Int
lfreq, a p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a p -> (:+:) a b p) -> CostGen (a p) -> CostGen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (a p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary)
, (Int
rfreq, b p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b p -> (:+:) a b p) -> CostGen (b p) -> CostGen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (b p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
gLessArbitrary) ]
where
lfreq :: Int
lfreq = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (SumLen a) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SumLen a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SumLen a))
rfreq :: Int
rfreq = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (SumLen b) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SumLen b)
forall k (t :: k). Proxy t
Proxy :: Proxy (SumLen b))
cheapest :: CostGen ((:+:) a b p)
cheapest =
if Int
lcheap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rcheap
then a p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a p -> (:+:) a b p) -> CostGen (a p) -> CostGen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (a p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
else b p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b p -> (:+:) a b p) -> CostGen (b p) -> CostGen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen (b p)
forall k (datatype :: k -> *) (p :: k).
GLessArbitrary datatype =>
CostGen (datatype p)
cheapest
where
lcheap, rcheap :: Int
lcheap :: Int
lcheap = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (Cheapness a) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (Cheapness a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Cheapness a))
rcheap :: Int
rcheap = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (Cheapness b) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (Cheapness b)
forall k (t :: k). Proxy t
Proxy :: Proxy (Cheapness b))
class LessArbitrary a where
lessArbitrary :: CostGen a
default lessArbitrary :: (Generic a
,GLessArbitrary (Rep a))
=> CostGen a
lessArbitrary = CostGen a
forall a. (Generic a, GLessArbitrary (Rep a)) => CostGen a
genericLessArbitrary
instance LessArbitrary Bool where
lessArbitrary :: CostGen Bool
lessArbitrary = CostGen Bool
forall a. Arbitrary a => CostGen a
flatLessArbitrary
instance LessArbitrary Int where
lessArbitrary :: CostGen Int
lessArbitrary = CostGen Int
forall a. Arbitrary a => CostGen a
flatLessArbitrary
instance LessArbitrary Integer where
lessArbitrary :: CostGen Integer
lessArbitrary = CostGen Integer
forall a. Arbitrary a => CostGen a
flatLessArbitrary
instance LessArbitrary Double where
lessArbitrary :: CostGen Double
lessArbitrary = CostGen Double
forall a. Arbitrary a => CostGen a
flatLessArbitrary
instance LessArbitrary Char where
lessArbitrary :: CostGen Char
lessArbitrary = CostGen Char
forall a. Arbitrary a => CostGen a
flatLessArbitrary
instance (LessArbitrary k
,LessArbitrary v)
=> LessArbitrary (k,v) where
instance (LessArbitrary k
,Ord k)
=> LessArbitrary (Set.Set k) where
lessArbitrary :: CostGen (Set k)
lessArbitrary = [k] -> Set k
forall a. Ord a => [a] -> Set a
Set.fromList ([k] -> Set k) -> CostGen [k] -> CostGen (Set k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen [k]
forall a. LessArbitrary a => CostGen a
lessArbitrary
instance (LessArbitrary k
,Eq k
,Ord k
,Hashable k
,LessArbitrary v)
=> LessArbitrary (Map.HashMap k v) where
lessArbitrary :: CostGen (HashMap k v)
lessArbitrary = [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList
([(k, v)] -> HashMap k v)
-> CostGen [(k, v)] -> CostGen (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen [(k, v)]
forall a. LessArbitrary a => CostGen a
lessArbitrary
instance LessArbitrary Scientific where
lessArbitrary :: CostGen Scientific
lessArbitrary =
Integer -> Int -> Scientific
scientific (Integer -> Int -> Scientific)
-> CostGen Integer -> CostGen (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen Integer
forall a. LessArbitrary a => CostGen a
lessArbitrary
CostGen (Int -> Scientific) -> CostGen Int -> CostGen Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CostGen Int
forall a. LessArbitrary a => CostGen a
lessArbitrary
fasterArbitrary :: LessArbitrary a => QC.Gen a
fasterArbitrary :: Gen a
fasterArbitrary = CostGen a -> Gen a
forall a. CostGen a -> Gen a
sizedCost CostGen a
forall a. LessArbitrary a => CostGen a
lessArbitrary
sizedCost :: CostGen a -> QC.Gen a
sizedCost :: CostGen a -> Gen a
sizedCost CostGen a
gen = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
QC.sized (Int -> CostGen a -> Gen a
forall a. Int -> CostGen a -> Gen a
`withCost` CostGen a
gen)
flatLessArbitrary :: QC.Arbitrary a
=> CostGen a
flatLessArbitrary :: CostGen a
flatLessArbitrary = StateT Cost Gen a -> CostGen a
forall a. StateT Cost Gen a -> CostGen a
CostGen (StateT Cost Gen a -> CostGen a) -> StateT Cost Gen a -> CostGen a
forall a b. (a -> b) -> a -> b
$ Gen a -> StateT Cost Gen a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary
instance LessArbitrary a
=> LessArbitrary (Vector.Vector a) where
lessArbitrary :: CostGen (Vector a)
lessArbitrary = [a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList ([a] -> Vector a) -> CostGen [a] -> CostGen (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen [a]
forall a. LessArbitrary a => CostGen a
lessArbitrary
instance LessArbitrary a
=> LessArbitrary [a] where
lessArbitrary :: CostGen [a]
lessArbitrary = [a] -> CostGen [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] CostGen [a] -> CostGen [a] -> CostGen [a]
forall a. HasCallStack => CostGen a -> CostGen a -> CostGen a
$$$? do
Cost
budget <- CostGen Cost
currentBudget
Int
len <- (Int, Int) -> CostGen Int
forall a. Random a => (a, a) -> CostGen a
choose (Int
1,Cost -> Int
forall a. Enum a => a -> Int
fromEnum Cost
budget)
Cost -> CostGen ()
spend (Cost -> CostGen ()) -> Cost -> CostGen ()
forall a b. (a -> b) -> a -> b
$ Int -> Cost
Cost Int
len
Int -> CostGen a -> CostGen [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len CostGen a
forall a. LessArbitrary a => CostGen a
lessArbitrary
instance QC.Testable a
=> QC.Testable (CostGen a) where
property :: CostGen a -> Property
property = Gen a -> Property
forall prop. Testable prop => prop -> Property
QC.property
(Gen a -> Property)
-> (CostGen a -> Gen a) -> CostGen a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostGen a -> Gen a
forall a. CostGen a -> Gen a
sizedCost
forAll :: CostGen a -> (a -> CostGen b) -> CostGen b
forAll :: CostGen a -> (a -> CostGen b) -> CostGen b
forAll CostGen a
gen a -> CostGen b
prop = CostGen a
gen CostGen a -> (a -> CostGen b) -> CostGen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CostGen b
prop
oneof :: HasCallStack
=> [CostGen a] -> CostGen a
oneof :: [CostGen a] -> CostGen a
oneof [] = [Char] -> CostGen a
forall a. HasCallStack => [Char] -> a
error
[Char]
"LessArbitrary.oneof used with empty list"
oneof [CostGen a]
gs = (Int, Int) -> CostGen Int
forall a. Random a => (a, a) -> CostGen a
choose (Int
0,[CostGen a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CostGen a]
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) CostGen Int -> (Int -> CostGen a) -> CostGen a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([CostGen a]
gs [CostGen a] -> Int -> CostGen a
forall a. [a] -> Int -> a
!!)
elements :: [a] -> CostGen a
elements :: [a] -> CostGen a
elements [a]
gs = ([a]
gs[a] -> Int -> a
forall a. [a] -> Int -> a
!!) (Int -> a) -> CostGen Int -> CostGen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> CostGen Int
forall a. Random a => (a, a) -> CostGen a
choose (Int
0,[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
choose :: Random a
=> (a, a)
-> CostGen a
choose :: (a, a) -> CostGen a
choose (a
a,a
b) = StateT Cost Gen a -> CostGen a
forall a. StateT Cost Gen a -> CostGen a
CostGen (StateT Cost Gen a -> CostGen a) -> StateT Cost Gen a -> CostGen a
forall a b. (a -> b) -> a -> b
$ Gen a -> StateT Cost Gen a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen a -> StateT Cost Gen a) -> Gen a -> StateT Cost Gen a
forall a b. (a -> b) -> a -> b
$ (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
QC.choose (a
a, a
b)
budgetChoose :: CostGen Int
budgetChoose :: CostGen Int
budgetChoose = do
Cost Int
b <- CostGen Cost
currentBudget
StateT Cost Gen Int -> CostGen Int
forall a. StateT Cost Gen a -> CostGen a
CostGen (StateT Cost Gen Int -> CostGen Int)
-> StateT Cost Gen Int -> CostGen Int
forall a b. (a -> b) -> a -> b
$ Gen Int -> StateT Cost Gen Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Int -> StateT Cost Gen Int) -> Gen Int -> StateT Cost Gen Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int
b)
CostGen b
cg suchThat :: CostGen b -> (b -> Bool) -> CostGen b
`suchThat` b -> Bool
pred = do
b
result <- CostGen b
cg
if b -> Bool
pred b
result
then b -> CostGen b
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
else do
Cost -> CostGen ()
spend Cost
1
CostGen b
cg CostGen b -> (b -> Bool) -> CostGen b
`suchThat` b -> Bool
pred
frequency :: HasCallStack
=> [(Int, CostGen a)] -> CostGen a
frequency :: [(Int, CostGen a)] -> CostGen a
frequency [] =
[Char] -> CostGen a
forall a. HasCallStack => [Char] -> a
error ([Char] -> CostGen a) -> [Char] -> CostGen a
forall a b. (a -> b) -> a -> b
$ [Char]
"LessArbitrary.frequency "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"used with empty list"
frequency [(Int, CostGen a)]
xs
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (((Int, CostGen a) -> Int) -> [(Int, CostGen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, CostGen a) -> Int
forall a b. (a, b) -> a
fst [(Int, CostGen a)]
xs) =
[Char] -> CostGen a
forall a. HasCallStack => [Char] -> a
error ([Char] -> CostGen a) -> [Char] -> CostGen a
forall a b. (a -> b) -> a -> b
$ [Char]
"LessArbitrary.frequency: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"negative weight"
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (((Int, CostGen a) -> Int) -> [(Int, CostGen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, CostGen a) -> Int
forall a b. (a, b) -> a
fst [(Int, CostGen a)]
xs) =
[Char] -> CostGen a
forall a. HasCallStack => [Char] -> a
error ([Char] -> CostGen a) -> [Char] -> CostGen a
forall a b. (a -> b) -> a -> b
$ [Char]
"LessArbitrary.frequency: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"all weights were zero"
frequency [(Int, CostGen a)]
xs0 = (Int, Int) -> CostGen Int
forall a. Random a => (a, a) -> CostGen a
choose (Int
1, Int
tot) CostGen Int -> (Int -> CostGen a) -> CostGen a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> [(Int, CostGen a)] -> CostGen a
forall t p. (Ord t, Num t) => t -> [(t, p)] -> p
`pick` [(Int, CostGen a)]
xs0)
where
tot :: Int
tot = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, CostGen a) -> Int) -> [(Int, CostGen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, CostGen a) -> Int
forall a b. (a, b) -> a
fst [(Int, CostGen 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]
"LessArbitrary.pick used with empty list"