-- ~\~ 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 InstanceSigs               #-}
{-# 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
  , StartingState(..)
  ) 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.Arrow (first, second)
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|starting-state>>[0]
class StartingState s where
  startingState :: s

instance StartingState () where
  startingState :: ()
startingState = ()
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|costgen>>[0]
newtype CostGen s a =
        CostGen {
          forall s a. CostGen s a -> StateT (Cost, s) Gen a
runCostGen :: State.StateT (Cost, s) QC.Gen a
        }
  deriving (forall a b. a -> CostGen s b -> CostGen s a
forall a b. (a -> b) -> CostGen s a -> CostGen s b
forall s a b. a -> CostGen s b -> CostGen s a
forall s a b. (a -> b) -> CostGen s a -> CostGen s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CostGen s b -> CostGen s a
$c<$ :: forall s a b. a -> CostGen s b -> CostGen s a
fmap :: forall a b. (a -> b) -> CostGen s a -> CostGen s b
$cfmap :: forall s a b. (a -> b) -> CostGen s a -> CostGen s b
Functor, forall s. Functor (CostGen s)
forall a. a -> CostGen s a
forall s a. a -> CostGen s a
forall a b. CostGen s a -> CostGen s b -> CostGen s a
forall a b. CostGen s a -> CostGen s b -> CostGen s b
forall a b. CostGen s (a -> b) -> CostGen s a -> CostGen s b
forall s a b. CostGen s a -> CostGen s b -> CostGen s a
forall s a b. CostGen s a -> CostGen s b -> CostGen s b
forall s a b. CostGen s (a -> b) -> CostGen s a -> CostGen s b
forall a b c.
(a -> b -> c) -> CostGen s a -> CostGen s b -> CostGen s c
forall s a b c.
(a -> b -> c) -> CostGen s a -> CostGen s b -> CostGen s 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
<* :: forall a b. CostGen s a -> CostGen s b -> CostGen s a
$c<* :: forall s a b. CostGen s a -> CostGen s b -> CostGen s a
*> :: forall a b. CostGen s a -> CostGen s b -> CostGen s b
$c*> :: forall s a b. CostGen s a -> CostGen s b -> CostGen s b
liftA2 :: forall a b c.
(a -> b -> c) -> CostGen s a -> CostGen s b -> CostGen s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> CostGen s a -> CostGen s b -> CostGen s c
<*> :: forall a b. CostGen s (a -> b) -> CostGen s a -> CostGen s b
$c<*> :: forall s a b. CostGen s (a -> b) -> CostGen s a -> CostGen s b
pure :: forall a. a -> CostGen s a
$cpure :: forall s a. a -> CostGen s a
Applicative, forall s. Applicative (CostGen s)
forall a. a -> CostGen s a
forall s a. a -> CostGen s a
forall a b. CostGen s a -> CostGen s b -> CostGen s b
forall a b. CostGen s a -> (a -> CostGen s b) -> CostGen s b
forall s a b. CostGen s a -> CostGen s b -> CostGen s b
forall s a b. CostGen s a -> (a -> CostGen s b) -> CostGen s 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 :: forall a. a -> CostGen s a
$creturn :: forall s a. a -> CostGen s a
>> :: forall a b. CostGen s a -> CostGen s b -> CostGen s b
$c>> :: forall s a b. CostGen s a -> CostGen s b -> CostGen s b
>>= :: forall a b. CostGen s a -> (a -> CostGen s b) -> CostGen s b
$c>>= :: forall s a b. CostGen s a -> (a -> CostGen s b) -> CostGen s b
Monad, forall s. Monad (CostGen s)
forall a. (a -> CostGen s a) -> CostGen s a
forall s a. (a -> CostGen s a) -> CostGen s a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> CostGen s a) -> CostGen s a
$cmfix :: forall s a. (a -> CostGen s a) -> CostGen s a
State.MonadFix)

instance State.MonadState        s  (CostGen s) where
  state :: forall s a.
           (s -> (a, s)) -> CostGen s a
  state :: forall s a. (s -> (a, s)) -> CostGen s a
state s -> (a, s)
nestedMod = forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (Cost, s) -> (a, (Cost, s))
mod
    where
      mod :: (Cost, s) -> (a, (Cost, s))
      mod :: (Cost, s) -> (a, (Cost, s))
