{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} -- MonadBase
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE DerivingVia #-}
#endif

module Hedgehog.Internal.Gen (
  -- * Transformer
    Gen
  , GenT(..)
  , MonadGen(..)

  -- * Combinators
  , generalize

  -- ** Shrinking
  , shrink
  , prune

  -- ** Size
  , small
  , scale
  , resize
  , sized

  -- ** Integral
  , integral
  , integral_

  , int
  , int8
  , int16
  , int32
  , int64

  , word
  , word8
  , word16
  , word32
  , word64

  -- ** Floating-point
  , realFloat
  , realFrac_
  , float
  , double

  -- ** Enumeration
  , enum
  , enumBounded
  , bool
  , bool_

  -- ** Characters
  , binit
  , octit
  , digit
  , hexit
  , lower
  , upper
  , alpha
  , alphaNum
  , ascii
  , latin1
  , unicode
  , unicodeAll

  -- ** Strings
  , string
  , text
  , utf8
  , bytes

  -- ** Choice
  , constant
  , element
  , element_
  , choice
  , frequency
  , recursive

  -- ** Conditional
  , discard
  , ensure
  , filter
  , mapMaybe
  , filterT
  , mapMaybeT
  , just
  , justT

  -- ** Collections
  , maybe
  , either
  , either_
  , list
  , seq
  , nonEmpty
  , set
  , map

  -- ** Subterms
  , freeze
  , subterm
  , subtermM
  , subterm2
  , subtermM2
  , subterm3
  , subtermM3

  -- ** Combinations & Permutations
  , subsequence
  , subset
  , shuffle
  , shuffleSeq

  -- * Sampling Generators
  , sample
  , print
  , printTree
  , printWith
  , printTreeWith
  , renderTree

  -- * Internal
  -- $internal

  -- ** Transfomer
  , runGenT
  , evalGen
  , evalGenT
  , mapGenT
  , generate
  , toTree
  , toTreeMaybeT
  , fromTree
  , fromTreeT
  , fromTreeMaybeT
  , runDiscardEffect
  , runDiscardEffectT

  -- ** Size
  , golden

  -- ** Shrinking
  , atLeast

  -- ** Characters
  , isSurrogate
  , isNoncharacter

  -- ** Subterms
  , Vec(..)
  , Nat(..)
  , subtermMVec
  ) where

import           Control.Applicative (Alternative(..),liftA2)
import           Control.Monad (MonadPlus(..), filterM, guard, replicateM, join)
import           Control.Monad.Base (MonadBase(..))
import           Control.Monad.Trans.Control (MonadBaseControl(..))
import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
import           Control.Monad.Error.Class (MonadError(..))
import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad.Morph (MFunctor(..), MMonad(..))
import qualified Control.Monad.Morph as Morph
import           Control.Monad.Primitive (PrimMonad(..))
import           Control.Monad.Reader.Class (MonadReader(..))
import           Control.Monad.State.Class (MonadState(..))
import           Control.Monad.Trans.Class (MonadTrans(..))
import           Control.Monad.Trans.Except (ExceptT(..))
import           Control.Monad.Trans.Identity (IdentityT(..))
import           Control.Monad.Trans.Maybe (MaybeT(..))
import           Control.Monad.Trans.Reader (ReaderT(..))
import           Control.Monad.Trans.Resource (MonadResource(..))
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
import           Control.Monad.Writer.Class (MonadWriter(..))
import           Control.Monad.Zip (MonadZip(..))

import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import           Data.Foldable (for_, toList)
import           Data.Functor.Identity (Identity(..))
import           Data.Int (Int8, Int16, Int32, Int64)
import           Data.Kind (Type)
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Semigroup as Semigroup
import           Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Word (Word8, Word16, Word32, Word64)

import           Hedgehog.Internal.Distributive (MonadTransDistributive(..))
import           Hedgehog.Internal.Prelude hiding (either, maybe, seq)
import           Hedgehog.Internal.Seed (Seed)
import qualified Hedgehog.Internal.Seed as Seed
import qualified Hedgehog.Internal.Shrink as Shrink
import           Hedgehog.Internal.Tree (Tree, TreeT(..), NodeT(..))
import qualified Hedgehog.Internal.Tree as Tree
import           Hedgehog.Range (Size, Range)
import qualified Hedgehog.Range as Range

#if __GLASGOW_HASKELL__ < 808
import qualified Control.Monad.Fail as Fail
#endif
#if __GLASGOW_HASKELL__ < 806
import           Data.Coerce (coerce)
#endif

------------------------------------------------------------------------
-- Generator transformer

-- | Generator for random values of @a@.
--
type Gen =
  GenT Identity

-- | Monad transformer which can generate random values of @a@.
--
newtype GenT m a =
  GenT {
      GenT m a -> Size -> Seed -> TreeT (MaybeT m) a
unGenT :: Size -> Seed -> TreeT (MaybeT m) a
    }

-- | Runs a generator, producing its shrink tree.
--
runGenT :: Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT :: Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed (GenT Size -> Seed -> TreeT (MaybeT m) a
m) =
  Size -> Seed -> TreeT (MaybeT m) a
m Size
size Seed
seed

-- | Run a generator, producing its shrink tree.
--
--   'Nothing' means discarded, 'Just' means we have a value.
--
evalGen :: Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen :: Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen Size
size Seed
seed =
  (Maybe a -> Maybe a) -> Tree (Maybe a) -> Maybe (Tree a)
forall a b. (a -> Maybe b) -> Tree a -> Maybe (Tree b)
Tree.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id (Tree (Maybe a) -> Maybe (Tree a))
-> (Gen a -> Tree (Maybe a)) -> Gen a -> Maybe (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Size -> Seed -> Gen a -> Tree (Maybe a)
forall (m :: * -> *) a.
Monad m =>
Size -> Seed -> GenT m a -> TreeT m (Maybe a)
evalGenT Size
size Seed
seed

-- | Runs a generator, producing its shrink tree.
--
evalGenT :: Monad m => Size -> Seed -> GenT m a -> TreeT m (Maybe a)
evalGenT :: Size -> Seed -> GenT m a -> TreeT m (Maybe a)
evalGenT Size
size Seed
seed =
  TreeT (MaybeT m) a -> TreeT m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runDiscardEffectT (TreeT (MaybeT m) a -> TreeT m (Maybe a))
-> (GenT m a -> TreeT (MaybeT m) a)
-> GenT m a
-> TreeT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed

-- | Map over a generator's shrink tree.
--
mapGenT :: (TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT :: (TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT TreeT (MaybeT m) a -> TreeT (MaybeT n) b
f GenT m a
gen =
  (Size -> Seed -> TreeT (MaybeT n) b) -> GenT n b
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT n) b) -> GenT n b)
-> (Size -> Seed -> TreeT (MaybeT n) b) -> GenT n b
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
    TreeT (MaybeT m) a -> TreeT (MaybeT n) b
f (Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed GenT m a
gen)

-- | Lift a predefined shrink tree in to a generator, ignoring the seed and the
--   size.
--
fromTree :: MonadGen m => Tree a -> m a
fromTree :: Tree a -> m a
fromTree =
  TreeT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => TreeT (GenBase m) a -> m a
fromTreeT (TreeT (GenBase m) a -> m a)
-> (Tree a -> TreeT (GenBase m) a) -> Tree a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall a. Identity a -> GenBase m a)
-> Tree a -> TreeT (GenBase m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (Identity a -> GenBase m a
forall (m :: * -> *) a. Monad m => Identity a -> m a
Morph.generalize)

-- | Lift a predefined shrink tree in to a generator, ignoring the seed and the
--   size.
--
fromTreeT :: MonadGen m => TreeT (GenBase m) a -> m a
fromTreeT :: TreeT (GenBase m) a -> m a
fromTreeT TreeT (GenBase m) a
x =
  TreeT (MaybeT (GenBase m)) a -> m a
forall (m :: * -> *) a.
MonadGen m =>
TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT (TreeT (MaybeT (GenBase m)) a -> m a)
-> TreeT (MaybeT (GenBase m)) a -> m a
forall a b. (a -> b) -> a -> b
$
    (forall a. GenBase m a -> MaybeT (GenBase m) a)
-> TreeT (GenBase m) a -> TreeT (MaybeT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (GenBase m (Maybe a) -> MaybeT (GenBase m) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (GenBase m (Maybe a) -> MaybeT (GenBase m) a)
-> (GenBase m a -> GenBase m (Maybe a))
-> GenBase m a
-> MaybeT (GenBase m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> GenBase m a -> GenBase m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) TreeT (GenBase m) a
x

-- | Lift a predefined shrink tree in to a generator, ignoring the seed and the
--   size.
--
fromTreeMaybeT :: MonadGen m => TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT :: TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT TreeT (MaybeT (GenBase m)) a
x =
  GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) a -> m a)
-> ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
    -> GenT (GenBase m) a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a) -> m a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a) -> m a
forall a b. (a -> b) -> a -> b
$ \Size
_ Seed
_ ->
    TreeT (MaybeT (GenBase m)) a
x

-- | Observe a generator's shrink tree.
--
toTree :: forall m a. (MonadGen m, GenBase m ~ Identity) => m a -> m (Tree a)
toTree :: m a -> m (Tree a)
toTree =
  (GenT (GenBase m) a -> GenT (GenBase m) (Tree a))
-> m a -> m (Tree a)
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((GenT (GenBase m) a -> GenT (GenBase m) (Tree a))
 -> m a -> m (Tree a))
-> (GenT (GenBase m) a -> GenT (GenBase m) (Tree a))
-> m a
-> m (Tree a)
forall a b. (a -> b) -> a -> b
$ (TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) (Tree a))
-> GenT Identity a -> GenT Identity (Tree a)
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT (TreeT (MaybeT Identity) (Tree a)
-> (Tree a -> TreeT (MaybeT Identity) (Tree a))
-> Maybe (Tree a)
-> TreeT (MaybeT Identity) (Tree a)
forall b a. b -> (a -> b) -> Maybe a -> b
Maybe.maybe TreeT (MaybeT Identity) (Tree a)
forall (f :: * -> *) a. Alternative f => f a
empty Tree a -> TreeT (MaybeT Identity) (Tree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree a) -> TreeT (MaybeT Identity) (Tree a))
-> (TreeT (MaybeT Identity) a -> Maybe (Tree a))
-> TreeT (MaybeT Identity) a
-> TreeT (MaybeT Identity) (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT (MaybeT Identity) a -> Maybe (Tree a)
forall a. TreeT (MaybeT Identity) a -> Maybe (Tree a)
runDiscardEffect)

-- | Lift a predefined shrink tree in to a generator, ignoring the seed and the
--   size.
--
toTreeMaybeT :: MonadGen m => m a -> m (TreeT (MaybeT (GenBase m)) a)
toTreeMaybeT :: m a -> m (TreeT (MaybeT (GenBase m)) a)
toTreeMaybeT =
  (GenT (GenBase m) a
 -> GenT (GenBase m) (TreeT (MaybeT (GenBase m)) a))
-> m a -> m (TreeT (MaybeT (GenBase m)) a)
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((GenT (GenBase m) a
  -> GenT (GenBase m) (TreeT (MaybeT (GenBase m)) a))
 -> m a -> m (TreeT (MaybeT (GenBase m)) a))
-> (GenT (GenBase m) a
    -> GenT (GenBase m) (TreeT (MaybeT (GenBase m)) a))
-> m a
-> m (TreeT (MaybeT (GenBase m)) a)
forall a b. (a -> b) -> a -> b
$ (TreeT (MaybeT (GenBase m)) a
 -> TreeT (MaybeT (GenBase m)) (TreeT (MaybeT (GenBase m)) a))
