-- ~\~ language=Haskell filename=src/Test/LessArbitrary.hs
-- ~\~ begin <<less-arbitrary.md|src/Test/LessArbitrary.hs>>[0]
{-# 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

-- ~\~ begin <<less-arbitrary.md|costgen>>[0]
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)
-- ~\~ end

-- Mark a costly constructor with this instead of `<$>`
(<$$$>) :: (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

-- ~\~ begin <<less-arbitrary.md|spend>>[0]
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
-- ~\~ end

-- ~\~ begin <<less-arbitrary.md|budget>>[0]
($$$?) :: 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."
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|budget>>[1]
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 ()
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|budget>>[2]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|budget>>[3]
-- unused: loop breaker message type name
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)))
-- ~\~ end


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

-- ~\~ begin <<less-arbitrary.md|generic-instances>>[0]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-instances>>[1]
type family Cheapness a :: Nat where
  Cheapness (a :*: b)  =
         Cheapness a + Cheapness b
  Cheapness (a :+: b)  =
    Min (Cheapness a) (Cheapness b)
  Cheapness  U1                      = 0
  -- ~\~ begin <<less-arbitrary.md|flat-types>>[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
  -- ~\~ end
  Cheapness (K1 a other) = 1
  Cheapness (C1 a other) = 1
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-instances>>[2]
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
-- ~\~ end

-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[0]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[1]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[2]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[3]
type family SumLen a :: Nat where
  SumLen (a G.:+: b) = SumLen a + SumLen b
  SumLen  a          = 1
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[4]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[5]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[6]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[7]
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))
-- ~\~ end

-- ~\~ begin <<less-arbitrary.md|less-arbitrary-class>>[0]
class LessArbitrary a where
  lessArbitrary :: CostGen a
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|less-arbitrary-class>>[1]
  default lessArbitrary :: (Generic             a
                           ,GLessArbitrary (Rep a))
                        =>  CostGen             a
  lessArbitrary = CostGen a
forall a. (Generic a, GLessArbitrary (Rep a)) => CostGen a
genericLessArbitrary
-- ~\~ end

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

-- ~\~ begin <<less-arbitrary.md|arbitrary-implementation>>[0]
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)
-- ~\~ end

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

-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[0]
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[1]
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)

-- | Choose but only up to the budget (for array and list sizes)
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)

-- | Version of `suchThat` using budget instead of sized generators.
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
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[2]
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"
-- ~\~ end

-- ~\~ end