mod (Cost
aCost, s
aState) = (a
result, (Cost
aCost, s
newState))
        where
          (a
result, s
newState) = s -> (a, s)
nestedMod s
aState
-- ~\~ end

-- Mark a costly constructor with this instead of `<$>`
(<$$$>) :: (a -> b) -> CostGen s a -> CostGen s b
a -> b
costlyConstructor <$$$> :: forall a b s. (a -> b) -> CostGen s a -> CostGen s b
<$$$> CostGen s a
arg = do
  forall s. Cost -> CostGen s ()
spend Cost
1
  a -> b
costlyConstructor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostGen s a
arg

-- ~\~ begin <<less-arbitrary.md|spend>>[0]
spend :: Cost -> CostGen s ()
spend :: forall s. Cost -> CostGen s ()
spend Cost
c = do
  forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (-Cost
cforall a. Num a => a -> a -> a
+))
  forall s. HasCallStack => CostGen s ()
checkBudget
-- ~\~ end

-- ~\~ begin <<less-arbitrary.md|budget>>[0]
($$$?) :: HasCallStack
       => CostGen s a
       -> CostGen s a
       -> CostGen s a
CostGen s a
cheapVariants $$$? :: forall s a.
HasCallStack =>
CostGen s a -> CostGen s a -> CostGen s a
$$$? CostGen s a
costlyVariants = do
  Cost
budget <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall s (m :: * -> *). MonadState s m => m s
State.get
  if | Cost
budget forall a. Ord a => a -> a -> Bool
> (Cost
0 :: Cost) -> CostGen s a
costlyVariants
     | Cost
budget forall a. Ord a => a -> a -> Bool
> -Cost
10000      -> CostGen s a
cheapVariants
     | Bool
otherwise            -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
       [Char]
"Recursive structure with no loop breaker."
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|budget>>[1]
checkBudget :: HasCallStack => CostGen s ()
checkBudget :: forall s. HasCallStack => CostGen s ()
checkBudget = do
  Cost
budget <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall s (m :: * -> *). MonadState s m => m s
State.get
  if Cost
budget forall a. Ord a => a -> a -> Bool
< -Cost
10000
    then forall a. HasCallStack => [Char] -> a
error [Char]
"Recursive structure with no loop breaker."
    else forall (m :: * -> *) a. Monad m => a -> m a
return ()
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|budget>>[2]
currentBudget :: CostGen s Cost
currentBudget :: forall s. CostGen s Cost
currentBudget = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall s (m :: * -> *). MonadState s m => m s
State.get
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|budget>>[3]
-- unused: loop breaker message type name
-- FIXME: use to make nicer error message
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 :: forall a. (Generic a, KnownSymbol (ShowType (Rep a))) => [Char]
showType  = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShowType (Rep a)))
-- ~\~ end


withCost :: forall        s a.
            StartingState s
         => Int
         -> CostGen       s a
         -> QC.Gen          a
withCost :: forall s a. StartingState s => Int -> CostGen s a -> Gen a
withCost Int
cost CostGen s a
gen = forall s a. Int -> s -> CostGen s a -> Gen a
withCostAndState Int
cost forall s. StartingState s => s
startingState CostGen s a
gen

withCostAndState :: Int -> s -> CostGen s a -> QC.Gen a
withCostAndState :: forall s a. Int -> s -> CostGen s a -> Gen a
withCostAndState Int
cost s
state CostGen s a
gen = forall s a. CostGen s a -> StateT (Cost, s) Gen a
runCostGen CostGen s a
gen
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`State.evalStateT` (Int -> Cost
Cost Int
cost, s
state)

-- ~\~ 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 s         f
      => GLessArbitrary s (G.C1 c f) where
  gLessArbitrary :: forall (p :: k). CostGen s (C1 c f p)
gLessArbitrary = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary
  cheapest :: forall (p :: k). CostGen s (C1 c f p)
cheapest       = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest

instance GLessArbitrary s         f
      => GLessArbitrary s (G.S1 c f) where
  gLessArbitrary :: forall (p :: k). CostGen s (S1 c f p)
gLessArbitrary = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary
  cheapest :: forall (p :: k). CostGen s (S1 c f p)