-> GenT (GenBase m) a
-> GenT (GenBase m) (TreeT (MaybeT (GenBase m)) a)
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT TreeT (MaybeT (GenBase m)) a
-> TreeT (MaybeT (GenBase m)) (TreeT (MaybeT (GenBase m)) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Lazily run the discard effects through the tree and reify it a
--   @Maybe (Tree a)@.
--
--   'Nothing' means discarded, 'Just' means we have a value.
--
--   Discards in the child nodes of the tree are simply removed.
--
runDiscardEffect :: TreeT (MaybeT Identity) a -> Maybe (Tree a)
runDiscardEffect :: TreeT (MaybeT Identity) a -> Maybe (Tree a)
runDiscardEffect =
  (Maybe a -> Maybe a) -> Tree (Maybe a) -> Maybe (Tree a)
forall a b. (a -> Maybe b) -> Tree a -> Maybe (Tree b)
Tree.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id (Tree (Maybe a) -> Maybe (Tree a))
-> (TreeT (MaybeT Identity) a -> Tree (Maybe a))
-> TreeT (MaybeT Identity) a
-> Maybe (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TreeT (MaybeT Identity) a -> Tree (Maybe a)
forall (m :: * -> *) a.
Monad m =>
TreeT (MaybeT m) a -> TreeT m (Maybe a)
runDiscardEffectT

-- | Run the discard effects through the tree and reify them as 'Maybe' values
--   at the nodes.
--
--   'Nothing' means discarded, 'Just' means we have a value.
--
runDiscardEffectT :: Monad m => TreeT (MaybeT m) a -> TreeT m (Maybe a)
runDiscardEffectT :: TreeT (MaybeT m) a -> TreeT m (Maybe a)
runDiscardEffectT =
  MaybeT (TreeT m) a -> TreeT m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (TreeT m) a -> TreeT m (Maybe a))
-> (TreeT (MaybeT m) a -> MaybeT (TreeT m) a)
-> TreeT (MaybeT m) a
-> TreeT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TreeT (MaybeT m) a -> MaybeT (TreeT m) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

-- | Lift a @Gen / GenT Identity@ in to a @Monad m => GenT m@
--
generalize :: Monad m => Gen a -> GenT m a
generalize :: Gen a -> GenT m a
generalize =
  (forall a. Identity a -> m a) -> Gen a -> GenT m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. Identity a -> m a
forall (m :: * -> *) a. Monad m => Identity a -> m a
Morph.generalize

------------------------------------------------------------------------
-- MonadGen

-- | Class of monads which can generate input data for tests.
--
class (Monad m, Monad (GenBase m)) => MonadGen m where
  type GenBase m :: (Type -> Type)

  -- | Extract a 'GenT' from a  'MonadGen'.
  --
  toGenT :: m a -> GenT (GenBase m) a

  -- | Lift a 'GenT' in to a 'MonadGen'.
  --
  fromGenT :: GenT (GenBase m) a -> m a

-- | Transform a 'MonadGen' as a 'GenT'.
--
withGenT :: (MonadGen m, MonadGen n) => (GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT :: (GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT GenT (GenBase m) a -> GenT (GenBase n) b
f =
  GenT (GenBase n) b -> n b
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase n) b -> n b)
-> (m a -> GenT (GenBase n) b) -> m a -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (GenBase m) a -> GenT (GenBase n) b
f (GenT (GenBase m) a -> GenT (GenBase n) b)
-> (m a -> GenT (GenBase m) a) -> m a -> GenT (GenBase n) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

instance Monad m => MonadGen (GenT m) where
  -- | The type of the transformer stack's base 'Monad'.
  --
  type GenBase (GenT m) =
    m

  -- | Convert a 'MonadGen' to a 'GenT'.
  --
  toGenT :: GenT m a -> GenT (GenBase (GenT m)) a
toGenT =
    GenT m a -> GenT (GenBase (GenT m)) a
forall a. a -> a
id

  -- | Convert a 'GenT' to a 'MonadGen'.
  --
  fromGenT :: GenT (GenBase (GenT m)) a -> GenT m a
fromGenT =
    GenT (GenBase (GenT m)) a -> GenT m a
forall a. a -> a
id

instance MonadGen m => MonadGen (IdentityT m) where
  type GenBase (IdentityT m) =
    IdentityT (GenBase m)

  toGenT :: IdentityT m a -> GenT (GenBase (IdentityT m)) a
toGenT =
    IdentityT (GenT (GenBase m)) a -> GenT (IdentityT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (IdentityT (GenT (GenBase m)) a -> GenT (IdentityT (GenBase m)) a)
-> (IdentityT m a -> IdentityT (GenT (GenBase m)) a)
-> IdentityT m a
-> GenT (IdentityT (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> IdentityT m a -> IdentityT (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (IdentityT m)) a -> IdentityT m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> IdentityT (GenT (GenBase m)) a -> IdentityT m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (IdentityT (GenT (GenBase m)) a -> IdentityT m a)
-> (GenT (IdentityT (GenBase m)) a
    -> IdentityT (GenT (GenBase m)) a)
-> GenT (IdentityT (GenBase m)) a
-> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (IdentityT (GenBase m)) a -> IdentityT (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance MonadGen m => MonadGen (MaybeT m) where
  type GenBase (MaybeT m) =
    MaybeT (GenBase m)

  toGenT :: MaybeT m a -> GenT (GenBase (MaybeT m)) a
toGenT =
    MaybeT (GenT (GenBase m)) a -> GenT (MaybeT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (MaybeT (GenT (GenBase m)) a -> GenT (MaybeT (GenBase m)) a)
-> (MaybeT m a -> MaybeT (GenT (GenBase m)) a)
-> MaybeT m a
-> GenT (MaybeT (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> MaybeT m a -> MaybeT (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (MaybeT m)) a -> MaybeT m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> MaybeT (GenT (GenBase m)) a -> MaybeT m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (MaybeT (GenT (GenBase m)) a -> MaybeT m a)
-> (GenT (MaybeT (GenBase m)) a -> MaybeT (GenT (GenBase m)) a)
-> GenT (MaybeT (GenBase m)) a
-> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (MaybeT (GenBase m)) a -> MaybeT (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance MonadGen m => MonadGen (ExceptT x m) where
  type GenBase (ExceptT x m) =
    ExceptT x (GenBase m)

  toGenT :: ExceptT x m a -> GenT (GenBase (ExceptT x m)) a
toGenT =
    ExceptT x (GenT (GenBase m)) a -> GenT (ExceptT x (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (ExceptT x (GenT (GenBase m)) a -> GenT (ExceptT x (GenBase m)) a)
-> (ExceptT x m a -> ExceptT x (GenT (GenBase m)) a)
-> ExceptT x m a
-> GenT (ExceptT x (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> ExceptT x m a -> ExceptT x (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (ExceptT x m)) a -> ExceptT x m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> ExceptT x (GenT (GenBase m)) a -> ExceptT x m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (ExceptT x (GenT (GenBase m)) a -> ExceptT x m a)
-> (GenT (ExceptT x (GenBase m)) a
    -> ExceptT x (GenT (GenBase m)) a)
-> GenT (ExceptT x (GenBase m)) a
-> ExceptT x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (ExceptT x (GenBase m)) a -> ExceptT x (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance MonadGen m => MonadGen (ReaderT r m) where
  type GenBase (ReaderT r m) =
    ReaderT r (GenBase m)

  toGenT :: ReaderT r m a -> GenT (GenBase (ReaderT r m)) a
toGenT =
    ReaderT r (GenT (GenBase m)) a -> GenT (ReaderT r (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (ReaderT r (GenT (GenBase m)) a -> GenT (ReaderT r (GenBase m)) a)
-> (ReaderT r m a -> ReaderT r (GenT (GenBase m)) a)
-> ReaderT r m a
-> GenT (ReaderT r (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> ReaderT r m a -> ReaderT r (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (ReaderT r m)) a -> ReaderT r m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> ReaderT r (GenT (GenBase m)) a -> ReaderT r m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (ReaderT r (GenT (GenBase m)) a -> ReaderT r m a)
-> (GenT (ReaderT r (GenBase m)) a
    -> ReaderT r (GenT (GenBase m)) a)
-> GenT (ReaderT r (GenBase m)) a
-> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (ReaderT r (GenBase m)) a -> ReaderT r (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance MonadGen m => MonadGen (Lazy.StateT r m) where
  type GenBase (Lazy.StateT r m) =
    Lazy.StateT r (GenBase m)

  toGenT :: StateT r m a -> GenT (GenBase (StateT r m)) a
toGenT =
    StateT r (GenT (GenBase m)) a -> GenT (StateT r (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (StateT r (GenT (GenBase m)) a -> GenT (StateT r (GenBase m)) a)
-> (StateT r m a -> StateT r (GenT (GenBase m)) a)
-> StateT r m a
-> GenT (StateT r (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> StateT r m a -> StateT r (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (StateT r m)) a -> StateT r m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> StateT r (GenT (GenBase m)) a -> StateT r m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (StateT r (GenT (GenBase m)) a -> StateT r m a)
-> (GenT (StateT r (GenBase m)) a -> StateT r (GenT (GenBase m)) a)
-> GenT (StateT r (GenBase m)) a
-> StateT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (StateT r (GenBase m)) a -> StateT r (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance MonadGen m => MonadGen (Strict.StateT r m) where
  type GenBase (Strict.StateT r m) =
    Strict.StateT r (GenBase m)

  toGenT :: StateT r m a -> GenT (GenBase (StateT r m)) a
toGenT =
    StateT r (GenT (GenBase m)) a -> GenT (StateT r (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (StateT r (GenT (GenBase m)) a -> GenT (StateT r (GenBase m)) a)
-> (StateT r m a -> StateT r (GenT (GenBase m)) a)
-> StateT r m a
-> GenT (StateT r (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> StateT r m a -> StateT r (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (StateT r m)) a -> StateT r m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> StateT r (GenT (GenBase m)) a -> StateT r m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (StateT r (GenT (GenBase m)) a -> StateT r m a)
-> (GenT (StateT r (GenBase m)) a -> StateT r (GenT (GenBase m)) a)
-> GenT (StateT r (GenBase m)) a
-> StateT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (StateT r (GenBase m)) a -> StateT r (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance (MonadGen m, Monoid w) => MonadGen (Lazy.WriterT w m) where
  type GenBase (Lazy.WriterT w m) =
    Lazy.WriterT w (GenBase m)

  toGenT :: WriterT w m a -> GenT (GenBase (WriterT w m)) a
toGenT =
    WriterT w (GenT (GenBase m)) a -> GenT (WriterT w (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (WriterT w (GenT (GenBase m)) a -> GenT (WriterT w (GenBase m)) a)
-> (WriterT w m a -> WriterT w (GenT (GenBase m)) a)
-> WriterT w m a
-> GenT (WriterT w (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> WriterT w m a -> WriterT w (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (WriterT w m)) a -> WriterT w m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> WriterT w (GenT (GenBase m)) a -> WriterT w m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (WriterT w (GenT (GenBase m)) a -> WriterT w m a)
-> (GenT (WriterT w (GenBase m)) a
    -> WriterT w (GenT (GenBase m)) a)
-> GenT (WriterT w (GenBase m)) a
-> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (WriterT w (GenBase m)) a -> WriterT w (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

instance (MonadGen m, Monoid w) => MonadGen (Strict.WriterT w m) where
  type GenBase (Strict.WriterT w m) =
    Strict.WriterT w (GenBase m)

  toGenT :: WriterT w m a -> GenT (GenBase (WriterT w m)) a
toGenT =
    WriterT w (GenT (GenBase m)) a -> GenT (WriterT w (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (WriterT w (GenT (GenBase m)) a -> GenT (WriterT w (GenBase m)) a)
-> (WriterT w m a -> WriterT w (GenT (GenBase m)) a)
-> WriterT w m a
-> GenT (WriterT w (GenBase m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> GenT (GenBase m) a)
-> WriterT w m a -> WriterT w (GenT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> GenT (GenBase m) a
forall (m :: * -> *) a. MonadGen m => m a -> GenT (GenBase m) a
toGenT

  fromGenT :: GenT (GenBase (WriterT w m)) a -> WriterT w m a
fromGenT =
    (forall a. GenT (GenBase m) a -> m a)
-> WriterT w (GenT (GenBase m)) a -> WriterT w m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (WriterT w (GenT (GenBase m)) a -> WriterT w m a)
-> (GenT (WriterT w (GenBase m)) a
    -> WriterT w (GenT (GenBase m)) a)
-> GenT (WriterT w (GenBase m)) a
-> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT (WriterT w (GenBase m)) a -> WriterT w (GenT (GenBase m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT

------------------------------------------------------------------------
-- GenT instances

instance (Monad m, Semigroup a) => Semigroup (GenT m a) where
  <> :: GenT m a -> GenT m a -> GenT m a
(<>) =
    (a -> a -> a) -> GenT m a -> GenT m a -> GenT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

instance (
  Monad m, Monoid a
#if !MIN_VERSION_base(4,11,0)
  , Semigroup a
#endif
         ) => Monoid (GenT m a) where
#if !MIN_VERSION_base(4,11,0)
  mappend = (Semigroup.<>)
#endif

  mempty :: GenT m a
mempty =
    a -> GenT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty

instance Functor m => Functor (GenT m) where
  fmap :: (a -> b) -> GenT m a -> GenT m b
fmap a -> b
f GenT m a
gen =
    (Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b)
-> (Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b
forall a b. (a -> b) -> a -> b
$ \Size
seed Seed
size ->
      (a -> b) -> TreeT (MaybeT m) a -> TreeT (MaybeT m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
seed Seed
size GenT m a
gen)

--
-- implementation: parallel shrinking
--
instance Monad m => Applicative (GenT m) where
  pure :: a -> GenT m a
pure =
    TreeT (MaybeT m) a -> GenT m a
forall (m :: * -> *) a.
MonadGen m =>
TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT (TreeT (MaybeT m) a -> GenT m a)
-> (a -> TreeT (MaybeT m) a) -> a -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TreeT (MaybeT m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  <*> :: GenT m (a -> b) -> GenT m a -> GenT m b
(<*>) GenT m (a -> b)
f GenT m a
m =
    (Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b)
-> (Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b
forall a b. (a -> b) -> a -> b
$ \ Size
size Seed
seed ->
      case Seed -> (Seed, Seed)
Seed.split Seed
seed of
        (Seed
sf, Seed
sm) ->
          ((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) ((a -> b, a) -> b)
-> TreeT (MaybeT m) (a -> b, a) -> TreeT (MaybeT m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Size -> Seed -> GenT m (a -> b) -> TreeT (MaybeT m) (a -> b)
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sf GenT m (a -> b)
f TreeT (MaybeT m) (a -> b)
-> TreeT (MaybeT m) a -> TreeT (MaybeT m) (a -> b, a)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
`mzip`
            Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sm GenT m a
m

--
-- implementation: satisfies law (ap = <*>)
--
--instance Monad m => Applicative (GenT m) where
--  pure =
--    fromTreeMaybeT . pure
--  (<*>) f m =
--    GenT $ \ size seed ->
--      case Seed.split seed of
--        (sf, sm) ->
--          runGenT size sf f <*>
--          runGenT size sm m

instance Monad m => Monad (GenT m) where
  return :: a -> GenT m a
return =
    a -> GenT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  >>= :: GenT m a -> (a -> GenT m b) -> GenT m b
(>>=) GenT m a
m a -> GenT m b
k =
    (Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b)
-> (Size -> Seed -> TreeT (MaybeT m) b) -> GenT m b
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      case Seed -> (Seed, Seed)
Seed.split Seed
seed of
        (Seed
sk, Seed
sm) ->
          Size -> Seed -> GenT m b -> TreeT (MaybeT m) b
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sk (GenT m b -> TreeT (MaybeT m) b)
-> (a -> GenT m b) -> a -> TreeT (MaybeT m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GenT m b
k (a -> TreeT (MaybeT m) b)
-> TreeT (MaybeT m) a -> TreeT (MaybeT m) b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sm GenT m a
m

#if __GLASGOW_HASKELL__ < 808
  fail =
    Fail.fail
#endif

instance Monad m => MonadFail (GenT m) where
  fail :: String -> GenT m a
fail =
    String -> GenT m a
forall a. HasCallStack => String -> a
error

instance Monad m => Alternative (GenT m) where
  empty :: GenT m a
empty =
    GenT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

  <|> :: GenT m a -> GenT m a -> GenT m a
(<|>) =
    GenT m a -> GenT m a -> GenT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad m => MonadPlus (GenT m) where
  mzero :: GenT m a
mzero =
    TreeT (MaybeT (GenBase (GenT m))) a -> GenT m a
forall (m :: * -> *) a.
MonadGen m =>
TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT TreeT (MaybeT (GenBase (GenT m))) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

  mplus :: GenT m a -> GenT m a -> GenT m a
mplus GenT m a
x GenT m a
y =
    (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a)
-> (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      case Seed -> (Seed, Seed)
Seed.split Seed
seed of
        (Seed
sx, Seed
sy) ->
          Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sx GenT m a
x TreeT (MaybeT m) a -> TreeT (MaybeT m) a -> TreeT (MaybeT m) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
          Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sy GenT m a
y

instance MonadTrans GenT where
  lift :: m a -> GenT m a
lift =
    TreeT (MaybeT m) a -> GenT m a
forall (m :: * -> *) a.
MonadGen m =>
TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT (TreeT (MaybeT m) a -> GenT m a)
-> (m a -> TreeT (MaybeT m) a) -> m a -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT m a -> TreeT (MaybeT m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MaybeT m a -> TreeT (MaybeT m) a)
-> (m a -> MaybeT m a) -> m a -> TreeT (MaybeT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MFunctor GenT where
  hoist :: (forall a. m a -> n a) -> GenT m b -> GenT n b
hoist forall a. m a -> n a
f =
    (TreeT (MaybeT m) b -> TreeT (MaybeT n) b) -> GenT m b -> GenT n b
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT ((forall a. MaybeT m a -> MaybeT n a)
-> TreeT (MaybeT m) b -> TreeT (MaybeT n) b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a) -> MaybeT m a -> MaybeT n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
f))

embedMaybeT ::
     MonadTrans t
  => Monad n
  => Monad (t (MaybeT n))
  => (forall a. m a -> t (MaybeT n) a)
  -> MaybeT m b
  -> t (MaybeT n) b
embedMaybeT :: (forall a. m a -> t (MaybeT n) a) -> MaybeT m b -> t (MaybeT n) b
embedMaybeT forall a. m a -> t (MaybeT n) a
f MaybeT m b
m =
  MaybeT n b -> t (MaybeT n) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MaybeT n b -> t (MaybeT n) b)
-> (Maybe b -> MaybeT n b) -> Maybe b -> t (MaybeT n) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n (Maybe b) -> MaybeT n b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (n (Maybe b) -> MaybeT n b)
-> (Maybe b -> n (Maybe b)) -> Maybe b -> MaybeT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> n (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> t (MaybeT n) b)
-> t (MaybeT n) (Maybe b) -> t (MaybeT n) b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe b) -> t (MaybeT n) (Maybe b)
forall a. m a -> t (MaybeT n) a
f (MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m b
m)

embedTreeMaybeT ::
     Monad n
  => (forall a. m a -> TreeT (MaybeT n) a)
  -> TreeT (MaybeT m) b
  -> TreeT (MaybeT n) b
embedTreeMaybeT :: (forall a. m a -> TreeT (MaybeT n) a)
-> TreeT (MaybeT m) b -> TreeT (MaybeT n) b
embedTreeMaybeT forall a. m a -> TreeT (MaybeT n) a
f TreeT (MaybeT m) b
tree_ =
  (forall a. MaybeT m a -> TreeT (MaybeT n) a)
-> TreeT (MaybeT m) b -> TreeT (MaybeT n) b
forall (t :: (* -> *) -> * -> *) (n :: * -> *) (m :: * -> *) b.
(MMonad t, Monad n) =>
(forall a. m a -> t n a) -> t m b -> t n b
embed ((forall a. m a -> TreeT (MaybeT n) a)
-> MaybeT m a -> TreeT (MaybeT n) a
forall (t :: (* -> *) -> * -> *) (n :: * -> *) (m :: * -> *) b.
(MonadTrans t, Monad n, Monad (t (MaybeT n))) =>
(forall a. m a -> t (MaybeT n) a) -> MaybeT m b -> t (MaybeT n) b
embedMaybeT forall a. m a -> TreeT (MaybeT n) a
f) TreeT (MaybeT m) b
tree_

embedGenT ::
     Monad n
  => (forall a. m a -> GenT n a)
  -> GenT m b
  -> GenT n b
embedGenT :: (forall a. m a -> GenT n a) -> GenT m b -> GenT n b
embedGenT forall a. m a -> GenT n a
f GenT m b
gen =
  (Size -> Seed -> TreeT (MaybeT n) b) -> GenT n b
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT n) b) -> GenT n b)
-> (Size -> Seed -> TreeT (MaybeT n) b) -> GenT n b
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
    case Seed -> (Seed, Seed)
Seed.split Seed
seed of
      (Seed
sf, Seed
sg) ->
        (Size -> Seed -> GenT n a -> TreeT (MaybeT n) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sf (GenT n a -> TreeT (MaybeT n) a)
-> (m a -> GenT n a) -> m a -> TreeT (MaybeT n) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> GenT n a
forall a. m a -> GenT n a
f) (forall a. m a -> TreeT (MaybeT n) a)
-> TreeT (MaybeT m) b -> TreeT (MaybeT n) b
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> TreeT (MaybeT n) a)
-> TreeT (MaybeT m) b -> TreeT (MaybeT n) b
`embedTreeMaybeT`
        (Size -> Seed -> GenT m b -> TreeT (MaybeT m) b
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sg GenT m b
gen)

instance MMonad GenT where
  embed :: (forall a. m a -> GenT n a) -> GenT m b -> GenT n b
embed =
    (forall a. m a -> GenT n a) -> GenT m b -> GenT n b
forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> GenT n a) -> GenT m b -> GenT n b
embedGenT

distributeGenT :: Transformer t GenT m => GenT (t m) a -> t (GenT m) a
distributeGenT :: GenT (t m) a -> t (GenT m) a
distributeGenT GenT (t m) a
x =
  t (GenT m) (t (GenT m) a) -> t (GenT m) a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (t (GenT m) (t (GenT m) a) -> t (GenT m) a)
-> ((Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a))
    -> t (GenT m) (t (GenT m) a))
-> (Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a))
-> t (GenT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenT m (t (GenT m) a) -> t (GenT m) (t (GenT m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GenT m (t (GenT m) a) -> t (GenT m) (t (GenT m) a))
-> ((Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a))
    -> GenT m (t (GenT m) a))
-> (Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a))
-> t (GenT m) (t (GenT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a))
-> GenT m (t (GenT m) a)
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a)) -> t (GenT m) a)
-> (Size -> Seed -> TreeT (MaybeT m) (t (GenT m) a))
-> t (GenT m) a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
    t (GenT m) a -> TreeT (MaybeT m) (t (GenT m) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t (GenT m) a -> TreeT (MaybeT m) (t (GenT m) a))
-> (TreeT (MaybeT (t m)) a -> t (GenT m) a)
-> TreeT (MaybeT (t m)) a
-> TreeT (MaybeT m) (t (GenT m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. TreeT (MaybeT m) a -> GenT m a)
-> t (TreeT (MaybeT m)) a -> t (GenT m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. TreeT (MaybeT m) a -> GenT m a
forall (m :: * -> *) a.
MonadGen m =>
TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT (t (TreeT (MaybeT m)) a -> t (GenT m) a)
-> (TreeT (MaybeT (t m)) a -> t (TreeT (MaybeT m)) a)
-> TreeT (MaybeT (t m)) a
-> t (GenT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT (t (MaybeT m)) a -> t (TreeT (MaybeT m)) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (TreeT (t (MaybeT m)) a -> t (TreeT (MaybeT m)) a)
-> (TreeT (MaybeT (t m)) a -> TreeT (t (MaybeT m)) a)
-> TreeT (MaybeT (t m)) a
-> t (TreeT (MaybeT m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. MaybeT (t m) a -> t (MaybeT m) a)
-> TreeT (MaybeT (t m)) a -> TreeT (t (MaybeT m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. MaybeT (t m) a -> t (MaybeT m) a
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(MonadTransDistributive g, Transformer f g m) =>
g (f m) a -> f (g m) a
distributeT (TreeT (MaybeT (t m)) a -> TreeT (MaybeT m) (t (GenT m) a))
-> TreeT (MaybeT (t m)) a -> TreeT (MaybeT m) (t (GenT m) a)
forall a b. (a -> b) -> a -> b
$ Size -> Seed -> GenT (t m) a -> TreeT (MaybeT (t m)) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed GenT (t m) a
x

instance MonadTransDistributive GenT where
  type Transformer t GenT m = (
      Monad (t (GenT m))
    , Transformer t MaybeT m
    , Transformer t TreeT (MaybeT m)
    )

  distributeT :: GenT (f m) a -> f (GenT m) a
distributeT =
    GenT (f m) a -> f (GenT m) a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a.
Transformer f GenT m =>
GenT (f m) a -> f (GenT m) a
distributeGenT

instance PrimMonad m => PrimMonad (GenT m) where
  type PrimState (GenT m) =
    PrimState m

  primitive :: (State# (PrimState (GenT m))
 -> (# State# (PrimState (GenT m)), a #))
-> GenT m a
primitive =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance MonadIO m => MonadIO (GenT m) where
  liftIO :: IO a -> GenT m a
liftIO =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a) -> (IO a -> m a) -> IO a -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadBase b m => MonadBase b (GenT m) where
  liftBase :: b α -> GenT m α
liftBase =
    m α -> GenT m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> GenT m α) -> (b α -> m α) -> b α -> GenT m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

#if __GLASGOW_HASKELL__ >= 806
deriving via (ReaderT Size (ReaderT Seed (TreeT (MaybeT m))))
  instance MonadBaseControl b m => MonadBaseControl b (GenT m)
#else
instance MonadBaseControl b m => MonadBaseControl b (GenT m) where
  type StM (GenT m) a = StM (GloopT m) a
  liftBaseWith g = gloopToGen $ liftBaseWith $ \q -> g (\gen -> q (genToGloop gen))
  restoreM = gloopToGen . restoreM

type GloopT m = ReaderT Size (ReaderT Seed (TreeT (MaybeT m)))

gloopToGen :: GloopT m a -> GenT m a
gloopToGen = coerce

genToGloop :: GenT m a -> GloopT m a
genToGloop = coerce
#endif

instance MonadThrow m => MonadThrow (GenT m) where
  throwM :: e -> GenT m a
throwM =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a) -> (e -> m a) -> e -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch m => MonadCatch (GenT m) where
  catch :: GenT m a -> (e -> GenT m a) -> GenT m a
catch GenT m a
m e -> GenT m a
onErr =
    (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a)
-> (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      case Seed -> (Seed, Seed)
Seed.split Seed
seed of
        (Seed
sm, Seed
se) ->
          (Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sm GenT m a
m) TreeT (MaybeT m) a
-> (e -> TreeT (MaybeT m) a) -> TreeT (MaybeT m) a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch`
          (Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
se (GenT m a -> TreeT (MaybeT m) a)
-> (e -> GenT m a) -> e -> TreeT (MaybeT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GenT m a
onErr)

instance MonadReader r m => MonadReader r (GenT m) where
  ask :: GenT m r
ask =
    m r -> GenT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> GenT m a -> GenT m a
local r -> r
f GenT m a
m =
    (TreeT (MaybeT m) a -> TreeT (MaybeT m) a) -> GenT m a -> GenT m a
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT ((r -> r) -> TreeT (MaybeT m) a -> TreeT (MaybeT m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f) GenT m a
m

instance MonadState s m => MonadState s (GenT m) where
  get :: GenT m s
get =
    m s -> GenT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> GenT m ()
put =
    m () -> GenT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GenT m ()) -> (s -> m ()) -> s -> GenT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: (s -> (a, s)) -> GenT m a
state =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance MonadWriter w m => MonadWriter w (GenT m) where
  writer :: (a, w) -> GenT m a
writer =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a) -> ((a, w) -> m a) -> (a, w) -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> GenT m ()
tell =
    m () -> GenT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GenT m ()) -> (w -> m ()) -> w -> GenT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: GenT m a -> GenT m (a, w)
listen GenT m a
m =
    (Size -> Seed -> TreeT (MaybeT m) (a, w)) -> GenT m (a, w)
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) (a, w)) -> GenT m (a, w))
-> (Size -> Seed -> TreeT (MaybeT m) (a, w)) -> GenT m (a, w)
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      TreeT (MaybeT m) a -> TreeT (MaybeT m) (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (TreeT (MaybeT m) a -> TreeT (MaybeT m) (a, w))
-> TreeT (MaybeT m) a -> TreeT (MaybeT m) (a, w)
forall a b. (a -> b) -> a -> b
$ Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed GenT m a
m
  pass :: GenT m (a, w -> w) -> GenT m a
pass GenT m (a, w -> w)
m =
    (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a)
-> (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      TreeT (MaybeT m) (a, w -> w) -> TreeT (MaybeT m) a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (TreeT (MaybeT m) (a, w -> w) -> TreeT (MaybeT m) a)
-> TreeT (MaybeT m) (a, w -> w) -> TreeT (MaybeT m) a
forall a b. (a -> b) -> a -> b
$ Size -> Seed -> GenT m (a, w -> w) -> TreeT (MaybeT m) (a, w -> w)
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed GenT m (a, w -> w)
m

instance MonadError e m => MonadError e (GenT m) where
  throwError :: e -> GenT m a
throwError =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a) -> (e -> m a) -> e -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: GenT m a -> (e -> GenT m a) -> GenT m a
catchError GenT m a
m e -> GenT m a
onErr =
    (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a)
-> (Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      case Seed -> (Seed, Seed)
Seed.split Seed
seed of
        (Seed
sm, Seed
se) ->
          (Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
sm GenT m a
m) TreeT (MaybeT m) a
-> (e -> TreeT (MaybeT m) a) -> TreeT (MaybeT m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError`
          (Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
se (GenT m a -> TreeT (MaybeT m) a)
-> (e -> GenT m a) -> e -> TreeT (MaybeT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GenT m a
onErr)

instance MonadResource m => MonadResource (GenT m) where
  liftResourceT :: ResourceT IO a -> GenT m a
liftResourceT =
    m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a)
-> (ResourceT IO a -> m a) -> ResourceT IO a -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO a -> m a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT

------------------------------------------------------------------------
-- Combinators

-- | Generate a value with no shrinks from a 'Size' and a 'Seed'.
--
generate :: MonadGen m => (Size -> Seed -> a) -> m a
generate :: (Size -> Seed -> a) -> m a
generate Size -> Seed -> a
f =
  GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) a -> m a)
-> ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
    -> GenT (GenBase m) a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a) -> m a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a) -> m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
    a -> TreeT (MaybeT (GenBase m)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> Seed -> a
f Size
size Seed
seed)

------------------------------------------------------------------------
-- Combinators - Shrinking

-- | Apply a shrinking function to a generator.
--
--   This will give the generator additional shrinking options, while keeping
--   the existing shrinks intact.
--
shrink :: MonadGen m => (a -> [a]) -> m a -> m a
shrink :: (a -> [a]) -> m a -> m a
shrink a -> [a]
f =
  (GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a)
-> (GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (TreeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a -> GenT (GenBase m) a
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT ((a -> [a])
-> TreeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) a
forall (m :: * -> *) a.
Monad m =>
(a -> [a]) -> TreeT m a -> TreeT m a
Tree.expand a -> [a]
f)

-- | Throw away a generator's shrink tree.
--
prune :: MonadGen m => m a -> m a
prune :: m a -> m a
prune =
  (GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a)
-> (GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (TreeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a -> GenT (GenBase m) a
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT (Int -> TreeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) a
forall (m :: * -> *) a. Monad m => Int -> TreeT m a -> TreeT m a
Tree.prune Int
0)

------------------------------------------------------------------------
-- Combinators - Size

-- | Construct a generator that depends on the size parameter.
--
sized :: MonadGen m => (Size -> m a) -> m a
sized :: (Size -> m a) -> m a
sized Size -> m a
f = do
  Size -> m a
f (Size -> m a) -> m Size -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Size -> Seed -> Size) -> m Size
forall (m :: * -> *) a. MonadGen m => (Size -> Seed -> a) -> m a
generate (\Size
size Seed
_ -> Size
size)

-- | Override the size parameter. Returns a generator which uses the given size
--   instead of the runtime-size parameter.
--
resize :: MonadGen m => Size -> m a -> m a
resize :: Size -> m a -> m a
resize Size
size m a
gen =
  (Size -> Size) -> m a -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> Size) -> m a -> m a
scale (Size -> Size -> Size
forall a b. a -> b -> a
const Size
size) m a
gen

-- | Adjust the size parameter by transforming it with the given function.
--
scale :: MonadGen m => (Size -> Size) -> m a -> m a
scale :: (Size -> Size) -> m a -> m a
scale Size -> Size
f =
  (GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a)
-> (GenT (GenBase m) a -> GenT (GenBase m) a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \GenT (GenBase m) a
gen ->
    (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
 -> GenT (GenBase m) a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a
forall a b. (a -> b) -> a -> b
$ \Size
size0 Seed
seed ->
      let
        size :: Size
size =
          Size -> Size
f Size
size0
      in
        if Size
size Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
0 then
          String -> TreeT (MaybeT (GenBase m)) a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.scale: negative size"
        else
          Size -> Seed -> GenT (GenBase m) a -> TreeT (MaybeT (GenBase m)) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed GenT (GenBase m) a
gen

-- | Make a generator smaller by scaling its size parameter.
--
small :: MonadGen m => m a -> m a
small :: m a -> m a
small =
  (Size -> Size) -> m a -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> Size) -> m a -> m a
scale Size -> Size
golden

-- | Scale a size using the golden ratio.
--
--   > golden x = x / φ
--   > golden x = x / 1.61803..
--
golden :: Size -> Size
golden :: Size -> Size
golden Size
x =
  Double -> Size
forall a b. (RealFrac a, Integral b) => a -> b
round (Size -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.61803398875 :: Double)

------------------------------------------------------------------------
-- Combinators - Integral

-- | Generates a random integral number in the given @[inclusive,inclusive]@ range.
--
--   When the generator tries to shrink, it will shrink towards the
--   'Range.origin' of the specified 'Range'.
--
--   For example, the following generator will produce a number between @1970@
--   and @2100@, but will shrink towards @2000@:
--
-- @
-- integral (Range.'Range.constantFrom' 2000 1970 2100) :: 'Gen' 'Int'
-- @
--
--   Some sample outputs from this generator might look like:
--
--   > === Outcome ===
--   > 1973
--   > === Shrinks ===
--   > 2000
--   > 1987
--   > 1980
--   > 1976
--   > 1974
--
--   > === Outcome ===
--   > 2061
--   > === Shrinks ===
--   > 2000
--   > 2031
--   > 2046
--   > 2054
--   > 2058
--   > 2060
--
integral :: forall m a. (MonadGen m, Integral a) => Range a -> m a
integral :: Range a -> m a
integral Range a
range =
  -- https://github.com/hedgehogqa/haskell-hedgehog/pull/413/files
  let
    origin_ :: a
origin_ =
      Range a -> a
forall a. Range a -> a
Range.origin Range a
range

    binarySearchTree :: a -> a -> TreeT Identity a
binarySearchTree a
bottom a
top =
      NodeT Identity a -> TreeT Identity a
forall a. NodeT Identity a -> Tree a
Tree.Tree (NodeT Identity a -> TreeT Identity a)
-> NodeT Identity a -> TreeT Identity a
forall a b. (a -> b) -> a -> b
$
        let
          shrinks :: [a]
shrinks =
            a -> a -> [a]
forall a. Integral a => a -> a -> [a]
Shrink.towards a
bottom a
top
          children :: [TreeT Identity a]
children =
            (a -> a -> TreeT Identity a) -> [a] -> [a] -> [TreeT Identity a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> TreeT Identity a
binarySearchTree [a]
shrinks (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
shrinks)
        in
          a -> [TreeT Identity a] -> NodeT Identity a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
Tree.NodeT a
top [TreeT Identity a]
children

    createTree :: a -> TreeT (MaybeT (GenBase m)) a
createTree a
root =
      if a
root a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
origin_ then
        a -> TreeT (MaybeT (GenBase m)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
root
      else
        (forall a. Identity a -> MaybeT (GenBase m) a)
-> TreeT Identity a -> TreeT (MaybeT (GenBase m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. Identity a -> MaybeT (GenBase m) a
forall (m :: * -> *) a. Monad m => Identity a -> m a
Morph.generalize (TreeT Identity a -> TreeT (MaybeT (GenBase m)) a)
-> TreeT Identity a -> TreeT (MaybeT (GenBase m)) a
forall a b. (a -> b) -> a -> b
$
          a -> TreeT Identity a -> TreeT Identity a
forall (m :: * -> *) a. Monad m => a -> TreeT m a -> TreeT m a
Tree.consChild a
origin_ (TreeT Identity a -> TreeT Identity a)
-> TreeT Identity a -> TreeT Identity a
forall a b. (a -> b) -> a -> b
$
            a -> a -> TreeT Identity a
forall a. Integral a => a -> a -> TreeT Identity a
binarySearchTree a
origin_ a
root

  in
    GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) a -> m a)
-> ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
    -> GenT (GenBase m) a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Seed -> TreeT (MaybeT (GenBase m)) a)
-> GenT (GenBase m) a
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT (GenBase m)) a) -> m a)
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) a) -> m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
      a -> TreeT (MaybeT (GenBase m)) a
createTree (a -> TreeT (MaybeT (GenBase m)) a)
-> a -> TreeT (MaybeT (GenBase m)) a
forall a b. (a -> b) -> a -> b
$ Range a -> Size -> Seed -> a
forall a c. (Integral a, Num c) => Range a -> Size -> Seed -> c
integralHelper Range a
range Size
size Seed
seed

-- | Generates a random integral number in the [inclusive,inclusive] range.
--
--   /This generator does not shrink./
--
integral_ :: (MonadGen m, Integral a) => Range a -> m a
integral_ :: Range a -> m a
integral_ =
  (Size -> Seed -> a) -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> Seed -> a) -> m a
generate ((Size -> Seed -> a) -> m a)
-> (Range a -> Size -> Seed -> a) -> Range a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range a -> Size -> Seed -> a
forall a c. (Integral a, Num c) => Range a -> Size -> Seed -> c
integralHelper


-- | Generates a random integral value from a range.
integralHelper :: (Integral a, Num c) => Range a -> Size -> Seed -> c
integralHelper :: Range a -> Size -> Seed -> c
integralHelper Range a
range Size
size Seed
seed =
  let
    (a
x, a
y) =
      Size -> Range a -> (a, a)
forall a. Size -> Range a -> (a, a)
Range.bounds Size
size Range a
range
  in
    Integer -> c
forall a. Num a => Integer -> a
fromInteger (Integer -> c)
-> ((Integer, Seed) -> Integer) -> (Integer, Seed) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Seed) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Seed) -> c) -> (Integer, Seed) -> c
forall a b. (a -> b) -> a -> b
$
      Integer -> Integer -> Seed -> (Integer, Seed)
Seed.nextInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x) (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
y) Seed
seed


-- | Generates a random machine integer in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
int :: MonadGen m => Range Int -> m Int
int :: Range Int -> m Int
int =
  Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 8-bit integer in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
int8 :: MonadGen m => Range Int8 -> m Int8
int8 :: Range Int8 -> m Int8
int8 =
  Range Int8 -> m Int8
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 16-bit integer in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
int16 :: MonadGen m => Range Int16 -> m Int16
int16 :: Range Int16 -> m Int16
int16 =
  Range Int16 -> m Int16
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 32-bit integer in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
int32 :: MonadGen m => Range Int32 -> m Int32
int32 :: Range Int32 -> m Int32
int32 =
  Range Int32 -> m Int32
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 64-bit integer in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
int64 :: MonadGen m => Range Int64 -> m Int64
int64 :: Range Int64 -> m Int64
int64 =
  Range Int64 -> m Int64
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random machine word in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
word :: MonadGen m => Range Word -> m Word
word :: Range Word -> m Word
word =
  Range Word -> m Word
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random byte in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
word8 :: MonadGen m => Range Word8 -> m Word8
word8 :: Range Word8 -> m Word8
word8 =
  Range Word8 -> m Word8
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 16-bit word in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
word16 :: MonadGen m => Range Word16 -> m Word16
word16 :: Range Word16 -> m Word16
word16 =
  Range Word16 -> m Word16
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 32-bit word in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
word32 :: MonadGen m => Range Word32 -> m Word32
word32 :: Range Word32 -> m Word32
word32 =
  Range Word32 -> m Word32
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

-- | Generates a random 64-bit word in the given @[inclusive,inclusive]@ range.
--
--   /This is a specialization of 'integral', offered for convenience./
--
word64 :: MonadGen m => Range Word64 -> m Word64
word64 :: Range Word64 -> m Word64
word64 =
  Range Word64 -> m Word64
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral

------------------------------------------------------------------------
-- Combinators - Fractional / Floating-Point

-- | Generates a random floating-point number in the @[inclusive,exclusive)@ range.
--
--   /This generator works the same as 'integral', but for floating point numbers./
--
realFloat :: (MonadGen m, RealFloat a) => Range a -> m a
realFloat :: Range a -> m a
realFloat Range a
range =
  (a -> [a]) -> m a -> m a
forall (m :: * -> *) a. MonadGen m => (a -> [a]) -> m a -> m a
shrink (a -> a -> [a]
forall a. RealFloat a => a -> a -> [a]
Shrink.towardsFloat (a -> a -> [a]) -> a -> a -> [a]
forall a b. (a -> b) -> a -> b
$ Range a -> a
forall a. Range a -> a
Range.origin Range a
range) (Range a -> m a
forall (m :: * -> *) a. (MonadGen m, RealFrac a) => Range a -> m a
realFrac_ Range a
range)

-- | Generates a random fractional number in the [inclusive,exclusive) range.
--
--   /This generator does not shrink./
--
realFrac_ :: (MonadGen m, RealFrac a) => Range a -> m a
realFrac_ :: Range a -> m a
realFrac_ Range a
range =
  (Size -> Seed -> a) -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> Seed -> a) -> m a
generate ((Size -> Seed -> a) -> m a) -> (Size -> Seed -> a) -> m a
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed ->
    let
      (a
x, a
y) =
        Size -> Range a -> (a, a)
forall a. Size -> Range a -> (a, a)
Range.bounds Size
size Range a
range
    in
      Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> ((Double, Seed) -> Double) -> (Double, Seed) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Seed) -> Double
forall a b. (a, b) -> a
fst ((Double, Seed) -> a) -> (Double, Seed) -> a
forall a b. (a -> b) -> a -> b
$
        Double -> Double -> Seed -> (Double, Seed)
Seed.nextDouble (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
x) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
y) Seed
seed

-- | Generates a random floating-point number in the @[inclusive,exclusive)@ range.
--
--   /This is a specialization of 'realFloat', offered for convenience./
--
float :: MonadGen m => Range Float -> m Float
float :: Range Float -> m Float
float =
 Range Float -> m Float
forall (m :: * -> *) a. (MonadGen m, RealFloat a) => Range a -> m a
realFloat

-- | Generates a random floating-point number in the @[inclusive,exclusive)@ range.
--
--   /This is a specialization of 'realFloat', offered for convenience./
--
double :: MonadGen m => Range Double -> m Double
double :: Range Double -> m Double
double =
 Range Double -> m Double
forall (m :: * -> *) a. (MonadGen m, RealFloat a) => Range a -> m a
realFloat

------------------------------------------------------------------------
-- Combinators - Enumeration

-- | Generates an element from an enumeration.
--
--   This generator shrinks towards the first argument.
--
--   For example:
--
-- @
-- enum \'a' \'z' :: 'Gen' 'Char'
-- @
--
enum :: (MonadGen m, Enum a) => a -> a -> m a
enum :: a -> a -> m a
enum a
lo a
hi =
  (Int -> a) -> m Int -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
forall a. Enum a => Int -> a
toEnum (m Int -> m a) -> (Range Int -> m Int) -> Range Int -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral (Range Int -> m a) -> Range Int -> m a
forall a b. (a -> b) -> a -> b
$
    Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant (a -> Int
forall a. Enum a => a -> Int
fromEnum a
lo) (a -> Int
forall a. Enum a => a -> Int
fromEnum a
hi)

-- | Generates a random value from a bounded enumeration.
--
--   This generator shrinks towards 'minBound'.
--
--   For example:
--
-- @
-- enumBounded :: 'Gen' 'Bool'
-- @
--
--   /This is implemented in terms of the 'Enum' class, and thus may be/
--   /partial for integral types larger than 'Int', e.g. 'Word64'./
enumBounded :: (MonadGen m, Enum a, Bounded a) => m a
enumBounded :: m a
enumBounded =
  a -> a -> m a
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound

-- | Generates a random boolean.
--
--   This generator shrinks to 'False'.
--
--   /This is a specialization of 'enumBounded', offered for convenience./
--
bool :: MonadGen m => m Bool
bool :: m Bool
bool =
  m Bool
forall (m :: * -> *) a. (MonadGen m, Enum a, Bounded a) => m a
enumBounded

-- | Generates a random boolean.
--
--   /This generator does not shrink./
--
bool_ :: MonadGen m => m Bool
bool_ :: m Bool
bool_ =
  (Size -> Seed -> Bool) -> m Bool
forall (m :: * -> *) a. MonadGen m => (Size -> Seed -> a) -> m a
generate ((Size -> Seed -> Bool) -> m Bool)
-> (Size -> Seed -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \Size
_ Seed
seed ->
    (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Integer -> Bool)
-> ((Integer, Seed) -> Integer) -> (Integer, Seed) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Seed) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Seed) -> Bool) -> (Integer, Seed) -> Bool
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Seed -> (Integer, Seed)
Seed.nextInteger Integer
0 Integer
1 Seed
seed

------------------------------------------------------------------------
-- Combinators - Characters

-- | Generates an ASCII binit: @'0'..'1'@
--
binit :: MonadGen m => m Char
binit :: m Char
binit =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'0' Char
'1'

-- | Generates an ASCII octit: @'0'..'7'@
--
octit :: MonadGen m => m Char
octit :: m Char
octit =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'0' Char
'7'

-- | Generates an ASCII digit: @'0'..'9'@
--
digit :: MonadGen m => m Char
digit :: m Char
digit =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'0' Char
'9'

-- | Generates an ASCII hexit: @'0'..'9', \'a\'..\'f\', \'A\'..\'F\'@
--
hexit :: MonadGen m => m Char
hexit :: m Char
hexit =
  -- FIXME optimize lookup, use a SmallArray or something.
  String -> m Char
forall (m :: * -> *) a. MonadGen m => [a] -> m a
element String
"0123456789aAbBcCdDeEfF"

-- | Generates an ASCII lowercase letter: @\'a\'..\'z\'@
--
lower :: MonadGen m => m Char
lower :: m Char
lower =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'a' Char
'z'

-- | Generates an ASCII uppercase letter: @\'A\'..\'Z\'@
--
upper :: MonadGen m => m Char
upper :: m Char
upper =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'A' Char
'Z'

-- | Generates an ASCII letter: @\'a\'..\'z\', \'A\'..\'Z\'@
--
alpha :: MonadGen m => m Char
alpha :: m Char
alpha =
  -- FIXME optimize lookup, use a SmallArray or something.
  String -> m Char
forall (m :: * -> *) a. MonadGen m => [a] -> m a
element String
"abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"

-- | Generates an ASCII letter or digit: @\'a\'..\'z\', \'A\'..\'Z\', \'0\'..\'9\'@
--
alphaNum :: MonadGen m => m Char
alphaNum :: m Char
alphaNum =
  -- FIXME optimize lookup, use a SmallArray or something.
  String -> m Char
forall (m :: * -> *) a. MonadGen m => [a] -> m a
element String
"abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

-- | Generates an ASCII character: @'\0'..'\127'@
--
ascii :: MonadGen m => m Char
ascii :: m Char
ascii =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'\0' Char
'\127'

-- | Generates a Latin-1 character: @'\0'..'\255'@
--
latin1 :: MonadGen m => m Char
latin1 :: m Char
latin1 =
  Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'\0' Char
'\255'

-- | Generates a Unicode character, excluding noncharacters and invalid standalone surrogates:
--   @'\0'..'\1114111' (excluding '\55296'..'\57343', '\65534', '\65535')@
--
unicode :: (MonadGen m) => m Char
unicode :: m Char
unicode =
  let
    s1 :: (Int, m Char)
s1 =
      (Int
55296, Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'\0' Char
'\55295')
    s2 :: (Int, m Char)
s2 =
      (Int
8190, Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'\57344' Char
'\65533')
    s3 :: (Int, m Char)
s3 =
      (Int
1048576, Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum Char
'\65536' Char
'\1114111')
  in
    [(Int, m Char)] -> m Char
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
frequency [(Int, m Char)
s1, (Int, m Char)
s2, (Int, m Char)
s3]

-- | Generates a Unicode character, including noncharacters and invalid standalone surrogates:
--   @'\0'..'\1114111'@
--
unicodeAll :: MonadGen m => m Char
unicodeAll :: m Char
unicodeAll =
  m Char
forall (m :: * -> *) a. (MonadGen m, Enum a, Bounded a) => m a
enumBounded

-- | Check if a character is in the surrogate category.
--
isSurrogate :: Char -> Bool
isSurrogate :: Char -> Bool
isSurrogate Char
x =
  Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\55296' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\57343'

-- | Check if a character is one of the noncharacters '\65534', '\65535'.
--
isNoncharacter :: Char -> Bool
isNoncharacter :: Char -> Bool
isNoncharacter Char
x =
  Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\65534' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\65535'

------------------------------------------------------------------------
-- Combinators - Strings

-- | Generates a string using 'Range' to determine the length.
--
--   /This is a specialization of 'list', offered for convenience./
--
string :: MonadGen m => Range Int -> m Char -> m String
string :: Range Int -> m Char -> m String
string =
  Range Int -> m Char -> m String
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
list

-- | Generates a string using 'Range' to determine the length.
--
text :: MonadGen m => Range Int -> m Char -> m Text
text :: Range Int -> m Char -> m Text
text Range Int
range =
  (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (m String -> m Text) -> (m Char -> m String) -> m Char -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Int -> m Char -> m String
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
string Range Int
range

-- | Generates a UTF-8 encoded string, using 'Range' to determine the length.
--
utf8 :: MonadGen m => Range Int -> m Char -> m ByteString
utf8 :: Range Int -> m Char -> m ByteString
utf8 Range Int
range =
  (Text -> ByteString) -> m Text -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
Text.encodeUtf8 (m Text -> m ByteString)
-> (m Char -> m Text) -> m Char -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
text Range Int
range

-- | Generates a random 'ByteString', using 'Range' to determine the
--   length.
--
bytes :: MonadGen m => Range Int -> m ByteString
bytes :: Range Int -> m ByteString
bytes Range Int
range =
  ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
ByteString.pack (m [Word8] -> m ByteString) -> m [Word8] -> m ByteString
forall a b. (a -> b) -> a -> b
$
  [m [Word8]] -> m [Word8]
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
choice [
      Range Int -> m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
list Range Int
range (m Word8 -> m [Word8])
-> (Range Word8 -> m Word8) -> Range Word8 -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Word8 -> m Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
word8 (Range Word8 -> m [Word8]) -> Range Word8 -> m [Word8]
forall a b. (a -> b) -> a -> b
$
        Word8 -> Word8 -> Range Word8
forall a. a -> a -> Range a
Range.constant
          (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
Char.ord Char
'a')
          (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
Char.ord Char
'z')

    , Range Int -> m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
list Range Int
range (m Word8 -> m [Word8])
-> (Range Word8 -> m Word8) -> Range Word8 -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Word8 -> m Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
word8 (Range Word8 -> m [Word8]) -> Range Word8 -> m [Word8]
forall a b. (a -> b) -> a -> b
$
        Word8 -> Word8 -> Range Word8
forall a. a -> a -> Range a
Range.constant Word8
forall a. Bounded a => a
minBound Word8
forall a. Bounded a => a
maxBound
    ]

------------------------------------------------------------------------
-- Combinators - Choice

-- | Trivial generator that always produces the same element.
--
--   /This is another name for 'pure' \/ 'return'./
constant :: MonadGen m => a -> m a
constant :: a -> m a
constant =
  a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Randomly selects one of the elements in the list.
--
--   This generator shrinks towards the first element in the list.
--
--   /The input list must be non-empty./
--
element :: MonadGen m => [a] -> m a
element :: [a] -> m a
element = \case
  [] ->
    String -> m a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.element: used with empty list"
  [a]
xs -> do
    Int
n <- Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral (Range Int -> m Int) -> Range Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant 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)
    pure $ [a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
n

-- | Randomly selects one of the elements in the list.
--
--   This generator does not shrink the choice of element.
--
--   /The input list must be non-empty./
--
element_ :: MonadGen m => [a] -> m a
element_ :: [a] -> m a
element_ = \case
  [] ->
    String -> m a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.element: used with empty list"
  [a]
xs -> do
    Int
n <- Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral_ (Range Int -> m Int) -> Range Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant 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)
    pure $ [a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
n

-- | Randomly selects one of the generators in the list.
--
--   This generator shrinks towards the first generator in the list.
--
--   /The input list must be non-empty./
--
choice :: MonadGen m => [m a] -> m a
choice :: [m a] -> m a
choice = \case
  [] ->
    String -> m a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.choice: used with empty list"
  [m a]
xs -> do
    Int
n <- Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral (Range Int -> m Int) -> Range Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 ([m a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    [m a]
xs [m a] -> Int -> m a
forall a. [a] -> Int -> a
!! Int
n

-- | Uses a weighted distribution to randomly select one of the generators in
--   the list.
--
--   This generator shrinks towards the first generator in the list.
--
--   /The input list must be non-empty./
--
frequency :: MonadGen m => [(Int, m a)] -> m a
frequency :: [(Int, m a)] -> m a
frequency = \case
  [] ->
    String -> m a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.frequency: used with empty list"
  [(Int, m a)]
xs0 -> do
    let
      pick :: t -> [(t, p)] -> p
pick t
n = \case
        [] ->
          String -> p
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.frequency/pick: used with empty list"
        (t
k, p
x) : [(t, p)]
xs ->
          if t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
k then
            p
x
          else
            t -> [(t, p)] -> p
pick (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
k) [(t, p)]
xs

      iis :: [Int]
iis =
        (Int -> Int -> Int) -> [Int] -> [Int]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (((Int, m a) -> Int) -> [(Int, m a)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, m a) -> Int
forall a b. (a, b) -> a
fst [(Int, m a)]
xs0)

      total :: Int
total =
        [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, m a) -> Int) -> [(Int, m a)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, m a) -> Int
forall a b. (a, b) -> a
fst [(Int, m a)]
xs0)

    Int
n <- (Int -> [Int]) -> m Int -> m Int
forall (m :: * -> *) a. MonadGen m => (a -> [a]) -> m a -> m a
shrink (\Int
n -> (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
iis) (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral_ (Range Int -> m Int) -> Range Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
1 Int
total
    Int -> [(Int, m a)] -> m a
forall t p. (Ord t, Num t) => t -> [(t, p)] -> p
pick Int
n [(Int, m a)]
xs0

-- | Modifies combinators which choose from a list of generators, like 'choice'
--   or 'frequency', so that they can be used in recursive scenarios.
--
--   This combinator modifies its target to select one of the generators in
--   either the non-recursive or the recursive list. When a selection is made
--   from the recursive list, the 'Size' is halved. When the 'Size' gets to one
--   or less, selections are no longer made from the recursive list, this
--   ensures termination.
--
--   A good example of where this might be useful is abstract syntax trees:
--
-- @
-- data Expr =
--     Var String
--   | Lam String Expr
--   | App Expr Expr
--
-- -- Assuming we have a name generator
-- genName :: 'MonadGen' m => m String
--
-- -- We can write a generator for expressions
-- genExpr :: 'MonadGen' m => m Expr
-- genExpr =
--   Gen.'recursive' Gen.'choice' [
--       -- non-recursive generators
--       Var '<$>' genName
--     ] [
--       -- recursive generators
--       Gen.'subtermM' genExpr (\x -> Lam '<$>' genName '<*>' pure x)
--     , Gen.'subterm2' genExpr genExpr App
--     ]
-- @
--
--   If we wrote the above example using only 'choice', it is likely that it
--   would fail to terminate. This is because for every call to @genExpr@,
--   there is a 2 in 3 chance that we will recurse again.
--
recursive :: MonadGen m => ([m a] -> m a) -> [m a] -> [m a] -> m a
recursive :: ([m a] -> m a) -> [m a] -> [m a] -> m a
recursive [m a] -> m a
f [m a]
nonrec [m a]
rec =
  (Size -> m a) -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> m a) -> m a
sized ((Size -> m a) -> m a) -> (Size -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Size
n ->
    if Size
n Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 then
      [m a] -> m a
f [m a]
nonrec
    else
      [m a] -> m a
f ([m a] -> m a) -> [m a] -> m a
forall a b. (a -> b) -> a -> b
$ [m a]
nonrec [m a] -> [m a] -> [m a]
forall a. [a] -> [a] -> [a]
++ (m a -> m a) -> [m a] -> [m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m a -> m a
forall (m :: * -> *) a. MonadGen m => m a -> m a
small [m a]
rec

------------------------------------------------------------------------
-- Combinators - Conditional

-- | Discards the whole generator.
--
discard :: MonadGen m => m a
discard :: m a
discard =
  GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT GenT (GenBase m) a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Discards the generator if the generated value does not satisfy the
--   predicate.
--
ensure :: MonadGen m => (a -> Bool) -> m a -> m a
ensure :: (a -> Bool) -> m a -> m a
ensure a -> Bool
p m a
gen = do
  a
x <- m a
gen
  if a -> Bool
p a
x then
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  else
    m a
forall (m :: * -> *) a. MonadGen m => m a
discard

fromPred :: (a -> Bool) -> a -> Maybe a
fromPred :: (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p a
a = a
a a -> Maybe () -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
a)

-- | Generates a value that satisfies a predicate.
--
--   This is essentially:
--
-- @
--   filter p gen = 'mfilter' p gen '<|>' filter p gen
-- @
--
--   It differs from the above in that we keep some state to avoid looping
--   forever. If we trigger these limits then the whole generator is discarded.
--
filter :: (MonadGen m, GenBase m ~ Identity) => (a -> Bool) -> m a -> m a
filter :: (a -> Bool) -> m a -> m a
filter a -> Bool
p =
  (a -> Maybe a) -> m a -> m a
forall (m :: * -> *) a b.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Maybe b) -> m a -> m b
mapMaybe ((a -> Bool) -> a -> Maybe a
forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)

mapMaybe :: (MonadGen m, GenBase m ~ Identity) => (a -> Maybe b) -> m a -> m b
mapMaybe :: (a -> Maybe b) -> m a -> m b
mapMaybe a -> Maybe b
p m a
gen0 =
  let
    try :: Size -> m b
try Size
k =
      if Size
k Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
100 then
        m b
forall (m :: * -> *) a. MonadGen m => m a
discard
      else do
        (a
x, m a
gen) <- m a -> m (a, m a)
forall (m :: * -> *) a. MonadGen m => m a -> m (a, m a)
freeze (m a -> m (a, m a)) -> m a -> m (a, m a)
forall a b. (a -> b) -> a -> b
$ (Size -> Size) -> m a -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> Size) -> m a -> m a
scale (Size
2 Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
k Size -> Size -> Size
forall a. Num a => a -> a -> a
+) m a
gen0

        case a -> Maybe b
p a
x of
          Just b
_ ->
            (GenT (GenBase m) a -> GenT (GenBase m) b) -> m a -> m b
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b)
-> GenT Identity a -> GenT Identity b
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT ((a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
forall a b.
(a -> Maybe b)
-> TreeT (MaybeT Identity) a -> TreeT (MaybeT Identity) b
Tree.mapMaybeMaybeT a -> Maybe b
p)) m a
gen
          Maybe b
Nothing ->
            Size -> m b
try (Size
k Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1)
  in
    Size -> m b
try Size
0

filterT :: MonadGen m => (a -> Bool) -> m a -> m a
filterT :: (a -> Bool) -> m a -> m a
filterT a -> Bool
p =
  (a -> Maybe a) -> m a -> m a
forall (m :: * -> *) a b.
MonadGen m =>
(a -> Maybe b) -> m a -> m b
mapMaybeT ((a -> Bool) -> a -> Maybe a
forall a. (a -> Bool) -> a -> Maybe a
fromPred a -> Bool
p)

mapMaybeT :: MonadGen m => (a -> Maybe b) -> m a -> m b
mapMaybeT :: (a -> Maybe b) -> m a -> m b
mapMaybeT a -> Maybe b
p m a
gen0 =
  let
    try :: Size -> m b
try Size
k =
      if Size
k Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
100 then
        m b
forall (m :: * -> *) a. MonadGen m => m a
discard
      else do
        (a
x, m a
gen) <- m a -> m (a, m a)
forall (m :: * -> *) a. MonadGen m => m a -> m (a, m a)
freeze (m a -> m (a, m a)) -> m a -> m (a, m a)
forall a b. (a -> b) -> a -> b
$ (Size -> Size) -> m a -> m a
forall (m :: * -> *) a. MonadGen m => (Size -> Size) -> m a -> m a
scale (Size
2 Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
k Size -> Size -> Size
forall a. Num a => a -> a -> a
+) m a
gen0

        case a -> Maybe b
p a
x of
          Just b
_ ->
            (GenT (GenBase m) a -> GenT (GenBase m) b) -> m a -> m b
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((TreeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) b)
-> GenT (GenBase m) a -> GenT (GenBase m) b
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT ((a -> Maybe b)
-> TreeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) b
forall (m :: * -> *) a b.
(Monad m, Alternative m) =>
(a -> Maybe b) -> TreeT m a -> TreeT m b
Tree.mapMaybeT a -> Maybe b
p)) m a
gen
          Maybe b
Nothing ->
            Size -> m b
try (Size
k Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1)
  in
    Size -> m b
try Size
0

-- | Runs a 'Maybe' generator until it produces a 'Just'.
--
--   /This is implemented using 'filter' and has the same caveats./
--
just :: (MonadGen m, GenBase m ~ Identity) => m (Maybe a) -> m a
just :: m (Maybe a) -> m a
just m (Maybe a)
g = do
  Maybe a
mx <- (Maybe a -> Bool) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
filter Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isJust m (Maybe a)
g
  case Maybe a
mx of
    Just a
x ->
      a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Maybe a
Nothing ->
      String -> m a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.just: internal error, unexpected Nothing"

-- | Runs a 'Maybe' generator until it produces a 'Just'.
--
--   /This is implemented using 'filter' and has the same caveats./
--
justT :: MonadGen m => m (Maybe a) -> m a
justT :: m (Maybe a) -> m a
justT m (Maybe a)
g = do
  Maybe a
mx <- (Maybe a -> Bool) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
filterT Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isJust m (Maybe a)
g
  case Maybe a
mx of
    Just a
x ->
      a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Maybe a
Nothing ->
      String -> m a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.just: internal error, unexpected Nothing"

------------------------------------------------------------------------
-- Combinators - Collections

-- | Generates a 'Nothing' some of the time.
--
maybe :: MonadGen m => m a -> m (Maybe a)
maybe :: m a -> m (Maybe a)
maybe m a
gen =
  (Size -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a. MonadGen m => (Size -> m a) -> m a
sized ((Size -> m (Maybe a)) -> m (Maybe a))
-> (Size -> m (Maybe a)) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Size
n ->
    [(Int, m (Maybe a))] -> m (Maybe a)
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
frequency [
        (Int
2, Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
      , (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
n, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
gen)
      ]

-- | Generates either an 'a' or a 'b'.
--
--   As the size grows, this generator generates @Right@s more often than @Left@s.
--
either :: MonadGen m => m a -> m b -> m (Either a b)
either :: m a -> m b -> m (Either a b)
either m a
genA m b
genB =
  (Size -> m (Either a b)) -> m (Either a b)
forall (m :: * -> *) a. MonadGen m => (Size -> m a) -> m a
sized ((Size -> m (Either a b)) -> m (Either a b))
-> (Size -> m (Either a b)) -> m (Either a b)
forall a b. (a -> b) -> a -> b
$ \Size
n ->
    [(Int, m (Either a b))] -> m (Either a b)
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
frequency [
        (Int
2, a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
genA)
      , (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
n, b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
genB)
      ]

-- | Generates either an 'a' or a 'b', without bias.
--
--   This generator generates as many @Right@s as it does @Left@s.
--
either_ :: MonadGen m => m a -> m b -> m (Either a b)
either_ :: m a -> m b -> m (Either a b)
either_ m a
genA m b
genB =
    [m (Either a b)] -> m (Either a b)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
choice [
      a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
genA
    , b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
genB
    ]

-- | Generates a list using a 'Range' to determine the length.
--
list :: MonadGen m => Range Int -> m a -> m [a]
list :: Range Int -> m a -> m [a]
list Range Int
range m a
gen =
  let
     interleave :: MaybeT (GenBase m) (NodeT m [TreeT (MaybeT (GenBase m)) a])
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
interleave =
       ([TreeT (MaybeT (GenBase m)) a]
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
forall (m :: * -> *) a. Monad m => [TreeT m a] -> m (NodeT m [a])
interleaveTreeT ([TreeT (MaybeT (GenBase m)) a]
 -> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a]))
-> (NodeT m [TreeT (MaybeT (GenBase m)) a]
    -> [TreeT (MaybeT (GenBase m)) a])
-> NodeT m [TreeT (MaybeT (GenBase m)) a]
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT m [TreeT (MaybeT (GenBase m)) a]
-> [TreeT (MaybeT (GenBase m)) a]
forall (m :: * -> *) a. NodeT m a -> a
nodeValue (NodeT m [TreeT (MaybeT (GenBase m)) a]
 -> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a]))
-> MaybeT (GenBase m) (NodeT m [TreeT (MaybeT (GenBase m)) a])
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
  in
    (Size -> m [a]) -> m [a]
forall (m :: * -> *) a. MonadGen m => (Size -> m a) -> m a
sized ((Size -> m [a]) -> m [a]) -> (Size -> m [a]) -> m [a]
forall a b. (a -> b) -> a -> b
$ \Size
size ->
      ([a] -> Bool) -> m [a] -> m [a]
forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
ensure (Int -> [a] -> Bool
forall a. Int -> [a] -> Bool
atLeast (Int -> [a] -> Bool) -> Int -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ Size -> Range Int -> Int
forall a. Ord a => Size -> Range a -> a
Range.lowerBound Size
size Range Int
range) (m [a] -> m [a])
-> (m [TreeT (MaybeT (GenBase m)) a] -> m [a])
-> m [TreeT (MaybeT (GenBase m)) a]
-> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (GenT (GenBase m) [TreeT (MaybeT (GenBase m)) a]
 -> GenT (GenBase m) [a])
-> m [TreeT (MaybeT (GenBase m)) a] -> m [a]
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((TreeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]
 -> TreeT (MaybeT (GenBase m)) [a])
-> GenT (GenBase m) [TreeT (MaybeT (GenBase m)) a]
-> GenT (GenBase m) [a]
forall (m :: * -> *) a (n :: * -> *) b.
(TreeT (MaybeT m) a -> TreeT (MaybeT n) b) -> GenT m a -> GenT n b
mapGenT (MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
-> TreeT (MaybeT (GenBase m)) [a]
forall (m :: * -> *) a. m (NodeT m a) -> TreeT m a
TreeT (MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
 -> TreeT (MaybeT (GenBase m)) [a])
-> (TreeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]
    -> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a]))
-> TreeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]
-> TreeT (MaybeT (GenBase m)) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT
  (GenBase m)
  (NodeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a])
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
forall (m :: * -> *) a.
MaybeT (GenBase m) (NodeT m [TreeT (MaybeT (GenBase m)) a])
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
interleave (MaybeT
   (GenBase m)
   (NodeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a])
 -> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a]))
-> (TreeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]
    -> MaybeT
         (GenBase m)
         (NodeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]))
-> TreeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a]
-> MaybeT
     (GenBase m)
     (NodeT (MaybeT (GenBase m)) [TreeT (MaybeT (GenBase m)) a])
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT)) (m [TreeT (MaybeT (GenBase m)) a] -> m [a])
-> m [TreeT (MaybeT (GenBase m)) a] -> m [a]
forall a b. (a -> b) -> a -> b
$ do
        Int
n <- Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral_ Range Int
range
        Int
-> m (TreeT (MaybeT (GenBase m)) a)
-> m [TreeT (MaybeT (GenBase m)) a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (m a -> m (TreeT (MaybeT (GenBase m)) a)
forall (m :: * -> *) a.
MonadGen m =>
m a -> m (TreeT (MaybeT (GenBase m)) a)
toTreeMaybeT m a
gen)

interleaveTreeT :: Monad m => [TreeT m a] -> m (NodeT m [a])
interleaveTreeT :: [TreeT m a] -> m (NodeT m [a])
interleaveTreeT =
  ([NodeT m a] -> NodeT m [a]) -> m [NodeT m a] -> m (NodeT m [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NodeT m a] -> NodeT m [a]
forall (m :: * -> *) a. Monad m => [NodeT m a] -> NodeT m [a]
Tree.interleave (m [NodeT m a] -> m (NodeT m [a]))
-> ([TreeT m a] -> m [NodeT m a]) -> [TreeT m a] -> m (NodeT m [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TreeT m a -> m (NodeT m a)) -> [TreeT m a] -> m [NodeT m a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TreeT m a -> m (NodeT m a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT

-- | Generates a seq using a 'Range' to determine the length.
--
seq :: MonadGen m => Range Int -> m a -> m (Seq a)
seq :: Range Int -> m a -> m (Seq a)
seq Range Int
range m a
gen =
  [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> m [a] -> m (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m a -> m [a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
list Range Int
range m a
gen

-- | Generates a non-empty list using a 'Range' to determine the length.
--
nonEmpty :: MonadGen m => Range Int -> m a -> m (NonEmpty a)
nonEmpty :: Range Int -> m a -> m (NonEmpty a)
nonEmpty Range Int
range m a
gen = do
  [a]
xs <- Range Int -> m a -> m [a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
list ((Int -> Int) -> Range Int -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1) Range Int
range) m a
gen
  case [a]
xs of
    [] ->
      String -> m (NonEmpty a)
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.nonEmpty: internal error, generated empty list"
    [a]
_ ->
      NonEmpty a -> m (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty a -> m (NonEmpty a)) -> NonEmpty a -> m (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList [a]
xs

-- | Generates a set using a 'Range' to determine the length.
--
--   /This may fail to generate anything if the element generator/
--   /cannot produce a large enough number of unique items to satify/
--   /the required set size./
--
set :: (MonadGen m, Ord a) => Range Int -> m a -> m (Set a)
set :: Range Int -> m a -> m (Set a)
set Range Int
range m a
gen =
  (Map a () -> Set a) -> m (Map a ()) -> m (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map a () -> Set a
forall k a. Map k a -> Set k
Map.keysSet (m (Map a ()) -> m (Set a))
-> (m (a, ()) -> m (Map a ())) -> m (a, ()) -> m (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Int -> m (a, ()) -> m (Map a ())
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
map Range Int
range (m (a, ()) -> m (Set a)) -> m (a, ()) -> m (Set a)
forall a b. (a -> b) -> a -> b
$ (a -> (a, ())) -> m a -> m (a, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) m a
gen

-- | Generates a map using a 'Range' to determine the length.
--
--   /This may fail to generate anything if the keys produced by the/
--   /generator do not account for a large enough number of unique/
--   /items to satify the required map size./
--
map :: (MonadGen m, Ord k) => Range Int -> m (k, v) -> m (Map k v)
map :: Range Int -> m (k, v) -> m (Map k v)
map Range Int
range m (k, v)
gen =
  (Size -> m (Map k v)) -> m (Map k v)
forall (m :: * -> *) a. MonadGen m => (Size -> m a) -> m a
sized ((Size -> m (Map k v)) -> m (Map k v))
-> (Size -> m (Map k v)) -> m (Map k v)
forall a b. (a -> b) -> a -> b
$ \Size
size ->
    (Map k v -> Bool) -> m (Map k v) -> m (Map k v)
forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
ensure ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Size -> Range Int -> Int
forall a. Ord a => Size -> Range a -> a
Range.lowerBound Size
size Range Int
range) (Int -> Bool) -> (Map k v -> Int) -> Map k v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> Int
forall k a. Map k a -> Int
Map.size) (m (Map k v) -> m (Map k v))
-> (m [m (k, v)] -> m (Map k v)) -> m [m (k, v)] -> m (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([(k, v)] -> Map k v) -> m [(k, v)] -> m (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(k, v)] -> m (Map k v))
-> (m [m (k, v)] -> m [(k, v)]) -> m [m (k, v)] -> m (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([m (k, v)] -> m [(k, v)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (k, v)] -> m [(k, v)]) -> m [m (k, v)] -> m [(k, v)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m [m (k, v)] -> m [(k, v)])
-> (m [m (k, v)] -> m [m (k, v)]) -> m [m (k, v)] -> m [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([m (k, v)] -> [[m (k, v)]]) -> m [m (k, v)] -> m [m (k, v)]
forall (m :: * -> *) a. MonadGen m => (a -> [a]) -> m a -> m a
shrink [m (k, v)] -> [[m (k, v)]]
forall a. [a] -> [[a]]
Shrink.list (m [m (k, v)] -> m (Map k v)) -> m [m (k, v)] -> m (Map k v)
forall a b. (a -> b) -> a -> b
$ do
      Int
k <- Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral_ Range Int
range
      Int -> m (k, v) -> m [m (k, v)]
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Int -> m (k, v) -> m [m (k, v)]
uniqueByKey Int
k m (k, v)
gen

-- | Generate exactly 'n' unique generators.
--
uniqueByKey :: (MonadGen m, Ord k) => Int -> m (k, v) -> m [m (k, v)]
uniqueByKey :: Int -> m (k, v) -> m [m (k, v)]
uniqueByKey Int
n m (k, v)
gen =
  let
    try :: Int -> Map k (m (k, v)) -> m [m (k, v)]
try Int
k Map k (m (k, v))
xs0 =
      if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 then
        m [m (k, v)]
forall (m :: * -> *) a. MonadGen m => m a
discard
      else
        Int -> m ((k, v), m (k, v)) -> m [((k, v), m (k, v))]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (m (k, v) -> m ((k, v), m (k, v))
forall (m :: * -> *) a. MonadGen m => m a -> m (a, m a)
freeze m (k, v)
gen) m [((k, v), m (k, v))]
-> ([((k, v), m (k, v))] -> m [m (k, v)]) -> m [m (k, v)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[((k, v), m (k, v))]
kvs ->
        case Int
-> Map k (m (k, v))
-> [(k, m (k, v))]
-> Either (Map k (m (k, v))) (Map k (m (k, v)))
forall k v.
Ord k =>
Int -> Map k v -> [(k, v)] -> Either (Map k v) (Map k v)
uniqueInsert Int
n Map k (m (k, v))
xs0 ((((k, v), m (k, v)) -> (k, m (k, v)))
-> [((k, v), m (k, v))] -> [(k, m (k, v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((k, v) -> k) -> ((k, v), m (k, v)) -> (k, m (k, v))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (k, v) -> k
forall a b. (a, b) -> a
fst) [((k, v), m (k, v))]
kvs) of
          Left Map k (m (k, v))
xs ->
            [m (k, v)] -> m [m (k, v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([m (k, v)] -> m [m (k, v)]) -> [m (k, v)] -> m [m (k, v)]
forall a b. (a -> b) -> a -> b
$ Map k (m (k, v)) -> [m (k, v)]
forall k a. Map k a -> [a]
Map.elems Map k (m (k, v))
xs
          Right Map k (m (k, v))
xs ->
            Int -> Map k (m (k, v)) -> m [m (k, v)]
try (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Map k (m (k, v))
xs
  in
    Int -> Map k (m (k, v)) -> m [m (k, v)]
try (Int
0 :: Int) Map k (m (k, v))
forall k a. Map k a
Map.empty

uniqueInsert :: Ord k => Int -> Map k v -> [(k, v)] -> Either (Map k v) (Map k v)
uniqueInsert :: Int -> Map k v -> [(k, v)] -> Either (Map k v) (Map k v)
uniqueInsert Int
n Map k v
xs [(k, v)]
kvs0 =
  if Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n then
    Map k v -> Either (Map k v) (Map k v)
forall a b. a -> Either a b
Left Map k v
xs
  else
    case [(k, v)]
kvs0 of
      [] ->
        Map k v -> Either (Map k v) (Map k v)
forall a b. b -> Either a b
Right Map k v
xs
      (k
k, v
v) : [(k, v)]
kvs ->
        Int -> Map k v -> [(k, v)] -> Either (Map k v) (Map k v)
forall k v.
Ord k =>
Int -> Map k v -> [(k, v)] -> Either (Map k v) (Map k v)
uniqueInsert Int
n ((v -> v -> v) -> k -> v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\v
x v
_ -> v
x) k
k v
v Map k v
xs) [(k, v)]
kvs

-- | Check that list contains at least a certain number of elements.
--
atLeast :: Int -> [a] -> Bool
atLeast :: Int -> [a] -> Bool
atLeast Int
n =
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
    Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
True
  else
    Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

------------------------------------------------------------------------
-- Combinators - Subterms

data Subterms n a =
    One a
  | All (Vec n a)
    deriving (a -> Subterms n b -> Subterms n a
(a -> b) -> Subterms n a -> Subterms n b
(forall a b. (a -> b) -> Subterms n a -> Subterms n b)
-> (forall a b. a -> Subterms n b -> Subterms n a)
-> Functor (Subterms n)
forall a b. a -> Subterms n b -> Subterms n a
forall a b. (a -> b) -> Subterms n a -> Subterms n b
forall (n :: Nat) a b. a -> Subterms n b -> Subterms n a
forall (n :: Nat) a b. (a -> b) -> Subterms n a -> Subterms n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Subterms n b -> Subterms n a
$c<$ :: forall (n :: Nat) a b. a -> Subterms n b -> Subterms n a
fmap :: (a -> b) -> Subterms n a -> Subterms n b
$cfmap :: forall (n :: Nat) a b. (a -> b) -> Subterms n a -> Subterms n b
Functor, Subterms n a -> Bool
(a -> m) -> Subterms n a -> m
(a -> b -> b) -> b -> Subterms n a -> b
(forall m. Monoid m => Subterms n m -> m)
-> (forall m a. Monoid m => (a -> m) -> Subterms n a -> m)
-> (forall m a. Monoid m => (a -> m) -> Subterms n a -> m)
-> (forall a b. (a -> b -> b) -> b -> Subterms n a -> b)
-> (forall a b. (a -> b -> b) -> b -> Subterms n a -> b)
-> (forall b a. (b -> a -> b) -> b -> Subterms n a -> b)
-> (forall b a. (b -> a -> b) -> b -> Subterms n a -> b)
-> (forall a. (a -> a -> a) -> Subterms n a -> a)
-> (forall a. (a -> a -> a) -> Subterms n a -> a)
-> (forall a. Subterms n a -> [a])
-> (forall a. Subterms n a -> Bool)
-> (forall a. Subterms n a -> Int)
-> (forall a. Eq a => a -> Subterms n a -> Bool)
-> (forall a. Ord a => Subterms n a -> a)
-> (forall a. Ord a => Subterms n a -> a)
-> (forall a. Num a => Subterms n a -> a)
-> (forall a. Num a => Subterms n a -> a)
-> Foldable (Subterms n)
forall a. Eq a => a -> Subterms n a -> Bool
forall a. Num a => Subterms n a -> a
forall a. Ord a => Subterms n a -> a
forall m. Monoid m => Subterms n m -> m
forall a. Subterms n a -> Bool
forall a. Subterms n a -> Int
forall a. Subterms n a -> [a]
forall a. (a -> a -> a) -> Subterms n a -> a
forall m a. Monoid m => (a -> m) -> Subterms n a -> m
forall b a. (b -> a -> b) -> b -> Subterms n a -> b
forall a b. (a -> b -> b) -> b -> Subterms n a -> b
forall (n :: Nat) a. Eq a => a -> Subterms n a -> Bool
forall (n :: Nat) a. Num a => Subterms n a -> a
forall (n :: Nat) a. Ord a => Subterms n a -> a
forall (n :: Nat) m. Monoid m => Subterms n m -> m
forall (n :: Nat) a. Subterms n a -> Bool
forall (n :: Nat) a. Subterms n a -> Int
forall (n :: Nat) a. Subterms n a -> [a]
forall (n :: Nat) a. (a -> a -> a) -> Subterms n a -> a
forall (n :: Nat) m a. Monoid m => (a -> m) -> Subterms n a -> m
forall (n :: Nat) b a. (b -> a -> b) -> b -> Subterms n a -> b
forall (n :: Nat) a b. (a -> b -> b) -> b -> Subterms n a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Subterms n a -> a
$cproduct :: forall (n :: Nat) a. Num a => Subterms n a -> a
sum :: Subterms n a -> a
$csum :: forall (n :: Nat) a. Num a => Subterms n a -> a
minimum :: Subterms n a -> a
$cminimum :: forall (n :: Nat) a. Ord a => Subterms n a -> a
maximum :: Subterms n a -> a
$cmaximum :: forall (n :: Nat) a. Ord a => Subterms n a -> a
elem :: a -> Subterms n a -> Bool
$celem :: forall (n :: Nat) a. Eq a => a -> Subterms n a -> Bool
length :: Subterms n a -> Int
$clength :: forall (n :: Nat) a. Subterms n a -> Int
null :: Subterms n a -> Bool
$cnull :: forall (n :: Nat) a. Subterms n a -> Bool
toList :: Subterms n a -> [a]
$ctoList :: forall (n :: Nat) a. Subterms n a -> [a]
foldl1 :: (a -> a -> a) -> Subterms n a -> a
$cfoldl1 :: forall (n :: Nat) a. (a -> a -> a) -> Subterms n a -> a
foldr1 :: (a -> a -> a) -> Subterms n a -> a
$cfoldr1 :: forall (n :: Nat) a. (a -> a -> a) -> Subterms n a -> a
foldl' :: (b -> a -> b) -> b -> Subterms n a -> b
$cfoldl' :: forall (n :: Nat) b a. (b -> a -> b) -> b -> Subterms n a -> b
foldl :: (b -> a -> b) -> b -> Subterms n a -> b
$cfoldl :: forall (n :: Nat) b a. (b -> a -> b) -> b -> Subterms n a -> b
foldr' :: (a -> b -> b) -> b -> Subterms n a -> b
$cfoldr' :: forall (n :: Nat) a b. (a -> b -> b) -> b -> Subterms n a -> b
foldr :: (a -> b -> b) -> b -> Subterms n a -> b
$cfoldr :: forall (n :: Nat) a b. (a -> b -> b) -> b -> Subterms n a -> b
foldMap' :: (a -> m) -> Subterms n a -> m
$cfoldMap' :: forall (n :: Nat) m a. Monoid m => (a -> m) -> Subterms n a -> m
foldMap :: (a -> m) -> Subterms n a -> m
$cfoldMap :: forall (n :: Nat) m a. Monoid m => (a -> m) -> Subterms n a -> m
fold :: Subterms n m -> m
$cfold :: forall (n :: Nat) m. Monoid m => Subterms n m -> m
Foldable, Functor (Subterms n)
Foldable (Subterms n)
Functor (Subterms n)
-> Foldable (Subterms n)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Subterms n a -> f (Subterms n b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Subterms n (f a) -> f (Subterms n a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Subterms n a -> m (Subterms n b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Subterms n (m a) -> m (Subterms n a))
-> Traversable (Subterms n)
(a -> f b) -> Subterms n a -> f (Subterms n b)
forall (n :: Nat). Functor (Subterms n)
forall (n :: Nat). Foldable (Subterms n)
forall (n :: Nat) (m :: * -> *) a.
Monad m =>
Subterms n (m a) -> m (Subterms n a)
forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
Subterms n (f a) -> f (Subterms n a)
forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Subterms n a -> m (Subterms n b)
forall (n :: Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Subterms n a -> f (Subterms n b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Subterms n (m a) -> m (Subterms n a)
forall (f :: * -> *) a.
Applicative f =>
Subterms n (f a) -> f (Subterms n a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Subterms n a -> m (Subterms n b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Subterms n a -> f (Subterms n b)
sequence :: Subterms n (m a) -> m (Subterms n a)
$csequence :: forall (n :: Nat) (m :: * -> *) a.
Monad m =>
Subterms n (m a) -> m (Subterms n a)
mapM :: (a -> m b) -> Subterms n a -> m (Subterms n b)
$cmapM :: forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Subterms n a -> m (Subterms n b)
sequenceA :: Subterms n (f a) -> f (Subterms n a)
$csequenceA :: forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
Subterms n (f a) -> f (Subterms n a)
traverse :: (a -> f b) -> Subterms n a -> f (Subterms n b)
$ctraverse :: forall (n :: Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Subterms n a -> f (Subterms n b)
$cp2Traversable :: forall (n :: Nat). Foldable (Subterms n)
$cp1Traversable :: forall (n :: Nat). Functor (Subterms n)
Traversable)

data Nat =
    Z
  | S Nat

data Vec n a where
  Nil :: Vec 'Z a
  (:.) :: a -> Vec n a -> Vec ('S n) a

infixr 5 :.

deriving instance Functor (Vec n)
deriving instance Foldable (Vec n)
deriving instance Traversable (Vec n)

-- | Freeze the size and seed used by a generator, so we can inspect the value
--   which it will produce.
--
--   This is used for implementing `list` and `subtermMVec`. It allows us to
--   shrink the list itself before trying to shrink the values inside the list.
--
freeze :: MonadGen m => m a -> m (a, m a)
freeze :: m a -> m (a, m a)
freeze =
  (GenT (GenBase m) a -> GenT (GenBase m) (a, m a))
-> m a -> m (a, m a)
forall (m :: * -> *) (n :: * -> *) a b.
(MonadGen m, MonadGen n) =>
(GenT (GenBase m) a -> GenT (GenBase n) b) -> m a -> n b
withGenT ((GenT (GenBase m) a -> GenT (GenBase m) (a, m a))
 -> m a -> m (a, m a))
-> (GenT (GenBase m) a -> GenT (GenBase m) (a, m a))
-> m a
-> m (a, m a)
forall a b. (a -> b) -> a -> b
$ \GenT (GenBase m) a
gen ->
    (Size -> Seed -> TreeT (MaybeT (GenBase m)) (a, m a))
-> GenT (GenBase m) (a, m a)
forall (m :: * -> *) a.
(Size -> Seed -> TreeT (MaybeT m) a) -> GenT m a
GenT ((Size -> Seed -> TreeT (MaybeT (GenBase m)) (a, m a))
 -> GenT (GenBase m) (a, m a))
-> (Size -> Seed -> TreeT (MaybeT (GenBase m)) (a, m a))
-> GenT (GenBase m) (a, m a)
forall a b. (a -> b) -> a -> b
$ \Size
size Seed
seed -> do
      Maybe (NodeT (MaybeT (GenBase m)) a)
mx <- MaybeT (GenBase m) (Maybe (NodeT (MaybeT (GenBase m)) a))
-> TreeT
     (MaybeT (GenBase m)) (Maybe (NodeT (MaybeT (GenBase m)) a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MaybeT (GenBase m) (Maybe (NodeT (MaybeT (GenBase m)) a))
 -> TreeT
      (MaybeT (GenBase m)) (Maybe (NodeT (MaybeT (GenBase m)) a)))
-> (TreeT (MaybeT (GenBase m)) a
    -> MaybeT (GenBase m) (Maybe (NodeT (MaybeT (GenBase m)) a)))
-> TreeT (MaybeT (GenBase m)) a
-> TreeT
     (MaybeT (GenBase m)) (Maybe (NodeT (MaybeT (GenBase m)) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenBase m (Maybe (NodeT (MaybeT (GenBase m)) a))
-> MaybeT (GenBase m) (Maybe (NodeT (MaybeT (GenBase m)) a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GenBase m (Maybe (NodeT (MaybeT (GenBase m)) a))
 -> MaybeT (GenBase m) (Maybe (NodeT (MaybeT (GenBase m)) a)))
-> (TreeT (MaybeT (GenBase m)) a
    -> GenBase m (Maybe (NodeT (MaybeT (GenBase m)) a)))
-> TreeT (MaybeT (GenBase m)) a
-> MaybeT (GenBase m) (Maybe (NodeT (MaybeT (GenBase m)) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) a)
-> GenBase m (Maybe (NodeT (MaybeT (GenBase m)) a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) a)
 -> GenBase m (Maybe (NodeT (MaybeT (GenBase m)) a)))
-> (TreeT (MaybeT (GenBase m)) a
    -> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) a))
-> TreeT (MaybeT (GenBase m)) a
-> GenBase m (Maybe (NodeT (MaybeT (GenBase m)) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT (MaybeT (GenBase m)) a
-> MaybeT (GenBase m) (NodeT (MaybeT (GenBase m)) a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT (TreeT (MaybeT (GenBase m)) a
 -> TreeT
      (MaybeT (GenBase m)) (Maybe (NodeT (MaybeT (GenBase m)) a)))
-> TreeT (MaybeT (GenBase m)) a
-> TreeT
     (MaybeT (GenBase m)) (Maybe (NodeT (MaybeT (GenBase m)) a))
forall a b. (a -> b) -> a -> b
$ Size -> Seed -> GenT (GenBase m) a -> TreeT (MaybeT (GenBase m)) a
forall (m :: * -> *) a.
Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT Size
size Seed
seed GenT (GenBase m) a
gen
      case Maybe (NodeT (MaybeT (GenBase m)) a)
mx of
        Maybe (NodeT (MaybeT (GenBase m)) a)
Nothing ->
          TreeT (MaybeT (GenBase m)) (a, m a)
forall (f :: * -> *) a. Alternative f => f a
empty
        Just (NodeT a
x [TreeT (MaybeT (GenBase m)) a]
xs) ->
          (a, m a) -> TreeT (MaybeT (GenBase m)) (a, m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
fromGenT (GenT (GenBase m) a -> m a)
-> (NodeT (MaybeT (GenBase m)) a -> GenT (GenBase m) a)
-> NodeT (MaybeT (GenBase m)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeT (MaybeT (GenBase m)) a -> GenT (GenBase m) a
forall (m :: * -> *) a.
MonadGen m =>
TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT (TreeT (MaybeT (GenBase m)) a -> GenT (GenBase m) a)
-> (NodeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) a)
-> NodeT (MaybeT (GenBase m)) a
-> GenT (GenBase m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeT (MaybeT (GenBase m)) a -> TreeT (MaybeT (GenBase m)) a
forall (m :: * -> *) a. Applicative m => NodeT m a -> TreeT m a
Tree.fromNodeT (NodeT (MaybeT (GenBase m)) a -> m a)
-> NodeT (MaybeT (GenBase m)) a -> m a
forall a b. (a -> b) -> a -> b
$ a -> [TreeT (MaybeT (GenBase m)) a] -> NodeT (MaybeT (GenBase m)) a
forall (m :: * -> *) a. a -> [TreeT m a] -> NodeT m a
NodeT a
x [TreeT (MaybeT (GenBase m)) a]
xs)

shrinkSubterms :: Subterms n a -> [Subterms n a]
shrinkSubterms :: Subterms n a -> [Subterms n a]
shrinkSubterms = \case
  One a
_ ->
    []
  All Vec n a
xs ->
    (a -> Subterms n a) -> [a] -> [Subterms n a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Subterms n a
forall (n :: Nat) a. a -> Subterms n a
One ([a] -> [Subterms n a]) -> [a] -> [Subterms n a]
forall a b. (a -> b) -> a -> b
$ Vec n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vec n a
xs

genSubterms :: MonadGen m => Vec n (m a) -> m (Subterms n a)
genSubterms :: Vec n (m a) -> m (Subterms n a)
genSubterms =
  (Subterms n (m a) -> m (Subterms n a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Subterms n (m a) -> m (Subterms n a))
-> m (Subterms n (m a)) -> m (Subterms n a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (Subterms n (m a)) -> m (Subterms n a))
-> (Vec n (m a) -> m (Subterms n (m a)))
-> Vec n (m a)
-> m (Subterms n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Subterms n (m a) -> [Subterms n (m a)])
-> m (Subterms n (m a)) -> m (Subterms n (m a))
forall (m :: * -> *) a. MonadGen m => (a -> [a]) -> m a -> m a
shrink Subterms n (m a) -> [Subterms n (m a)]
forall (n :: Nat) a. Subterms n a -> [Subterms n a]
shrinkSubterms (m (Subterms n (m a)) -> m (Subterms n (m a)))
-> (Vec n (m a) -> m (Subterms n (m a)))
-> Vec n (m a)
-> m (Subterms n (m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Vec n (m a) -> Subterms n (m a))
-> m (Vec n (m a)) -> m (Subterms n (m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec n (m a) -> Subterms n (m a)
forall (n :: Nat) a. Vec n a -> Subterms n a
All (m (Vec n (m a)) -> m (Subterms n (m a)))
-> (Vec n (m a) -> m (Vec n (m a)))
-> Vec n (m a)
-> m (Subterms n (m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (m a -> m (m a)) -> Vec n (m a) -> m (Vec n (m a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((a, m a) -> m a) -> m (a, m a) -> m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, m a) -> m a
forall a b. (a, b) -> b
snd (m (a, m a) -> m (m a)) -> (m a -> m (a, m a)) -> m a -> m (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m (a, m a)
forall (m :: * -> *) a. MonadGen m => m a -> m (a, m a)
freeze)

fromSubterms :: Applicative m => (Vec n a -> m a) -> Subterms n a -> m a
fromSubterms :: (Vec n a -> m a) -> Subterms n a -> m a
fromSubterms Vec n a -> m a
f = \case
  One a
x ->
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  All Vec n a
xs ->
    Vec n a -> m a
f Vec n a
xs

-- | Constructs a generator from a number of sub-term generators.
--
--   /Shrinks to one of the sub-terms if possible./
--
subtermMVec :: MonadGen m => Vec n (m a) -> (Vec n a -> m a) -> m a
subtermMVec :: Vec n (m a) -> (Vec n a -> m a) -> m a
subtermMVec Vec n (m a)
gs Vec n a -> m a
f =
  (Vec n a -> m a) -> Subterms n a -> m a
forall (m :: * -> *) (n :: Nat) a.
Applicative m =>
(Vec n a -> m a) -> Subterms n a -> m a
fromSubterms Vec n a -> m a
f (Subterms n a -> m a) -> m (Subterms n a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vec n (m a) -> m (Subterms n a)
forall (m :: * -> *) (n :: Nat) a.
MonadGen m =>
Vec n (m a) -> m (Subterms n a)
genSubterms Vec n (m a)
gs

-- | Constructs a generator from a sub-term generator.
--
--   /Shrinks to the sub-term if possible./
--
subtermM :: MonadGen m => m a -> (a -> m a) -> m a
subtermM :: m a -> (a -> m a) -> m a
subtermM m a
gx a -> m a
f =
  Vec ('S 'Z) (m a) -> (Vec ('S 'Z) a -> m a) -> m a
forall (m :: * -> *) (n :: Nat) a.
MonadGen m =>
Vec n (m a) -> (Vec n a -> m a) -> m a
subtermMVec (m a
gx m a -> Vec 'Z (m a) -> Vec ('S 'Z) (m a)
forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a
:. Vec 'Z (m a)
forall a. Vec 'Z a
Nil) ((Vec ('S 'Z) a -> m a) -> m a) -> (Vec ('S 'Z) a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \(a
x :. Vec n a
Nil) ->
    a -> m a
f a
x

-- | Constructs a generator from a sub-term generator.
--
--   /Shrinks to the sub-term if possible./
--
subterm :: MonadGen m => m a -> (a -> a) -> m a
subterm :: m a -> (a -> a) -> m a
subterm m a
gx a -> a
f =
  m a -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadGen m => m a -> (a -> m a) -> m a
subtermM m a
gx ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
x ->
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a
f a
x)

-- | Constructs a generator from two sub-term generators.
--
--   /Shrinks to one of the sub-terms if possible./
--
subtermM2 :: MonadGen m => m a -> m a -> (a -> a -> m a) -> m a
subtermM2 :: m a -> m a -> (a -> a -> m a) -> m a
subtermM2 m a
gx m a
gy a -> a -> m a
f =
  Vec ('S ('S 'Z)) (m a) -> (Vec ('S ('S 'Z)) a -> m a) -> m a
forall (m :: * -> *) (n :: Nat) a.
MonadGen m =>
Vec n (m a) -> (Vec n a -> m a) -> m a
subtermMVec (m a
gx m a -> Vec ('S 'Z) (m a) -> Vec ('S ('S 'Z)) (m a)
forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a
:. m a
gy m a -> Vec 'Z (m a) -> Vec ('S 'Z) (m a)
forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a
:. Vec 'Z (m a)
forall a. Vec 'Z a
Nil) ((Vec ('S ('S 'Z)) a -> m a) -> m a)
-> (Vec ('S ('S 'Z)) a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \(a
x :. a
y :. Vec n a
Nil) ->
    a -> a -> m a
f a
x a
y

-- | Constructs a generator from two sub-term generators.
--
--   /Shrinks to one of the sub-terms if possible./
--
subterm2 :: MonadGen m => m a -> m a -> (a -> a -> a) -> m a
subterm2 :: m a -> m a -> (a -> a -> a) -> m a
subterm2 m a
gx m a
gy a -> a -> a
f =
  m a -> m a -> (a -> a -> m a) -> m a
forall (m :: * -> *) a.
MonadGen m =>
m a -> m a -> (a -> a -> m a) -> m a
subtermM2 m a
gx m a
gy ((a -> a -> m a) -> m a) -> (a -> a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
x a
y ->
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> a
f a
x a
y)

-- | Constructs a generator from three sub-term generators.
--
--   /Shrinks to one of the sub-terms if possible./
--
subtermM3 :: MonadGen m => m a -> m a -> m a -> (a -> a -> a -> m a) -> m a
subtermM3 :: m a -> m a -> m a -> (a -> a -> a -> m a) -> m a
subtermM3 m a
gx m a
gy m a
gz a -> a -> a -> m a
f =
  Vec ('S ('S ('S 'Z))) (m a)
-> (Vec ('S ('S ('S 'Z))) a -> m a) -> m a
forall (m :: * -> *) (n :: Nat) a.
MonadGen m =>
Vec n (m a) -> (Vec n a -> m a) -> m a
subtermMVec (m a
gx m a -> Vec ('S ('S 'Z)) (m a) -> Vec ('S ('S ('S 'Z))) (m a)
forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a
:. m a
gy m a -> Vec ('S 'Z) (m a) -> Vec ('S ('S 'Z)) (m a)
forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a
:. m a
gz m a -> Vec 'Z (m a) -> Vec ('S 'Z) (m a)
forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a
:. Vec 'Z (m a)
forall a. Vec 'Z a
Nil) ((Vec ('S ('S ('S 'Z))) a -> m a) -> m a)
-> (Vec ('S ('S ('S 'Z))) a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \(a
x :. a
y :. a
z :. Vec n a
Nil) ->
    a -> a -> a -> m a
f a
x a
y a
z

-- | Constructs a generator from three sub-term generators.
--
--   /Shrinks to one of the sub-terms if possible./
--
subterm3 :: MonadGen m => m a -> m a -> m a -> (a -> a -> a -> a) -> m a
subterm3 :: m a -> m a -> m a -> (a -> a -> a -> a) -> m a
subterm3 m a
gx m a
gy m a
gz a -> a -> a -> a
f =
  m a -> m a -> m a -> (a -> a -> a -> m a) -> m a
forall (m :: * -> *) a.
MonadGen m =>
m a -> m a -> m a -> (a -> a -> a -> m a) -> m a
subtermM3 m a
gx m a
gy m a
gz ((a -> a -> a -> m a) -> m a) -> (a -> a -> a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
x a
y a
z ->
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> a -> a
f a
x a
y a
z)

------------------------------------------------------------------------
-- Combinators - Combinations & Permutations

-- | Generates a random subsequence of a list.
--
-- For example:
--
-- @
-- Gen.print (Gen.subsequence [1..5])
-- @
--
--   > === Outcome ===
--   > [1,2,4]
--   > === Shrinks ===
--   > []
--   > [2,4]
--   > [1,4]
--   > [1,2]
--
subsequence :: MonadGen m => [a] -> m [a]
subsequence :: [a] -> m [a]
subsequence [a]
xs =
  ([a] -> [[a]]) -> m [a] -> m [a]
forall (m :: * -> *) a. MonadGen m => (a -> [a]) -> m a -> m a
shrink [a] -> [[a]]
forall a. [a] -> [[a]]
Shrink.list (m [a] -> m [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ (a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (m Bool -> a -> m Bool
forall a b. a -> b -> a
const m Bool
forall (m :: * -> *). MonadGen m => m Bool
bool_) [a]
xs

-- | Generates a random subset of a set.
--
--  /This shrinks towards the empty set./
--
subset :: MonadGen m => Set a -> m (Set a)
-- Set.fromDistinctAscList has an unchecked precondition that the list
-- must be strictly ascending. This precondition is satisfied because
-- Set.toAscList produces a strictly ascending list, and the 'subsequence'
-- generator only removes elements from the list; it never adds or
-- rearranges elements, so the strictly ascending property is undisturbed.
subset :: Set a -> m (Set a)
subset =
  ([a] -> Set a) -> m [a] -> m (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. [a] -> Set a
Set.fromDistinctAscList (m [a] -> m (Set a)) -> (Set a -> m [a]) -> Set a -> m (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> m [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
subsequence ([a] -> m [a]) -> (Set a -> [a]) -> Set a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toAscList

-- | Generates a random permutation of a list.
--
--   /This shrinks towards the order of the list being identical to the input/
--   /list./
--
shuffle :: MonadGen m => [a] -> m [a]
-- We shuffle sequences instead of lists to make extracting an arbitrary
-- element logarithmic instead of linear, and to make length calculation
-- constant-time instead of linear. We could probably do better, but
-- this is at least reasonably quick.
shuffle :: [a] -> m [a]
shuffle = (Seq a -> [a]) -> m (Seq a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (m (Seq a) -> m [a]) -> ([a] -> m (Seq a)) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> m (Seq a)
forall (m :: * -> *) a. MonadGen m => Seq a -> m (Seq a)
shuffleSeq (Seq a -> m (Seq a)) -> ([a] -> Seq a) -> [a] -> m (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList

-- | Generates a random permutation of a sequence.
--
--   /This shrinks towards the order of the sequence being identical to the input/
--   /sequence./
--
shuffleSeq :: MonadGen m => Seq a -> m (Seq a)
shuffleSeq :: Seq a -> m (Seq a)
shuffleSeq Seq a
xs =
  if Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
xs then
    Seq a -> m (Seq a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
forall a. Seq a
Seq.empty
  else do
    Int
n <- Range Int -> m Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
integral (Range Int -> m Int) -> Range Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 (Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
#if MIN_VERSION_containers(0,5,8)
    -- Data.Sequence should offer a version of deleteAt that returns the
    -- deleted element, but it does not currently do so. Lookup followed
    -- by deletion seems likely faster than splitting and then appending,
    -- but I haven't actually tested that. It's certainly easier to see
    -- what's going on.
    case Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
n Seq a
xs of
      Just a
y ->
        (a
y a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<|) (Seq a -> Seq a) -> m (Seq a) -> m (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq a -> m (Seq a)
forall (m :: * -> *) a. MonadGen m => Seq a -> m (Seq a)
shuffleSeq (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.deleteAt Int
n Seq a
xs)
      Maybe a
Nothing ->
        String -> m (Seq a)
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.shuffleSeq: internal error, lookup in empty sequence"
#else
    case Seq.splitAt n xs of
      (beginning, end) ->
        case Seq.viewl end of
          y Seq.:< end' ->
            (y Seq.<|) <$> shuffleSeq (beginning Seq.>< end')
          Seq.EmptyL ->
            error "Hedgehog.Gen.shuffleSeq: internal error, lookup in empty sequence"
#endif

------------------------------------------------------------------------
-- Sampling

-- | Generate a sample from a generator.
--
sample :: MonadIO m => Gen a -> m a
sample :: Gen a -> m a
sample Gen a
gen =
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
    let
      loop :: Int -> IO a
loop Int
n =
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then
          String -> IO a
forall a. HasCallStack => String -> a
error String
"Hedgehog.Gen.sample: too many discards, could not generate a sample"
        else do
          Seed
seed <- IO Seed
forall (m :: * -> *). MonadIO m => m Seed
Seed.random
          case Size -> Seed -> Gen a -> Maybe (Tree a)
forall a. Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen Size
30 Seed
seed Gen a
gen of
            Maybe (Tree a)
Nothing ->
              Int -> IO a
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            Just Tree a
x ->
              a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Tree a -> a
forall a. Tree a -> a
Tree.treeValue Tree a
x
    in
      Int -> IO a
loop (Int
100 :: Int)

-- | Run a generator with a random seed and print the outcome, and the first
--   level of shrinks.
--
-- @
-- Gen.print (Gen.'enum' \'a\' \'f\')
-- @
--
--   > === Outcome ===
--   > 'd'
--   > === Shrinks ===
--   > 'a'
--   > 'b'
--   > 'c'
--
print :: (MonadIO m, Show a) => Gen a -> m ()
print :: Gen a -> m ()
print Gen a
gen = do
  Seed
seed <- IO Seed -> m Seed
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seed
forall (m :: * -> *). MonadIO m => m Seed
Seed.random
  Size -> Seed -> Gen a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Size -> Seed -> Gen a -> m ()
printWith Size
30 Seed
seed Gen a
gen

-- | Print the value produced by a generator, and the first level of shrinks,
--   for the given size and seed.
--
--   Use 'print' to generate a value from a random seed.
--
printWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()
printWith :: Size -> Seed -> Gen a -> m ()
printWith Size
size Seed
seed Gen a
gen =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    case Size -> Seed -> Gen a -> Maybe (Tree a)
forall a. Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen Size
size Seed
seed Gen a
gen of
      Maybe (Tree a)
Nothing -> do
        String -> IO ()
putStrLn String
"=== Outcome ==="
        String -> IO ()
putStrLn String
"<discard>"

      Just Tree a
tree_ -> do
        let
          NodeT a
x [Tree a]
ss =
            Identity (NodeT Identity a) -> NodeT Identity a
forall a. Identity a -> a
runIdentity (Tree a -> Identity (NodeT Identity a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT Tree a
tree_)

        String -> IO ()
putStrLn String
"=== Outcome ==="
        String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
x)
        String -> IO ()
putStrLn String
"=== Shrinks ==="

        [Tree a] -> (Tree a -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Tree a]
ss ((Tree a -> IO ()) -> IO ()) -> (Tree a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tree a
s ->
          let
            NodeT a
y [Tree a]
_ =
              Identity (NodeT Identity a) -> NodeT Identity a
forall a. Identity a -> a
runIdentity (Identity (NodeT Identity a) -> NodeT Identity a)
-> Identity (NodeT Identity a) -> NodeT Identity a
forall a b. (a -> b) -> a -> b
$ Tree a -> Identity (NodeT Identity a)
forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT Tree a
s
          in
            String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
y)

-- | Run a generator with a random seed and print the resulting shrink tree.
--
-- @
-- Gen.printTree (Gen.'enum' \'a\' \'f\')
-- @
--
--   > 'd'
--   >  ├╼'a'
--   >  ├╼'b'
--   >  │  └╼'a'
--   >  └╼'c'
--   >     ├╼'a'
--   >     └╼'b'
--   >        └╼'a'
--
--   /This may not terminate when the tree is very large./
--
printTree :: (MonadIO m, Show a) => Gen a -> m ()
printTree :: Gen a -> m ()
printTree Gen a
gen = do
  Seed
seed <- IO Seed -> m Seed
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seed
forall (m :: * -> *). MonadIO m => m Seed
Seed.random
  Size -> Seed -> Gen a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Size -> Seed -> Gen a -> m ()
printTreeWith Size
30 Seed
seed Gen a
gen

-- | Print the shrink tree produced by a generator, for the given size and
--   seed.
--
--   Use 'printTree' to generate a value from a random seed.
--
printTreeWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()
printTreeWith :: Size -> Seed -> Gen a -> m ()
printTreeWith Size
size Seed
seed Gen a
gen = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
    Size -> Seed -> Gen a -> String
forall a. Show a => Size -> Seed -> Gen a -> String
renderTree Size
size Seed
seed Gen a
gen

-- | Render the shrink tree produced by a generator, for the given size and
--   seed.
--
renderTree :: Show a => Size -> Seed -> Gen a -> String
renderTree :: Size -> Seed -> Gen a -> String
renderTree Size
size Seed
seed Gen a
gen =
  case Size -> Seed -> Gen a -> Maybe (Tree a)
forall a. Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen Size
size Seed
seed Gen a
gen of
    Maybe (Tree a)
Nothing ->
      String
"<discard>"
    Just Tree a
x ->
      Tree String -> String
Tree.render ((a -> String) -> Tree a -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Show a => a -> String
show Tree a
x)

------------------------------------------------------------------------
-- Internal

-- $internal
--
-- These functions are exported in case you need them in a pinch, but are not
-- part of the public API and may change at any time, even as part of a minor
-- update.