cheapest       = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest
-- ~\~ end

-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[0]
genericLessArbitraryMonoid :: (Generic               a
                              ,GLessArbitrary s (Rep a)
                              ,Monoid                a )
                           =>  CostGen        s      a
genericLessArbitraryMonoid :: forall a s.
(Generic a, GLessArbitrary s (Rep a), Monoid a) =>
CostGen s a
genericLessArbitraryMonoid  =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty forall s a.
HasCallStack =>
CostGen s a -> CostGen s a -> CostGen s a
$$$? forall a s. (Generic a, GLessArbitrary s (Rep a)) => CostGen s a
genericLessArbitrary
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[1]
class GLessArbitrary s datatype where
  gLessArbitrary :: CostGen s (datatype p)
  cheapest       :: CostGen s (datatype p)

genericLessArbitrary :: (Generic               a
                        ,GLessArbitrary s (Rep a))
                     =>  CostGen        s      a
genericLessArbitrary :: forall a s. (Generic a, GLessArbitrary s (Rep a)) => CostGen s a
genericLessArbitrary = forall a x. Generic a => Rep a x -> a
G.to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[2]
instance GLessArbitrary s       f
      => GLessArbitrary s (D1 m f) where 
  gLessArbitrary :: forall (p :: k). CostGen s (D1 m f p)
gLessArbitrary = do
    forall s. Cost -> CostGen s ()
spend Cost
1
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest forall s a.
HasCallStack =>
CostGen s a -> CostGen s a -> CostGen s a
$$$? forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary)
  cheapest :: forall (p :: k). CostGen s (D1 m f p)
cheapest = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (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 s G.U1 where
  gLessArbitrary :: forall (p :: k). CostGen s (U1 p)
gLessArbitrary = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
G.U1
  cheapest :: forall (p :: k). CostGen s (U1 p)
cheapest       = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
G.U1
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[5]
instance (GLessArbitrary  s  a
         ,GLessArbitrary  s          b)
      =>  GLessArbitrary  s (a G.:*: b) where
  gLessArbitrary :: forall (p :: k). CostGen s ((:*:) a b p)
gLessArbitrary = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(G.:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary
  cheapest :: forall (p :: k). CostGen s ((:*:) a b p)
cheapest       = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(G.:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[6]
instance  LessArbitrary s         c
      => GLessArbitrary s (G.K1 i c) where
  gLessArbitrary :: forall (p :: k). CostGen s (K1 i c p)
gLessArbitrary = forall k i c (p :: k). c -> K1 i c p
G.K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary
  cheapest :: forall (p :: k). CostGen s (K1 i c p)
cheapest       = forall k i c (p :: k). c -> K1 i c p
G.K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[7]
instance (GLessArbitrary s    a
         ,GLessArbitrary s                  b
         ,KnownNat (SumLen    a)
         ,KnownNat (SumLen                  b)
         ,KnownNat (Cheapness a)
         ,KnownNat (Cheapness               b)
         )
      => GLessArbitrary  s   (a Generic.:+: b) where
  gLessArbitrary :: forall (p :: k). CostGen s ((:+:) a b p)
gLessArbitrary =
    forall s a. HasCallStack => [(Int, CostGen s a)] -> CostGen s a
frequency
      [ (Int
lfreq, forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary)
      , (Int
rfreq, forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
gLessArbitrary) ]
    where
      lfreq :: Int
lfreq = forall a b. (Integral a, Num b) => a -> b
fromIntegral
            forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SumLen a))
      rfreq :: Int
rfreq = forall a b. (Integral a, Num b) => a -> b
fromIntegral
            forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SumLen b))
  cheapest :: forall (p :: k). CostGen s ((:+:) a b p)
cheapest =
      if Int
lcheap forall a. Ord a => a -> a -> Bool
<= Int
rcheap
         then forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest
         else forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} s (datatype :: k -> *) (p :: k).
GLessArbitrary s datatype =>
CostGen s (datatype p)
cheapest
    where
      lcheap, rcheap :: Int
      lcheap :: Int
lcheap = forall a b. (Integral a, Num b) => a -> b
fromIntegral
             forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Cheapness a))
      rcheap :: Int
rcheap = forall a b. (Integral a, Num b) => a -> b
fromIntegral
             forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Cheapness b))
-- ~\~ end

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

instance StartingState s
      => LessArbitrary s Bool where
  lessArbitrary :: CostGen s Bool
lessArbitrary = forall a s. Arbitrary a => CostGen s a
flatLessArbitrary

instance StartingState s
      => LessArbitrary s Int where
  lessArbitrary :: CostGen s Int
lessArbitrary = forall a s. Arbitrary a => CostGen s a
flatLessArbitrary

instance StartingState s
      => LessArbitrary s Integer where
  lessArbitrary :: CostGen s Integer
lessArbitrary = forall a s. Arbitrary a => CostGen s a
flatLessArbitrary

instance StartingState s
      => LessArbitrary s Double where
  lessArbitrary :: CostGen s Double
lessArbitrary = forall a s. Arbitrary a => CostGen s a
flatLessArbitrary

instance StartingState s
      => LessArbitrary s Char where
  lessArbitrary :: CostGen s Char
lessArbitrary = forall a s. Arbitrary a => CostGen s a
flatLessArbitrary

instance (LessArbitrary s  k
         ,LessArbitrary s    v)
      =>  LessArbitrary s (k,v) where

instance (LessArbitrary s          k
         ,Ord                      k)
      =>  LessArbitrary s (Set.Set k) where
  lessArbitrary :: CostGen s (Set k)
lessArbitrary = forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary

instance (LessArbitrary s              k
         ,Eq                           k
         ,Ord                          k
         ,Hashable                     k 
         ,LessArbitrary s                v)
      =>  LessArbitrary s (Map.HashMap k v) where
  lessArbitrary :: CostGen s (HashMap k v)
lessArbitrary =  forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList
               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary

instance StartingState s
      => LessArbitrary  s Scientific where
  lessArbitrary :: CostGen s Scientific
lessArbitrary =
    Integer -> Int -> Scientific
scientific forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary

-- ~\~ begin <<less-arbitrary.md|arbitrary-implementation>>[0]
fasterArbitrary :: forall        s a.
                   LessArbitrary s a
                => QC.Gen          a
fasterArbitrary :: forall s a. LessArbitrary s a => Gen a
fasterArbitrary  = (forall s a. LessArbitrary s a => CostGen s a -> Gen a
sizedCost :: CostGen s a -> QC.Gen a) (forall s a. LessArbitrary s a => CostGen s a
lessArbitrary :: CostGen s a)

sizedCost :: LessArbitrary s a
          => CostGen       s a
          -> QC.Gen          a
sizedCost :: forall s a. LessArbitrary s a => CostGen s a -> Gen a
sizedCost CostGen s a
gen = forall a. (Int -> Gen a) -> Gen a
QC.sized (forall s a. StartingState s => Int -> CostGen s a -> Gen a
`withCost` CostGen s a
gen)
-- ~\~ end

flatLessArbitrary :: QC.Arbitrary a
                  => CostGen    s a
flatLessArbitrary :: forall a s. Arbitrary a => CostGen s a
flatLessArbitrary  = forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Arbitrary a => Gen a
QC.arbitrary

instance LessArbitrary s                a
      => LessArbitrary s (Vector.Vector a) where
  lessArbitrary :: CostGen s (Vector a)
lessArbitrary = forall a. [a] -> Vector a
Vector.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. LessArbitrary s a => CostGen s a
lessArbitrary

-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[0]
instance LessArbitrary s  a
      => LessArbitrary s [a] where
  lessArbitrary :: CostGen s [a]
lessArbitrary = forall (f :: * -> *) a. Applicative f => a -> f a
pure [] forall s a.
HasCallStack =>
CostGen s a -> CostGen s a -> CostGen s a
$$$? do
    Cost
budget <- forall s. CostGen s Cost
currentBudget
    Int
len  <- forall a s. Random a => (a, a) -> CostGen s a
choose (Int
1,forall a. Enum a => a -> Int
fromEnum Cost
budget)
    forall s. Cost -> CostGen s ()
spend forall a b. (a -> b) -> a -> b
$ Int -> Cost
Cost Int
len
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM   Int
len forall s a. LessArbitrary s a => CostGen s a
lessArbitrary

instance (QC.Testable            a
         ,LessArbitrary        s a)
      =>  QC.Testable (CostGen s a) where
  property :: CostGen s a -> Property
property = forall prop. Testable prop => prop -> Property
QC.property
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. LessArbitrary s a => CostGen s a -> Gen a
sizedCost
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[1]
forAll :: CostGen s a -> (a -> CostGen s b) -> CostGen s b
forAll :: forall s a b. CostGen s a -> (a -> CostGen s b) -> CostGen s b
forAll CostGen s a
gen a -> CostGen s b
prop = CostGen s a
gen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CostGen s b
prop

oneof   :: HasCallStack
        => [CostGen s a] -> CostGen s a
oneof :: forall s a. HasCallStack => [CostGen s a] -> CostGen s a
oneof [] = forall a. HasCallStack => [Char] -> a
error
           [Char]
"LessArbitrary.oneof used with empty list"
oneof [CostGen s a]
gs = forall a s. Random a => (a, a) -> CostGen s a
choose (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [CostGen s a]
gs forall a. Num a => a -> a -> a
- Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([CostGen s a]
gs forall a. [a] -> Int -> a
!!)

elements :: [a] -> CostGen s a
elements :: forall a s. [a] -> CostGen s a
elements [a]
gs = ([a]
gsforall a. [a] -> Int -> a
!!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. Random a => (a, a) -> CostGen s a
choose (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
gs forall a. Num a => a -> a -> a
- Int
1)

choose      :: Random  a
            =>        (a, a)
            -> CostGen s a
choose :: forall a s. Random a => (a, a) -> CostGen s a
choose (a
a,a
b) = forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 s Int
budgetChoose :: forall s. CostGen s Int
budgetChoose  = do
  Cost Int
b <- forall s. CostGen s Cost
currentBudget
  forall s a. StateT (Cost, s) Gen a -> CostGen s a
CostGen forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int
b)

-- | Version of `suchThat` using budget instead of sized generators.
CostGen s b
cg suchThat :: CostGen s b -> (b -> Bool) -> CostGen s b
`suchThat` b -> Bool
pred = do
  b
result <- CostGen s b
cg
  if b -> Bool
pred b
result
     then forall (m :: * -> *) a. Monad m => a -> m a
return b
result
     else do
       forall s. Cost -> CostGen s ()
spend Cost
1
       CostGen s b
cg CostGen s b -> (b -> Bool) -> CostGen s b
`suchThat` b -> Bool
pred
-- ~\~ end
-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[2]
frequency   :: HasCallStack
            => [(Int, CostGen s a)]
            ->        CostGen s a
frequency :: forall s a. HasCallStack => [(Int, CostGen s a)] -> CostGen s a
frequency [] =
  forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"LessArbitrary.frequency "
       forall a. [a] -> [a] -> [a]
++ [Char]
"used with empty list"
frequency [(Int, CostGen s a)]
xs
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
< Int
0) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, CostGen s a)]
xs) =
    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"LessArbitrary.frequency: "
         forall a. [a] -> [a] -> [a]
++ [Char]
"negative weight"
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Int
0) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, CostGen s a)]
xs) =
    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"LessArbitrary.frequency: "
         forall a. [a] -> [a] -> [a]
++ [Char]
"all weights were zero"
frequency [(Int, CostGen s a)]
xs0 = forall a s. Random a => (a, a) -> CostGen s a
choose (Int
1, Int
tot) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall {t} {b}. (Ord t, Num t) => t -> [(t, b)] -> b
`pick` [(Int, CostGen s a)]
xs0)
 where
  tot :: Int
tot = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, CostGen s a)]
xs0)

  pick :: t -> [(t, b)] -> b
pick t
n ((t
k,b
x):[(t, b)]
xs)
    | t
n forall a. Ord a => a -> a -> Bool
<= t
k    = b
x
    | Bool
otherwise = t -> [(t, b)] -> b
pick (t
nforall a. Num a => a -> a -> a
-t
k) [(t, b)]
xs
  pick t
_ [(t, b)]
_  = forall a. HasCallStack => [Char] -> a
error
    [Char]
"LessArbitrary.pick used with empty list"
-- ~\~ end

-- ~\~ end