{-# 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 RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE DerivingVia #-}
#endif
module Hedgehog.Internal.Gen (
Gen
, GenT(..)
, MonadGen(..)
, generalize
, shrink
, prune
, small
, scale
, resize
, sized
, integral
, integral_
, int
, int8
, int16
, int32
, int64
, word
, word8
, word16
, word32
, word64
, realFloat
, realFrac_
, float
, double
, enum
, enumBounded
, bool
, bool_
, binit
, octit
, digit
, hexit
, lower
, upper
, alpha
, alphaNum
, ascii
, latin1
, unicode
, unicodeAll
, string
, text
, utf8
, bytes
, constant
, element
, choice
, frequency
, recursive
, discard
, ensure
, filter
, mapMaybe
, filterT
, mapMaybeT
, just
, justT
, maybe
, list
, seq
, nonEmpty
, set
, map
, freeze
, subterm
, subtermM
, subterm2
, subtermM2
, subterm3
, subtermM3
, subsequence
, shuffle
, shuffleSeq
, sample
, print
, printTree
, printWith
, printTreeWith
, renderTree
, runGenT
, evalGen
, evalGenT
, mapGenT
, generate
, toTree
, toTreeMaybeT
, fromTree
, fromTreeT
, fromTreeMaybeT
, runDiscardEffect
, runDiscardEffectT
, golden
, atLeast
, isSurrogate
, isNoncharacter
, 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.Fail (MonadFail (..))
import qualified Control.Monad.Fail as Fail
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
#if __GLASGOW_HASKELL__ < 806
import Data.Coerce (coerce)
#endif
import Data.Foldable (for_, toList)
import Data.Functor.Identity (Identity(..))
import Data.Int (Int8, Int16, Int32, Int64)
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 Data.Semigroup (Semigroup)
import qualified Data.Semigroup as Semigroup
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (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.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
import Prelude hiding (filter, print, maybe, map, seq)
type Gen =
GenT Identity
newtype GenT m a =
GenT {
GenT m a -> Size -> Seed -> TreeT (MaybeT m) a
unGenT :: Size -> Seed -> TreeT (MaybeT m) a
}
runGenT :: Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT :: Size -> Seed -> GenT m a -> TreeT (MaybeT m) a
runGenT size :: Size
size seed :: Seed
seed (GenT m :: Size -> Seed -> TreeT (MaybeT m) a
m) =
Size -> Seed -> TreeT (MaybeT m) a
m Size
size Seed
seed
evalGen :: Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen :: Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen size :: Size
size seed :: 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
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
size seed :: 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
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 f :: TreeT (MaybeT m) a -> TreeT (MaybeT n) b
f gen :: 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
size seed :: 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)
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)
fromTreeT :: MonadGen m => TreeT (GenBase m) a -> m a
fromTreeT :: TreeT (GenBase m) a -> m a
fromTreeT x :: 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
fromTreeMaybeT :: MonadGen m => TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT :: TreeT (MaybeT (GenBase m)) a -> m a
fromTreeMaybeT x :: 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
$ \_ _ ->
TreeT (MaybeT (GenBase m)) a
x
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)
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
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
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
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
class (Monad m, Monad (GenBase m)) => MonadGen m where
type GenBase m :: (* -> *)
toGenT :: m a -> GenT (GenBase m) a
fromGenT :: GenT (GenBase m) a -> m a
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 f :: 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
type GenBase (GenT m) =
m
toGenT :: GenT m a -> GenT (GenBase (GenT m)) a
toGenT =
GenT m a -> GenT (GenBase (GenT m)) a
forall a. a -> a
id
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
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) => Monoid (GenT m a) where
mappend :: GenT m a -> GenT m a -> GenT m a
mappend =
(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. Monoid a => a -> a -> a
mappend
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 f :: a -> b
f gen :: 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
$ \seed :: Size
seed size :: 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)
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
(<*>) f :: GenT m (a -> b)
f m :: 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
size seed :: Seed
seed ->
case Seed -> (Seed, Seed)
Seed.split Seed
seed of
(sf :: Seed
sf, sm :: 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
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
(>>=) m :: GenT m a
m k :: 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
size seed :: Seed
seed ->
case Seed -> (Seed, Seed)
Seed.split Seed
seed of
(sk :: Seed
sk, sm :: 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 MIN_VERSION_base(4,13,0)
#else
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 x :: GenT m a
x y :: 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
size seed :: Seed
seed ->
case Seed -> (Seed, Seed)
Seed.split Seed
seed of
(sx :: Seed
sx, sy :: 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 f :: 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 f :: forall a. m a -> t (MaybeT n) a
f m :: 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 f :: forall a. m a -> TreeT (MaybeT n) a
f tree_ :: 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 f :: forall a. m a -> GenT n a
f gen :: 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
size seed :: Seed
seed ->
case Seed -> (Seed, Seed)
Seed.split Seed
seed of
(sf :: Seed
sf, sg :: 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 x :: 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
size seed :: 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 m :: GenT m a
m onErr :: 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
size seed :: Seed
seed ->
case Seed -> (Seed, Seed)
Seed.split Seed
seed of
(sm :: Seed
sm, se :: 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 f :: r -> r
f m :: 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 -> GenT m (a, w)
forall a. HasCallStack => a
undefined
pass :: GenT m (a, w -> w) -> GenT m a
pass =
GenT m (a, w -> w) -> GenT m a
forall a. HasCallStack => a
undefined
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 m :: GenT m a
m onErr :: 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
size seed :: Seed
seed ->
case Seed -> (Seed, Seed)
Seed.split Seed
seed of
(sm :: Seed
sm, se :: 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
generate :: MonadGen m => (Size -> Seed -> a) -> m a
generate :: (Size -> Seed -> a) -> m a
generate f :: 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
size seed :: 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)
shrink :: MonadGen m => (a -> [a]) -> m a -> m a
shrink :: (a -> [a]) -> m a -> m a
shrink f :: 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)
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 0)
sized :: MonadGen m => (Size -> m a) -> m a
sized :: (Size -> m a) -> m a
sized f :: 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
size _ -> Size
size)
resize :: MonadGen m => Size -> m a -> m a
resize :: Size -> m a -> m a
resize size :: Size
size gen :: 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
scale :: MonadGen m => (Size -> Size) -> m a -> m a
scale :: (Size -> Size) -> m a -> m a
scale f :: 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
$ \gen :: 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
$ \size0 :: Size
size0 seed :: 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
< 0 then
String -> TreeT (MaybeT (GenBase m)) a
forall a. HasCallStack => String -> a
error "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
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
golden :: Size -> Size
golden :: Size -> Size
golden x :: 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
* 0.61803398875 :: Double)
integral :: (MonadGen m, Integral a) => Range a -> m a
integral :: Range a -> m a
integral range :: 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. Integral a => a -> a -> [a]
Shrink.towards (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, Integral a) => Range a -> m a
integral_ Range a
range)
integral_ :: (MonadGen m, Integral a) => Range a -> m a
integral_ :: Range a -> m a
integral_ range :: 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
size seed :: Seed
seed ->
let
(x :: a
x, y :: a
y) =
Size -> Range a -> (a, a)
forall a. Size -> Range a -> (a, a)
Range.bounds Size
size Range a
range
in
Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a)
-> ((Integer, Seed) -> Integer) -> (Integer, Seed) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Seed) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Seed) -> a) -> (Integer, Seed) -> a
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
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
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
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
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
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
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
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
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
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
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
realFloat :: (MonadGen m, RealFloat a) => Range a -> m a
realFloat :: Range a -> m a
realFloat range :: 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)
realFrac_ :: (MonadGen m, RealFrac a) => Range a -> m a
realFrac_ :: Range a -> m a
realFrac_ range :: 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
size seed :: Seed
seed ->
let
(x :: a
x, y :: 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
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
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
enum :: (MonadGen m, Enum a) => a -> a -> m a
enum :: a -> a -> m a
enum lo :: a
lo hi :: 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)
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
bool :: MonadGen m => m Bool
bool :: m Bool
bool =
m Bool
forall (m :: * -> *) a. (MonadGen m, Enum a, Bounded a) => m a
enumBounded
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
$ \_ seed :: Seed
seed ->
(Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 0 1 Seed
seed
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 '0' '1'
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 '0' '7'
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 '0' '9'
hexit :: MonadGen m => m Char
hexit :: m Char
hexit =
String -> m Char
forall (m :: * -> *) a. MonadGen m => [a] -> m a
element "0123456789aAbBcCdDeEfF"
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 '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 'A' 'Z'
alpha :: MonadGen m => m Char
alpha :: m Char
alpha =
String -> m Char
forall (m :: * -> *) a. MonadGen m => [a] -> m a
element "abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
alphaNum :: MonadGen m => m Char
alphaNum :: m Char
alphaNum =
String -> m Char
forall (m :: * -> *) a. MonadGen m => [a] -> m a
element "abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
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 '\0' '\127'
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 '\0' '\255'
unicode :: (MonadGen m) => m Char
unicode :: m Char
unicode =
let
s1 :: (Int, m Char)
s1 =
(55296, Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum '\0' '\55295')
s2 :: (Int, m Char)
s2 =
(8190, Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum '\57344' '\65533')
s3 :: (Int, m Char)
s3 =
(1048576, Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
enum '\65536' '\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]
unicodeAll :: MonadGen m => m Char
unicodeAll :: m Char
unicodeAll =
m Char
forall (m :: * -> *) a. (MonadGen m, Enum a, Bounded a) => m a
enumBounded
isSurrogate :: Char -> Bool
isSurrogate :: Char -> Bool
isSurrogate x :: Char
x =
Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\55296' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\57343'
isNoncharacter :: Char -> Bool
isNoncharacter :: Char -> Bool
isNoncharacter x :: Char
x =
Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\65534' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\65535'
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
text :: MonadGen m => Range Int -> m Char -> m Text
text :: Range Int -> m Char -> m Text
text range :: 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
utf8 :: MonadGen m => Range Int -> m Char -> m ByteString
utf8 :: Range Int -> m Char -> m ByteString
utf8 range :: 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
bytes :: MonadGen m => Range Int -> m ByteString
bytes :: Range Int -> m ByteString
bytes range :: 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 '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 '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
]
constant :: MonadGen m => a -> m a
constant :: a -> m a
constant =
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
element :: MonadGen m => [a] -> m a
element :: [a] -> m a
element = \case
[] ->
String -> m a
forall a. HasCallStack => String -> a
error "Hedgehog.Gen.element: used with empty list"
xs :: [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 0 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
pure $ [a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
n
choice :: MonadGen m => [m a] -> m a
choice :: [m a] -> m a
choice = \case
[] ->
String -> m a
forall a. HasCallStack => String -> a
error "Hedgehog.Gen.choice: used with empty list"
xs :: [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 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
- 1)
[m a]
xs [m a] -> Int -> m a
forall a. [a] -> Int -> a
!! Int
n
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 "Hedgehog.Gen.frequency: used with empty list"
xs0 :: [(Int, m a)]
xs0 -> do
let
pick :: t -> [(t, p)] -> p
pick n :: t
n = \case
[] ->
String -> p
forall a. HasCallStack => String -> a
error "Hedgehog.Gen.frequency/pick: used with empty list"
(k :: t
k, x :: p
x) : xs :: [(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
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 <- 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 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
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 f :: [m a] -> m a
f nonrec :: [m a]
nonrec rec :: [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
$ \n :: Size
n ->
if Size
n Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
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
ensure :: MonadGen m => (a -> Bool) -> m a -> m a
ensure :: (a -> Bool) -> m a -> m a
ensure p :: a -> Bool
p gen :: 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 p :: a -> Bool
p a :: 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)
filter :: (MonadGen m, GenBase m ~ Identity) => (a -> Bool) -> m a -> m a
filter :: (a -> Bool) -> m a -> m a
filter p :: 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 p :: a -> Maybe b
p gen0 :: m a
gen0 =
let
try :: Size -> m b
try k :: Size
k =
if Size
k Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> 100 then
m b
forall (m :: * -> *) a. MonadGen m => m a
discard
else do
(x :: a
x, gen :: 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 (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 _ ->
(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
Nothing ->
Size -> m b
try (Size
k Size -> Size -> Size
forall a. Num a => a -> a -> a
+ 1)
in
Size -> m b
try 0
filterT :: MonadGen m => (a -> Bool) -> m a -> m a
filterT :: (a -> Bool) -> m a -> m a
filterT p :: 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 p :: a -> Maybe b
p gen0 :: m a
gen0 =
let
try :: Size -> m b
try k :: Size
k =
if Size
k Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> 100 then
m b
forall (m :: * -> *) a. MonadGen m => m a
discard
else do
(x :: a
x, gen :: 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 (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 _ ->
(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
Nothing ->
Size -> m b
try (Size
k Size -> Size -> Size
forall a. Num a => a -> a -> a
+ 1)
in
Size -> m b
try 0
just :: (MonadGen m, GenBase m ~ Identity) => m (Maybe a) -> m a
just :: m (Maybe a) -> m a
just g :: 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 x :: a
x ->
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Nothing ->
String -> m a
forall a. HasCallStack => String -> a
error "Hedgehog.Gen.just: internal error, unexpected Nothing"
justT :: MonadGen m => m (Maybe a) -> m a
justT :: m (Maybe a) -> m a
justT g :: 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 x :: a
x ->
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Nothing ->
String -> m a
forall a. HasCallStack => String -> a
error "Hedgehog.Gen.just: internal error, unexpected Nothing"
maybe :: MonadGen m => m a -> m (Maybe a)
maybe :: m a -> m (Maybe a)
maybe gen :: 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
$ \n :: Size
n ->
[(Int, m (Maybe a))] -> m (Maybe a)
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
frequency [
(2, Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
, (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)
]
list :: MonadGen m => Range Int -> m a -> m [a]
list :: Range Int -> m a -> m [a]
list range :: Range Int
range gen :: 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
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
seq :: MonadGen m => Range Int -> m a -> m (Seq a)
seq :: Range Int -> m a -> m (Seq a)
seq range :: Range Int
range gen :: 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
nonEmpty :: MonadGen m => Range Int -> m a -> m (NonEmpty a)
nonEmpty :: Range Int -> m a -> m (NonEmpty a)
nonEmpty range :: Range Int
range gen :: 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 1) Range Int
range) m a
gen
case [a]
xs of
[] ->
String -> m (NonEmpty a)
forall a. HasCallStack => String -> a
error "Hedgehog.Gen.nonEmpty: internal error, generated empty list"
_ ->
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
set :: (MonadGen m, Ord a) => Range Int -> m a -> m (Set a)
set :: Range Int -> m a -> m (Set a)
set range :: Range Int
range gen :: 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
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 :: Range Int
range gen :: 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
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
uniqueByKey :: (MonadGen m, Ord k) => Int -> m (k, v) -> m [m (k, v)]
uniqueByKey :: Int -> m (k, v) -> m [m (k, v)]
uniqueByKey n :: Int
n gen :: m (k, v)
gen =
let
try :: Int -> Map k (m (k, v)) -> m [m (k, v)]
try k :: Int
k xs0 :: Map k (m (k, v))
xs0 =
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
>>= \kvs :: [((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 xs :: 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 xs :: 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
+ 1) Map k (m (k, v))
xs
in
Int -> Map k (m (k, v)) -> m [m (k, v)]
try (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 n :: Int
n xs :: Map k v
xs kvs0 :: [(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
k, v :: v
v) : kvs :: [(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 (\x :: v
x _ -> v
x) k
k v
v Map k v
xs) [(k, v)]
kvs
atLeast :: Int -> [a] -> Bool
atLeast :: Int -> [a] -> Bool
atLeast n :: Int
n =
if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
- 1)
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 :: 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
$ \gen :: 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
size seed :: 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
Nothing ->
TreeT (MaybeT (GenBase m)) (a, m a)
forall (f :: * -> *) a. Alternative f => f a
empty
Just (NodeT x :: a
x xs :: [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 _ ->
[]
All xs :: 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 f :: Vec n a -> m a
f = \case
One x :: a
x ->
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
All xs :: Vec n a
xs ->
Vec n a -> m a
f Vec n a
xs
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 gs :: Vec n (m a)
gs f :: 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
subtermM :: MonadGen m => m a -> (a -> m a) -> m a
subtermM :: m a -> (a -> m a) -> m a
subtermM gx :: m a
gx f :: 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
$ \(x :: a
x :. Nil) ->
a -> m a
f a
x
subterm :: MonadGen m => m a -> (a -> a) -> m a
subterm :: m a -> (a -> a) -> m a
subterm gx :: m a
gx f :: 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
$ \x :: a
x ->
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a
f a
x)
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 gx :: m a
gx gy :: m a
gy f :: 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
$ \(x :: a
x :. y :: a
y :. Nil) ->
a -> a -> m a
f a
x a
y
subterm2 :: MonadGen m => m a -> m a -> (a -> a -> a) -> m a
subterm2 :: m a -> m a -> (a -> a -> a) -> m a
subterm2 gx :: m a
gx gy :: m a
gy f :: 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
$ \x :: a
x y :: a
y ->
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> a
f a
x a
y)
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 gx :: m a
gx gy :: m a
gy gz :: m a
gz f :: 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
$ \(x :: a
x :. y :: a
y :. z :: a
z :. Nil) ->
a -> a -> a -> m a
f a
x a
y a
z
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 gx :: m a
gx gy :: m a
gy gz :: m a
gz f :: 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
$ \x :: a
x y :: a
y z :: 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)
subsequence :: MonadGen m => [a] -> m [a]
subsequence :: [a] -> m [a]
subsequence xs :: [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
shuffle :: MonadGen m => [a] -> m [a]
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
shuffleSeq :: MonadGen m => Seq a -> m (Seq a)
shuffleSeq :: Seq a -> m (Seq a)
shuffleSeq xs :: 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 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
- 1)
#if MIN_VERSION_containers(0,5,8)
case Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
n Seq a
xs of
Just y :: 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)
Nothing ->
String -> m (Seq a)
forall a. HasCallStack => String -> a
error "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
sample :: MonadIO m => Gen a -> m a
sample :: Gen a -> m a
sample gen :: 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 n :: Int
n =
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then
String -> IO a
forall a. HasCallStack => String -> a
error "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 30 Seed
seed Gen a
gen of
Nothing ->
Int -> IO a
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
Just x :: 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 (100 :: Int)
print :: (MonadIO m, Show a) => Gen a -> m ()
print :: Gen a -> m ()
print gen :: 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 30 Seed
seed Gen a
gen
printWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()
printWith :: Size -> Seed -> Gen a -> m ()
printWith size :: Size
size seed :: Seed
seed gen :: 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
Nothing -> do
String -> IO ()
putStrLn "=== Outcome ==="
String -> IO ()
putStrLn "<discard>"
Just tree_ :: Tree a
tree_ -> do
let
NodeT x :: a
x ss :: [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 "=== Outcome ==="
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
x)
String -> IO ()
putStrLn "=== 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
$ \s :: Tree a
s ->
let
NodeT y :: a
y _ =
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)
printTree :: (MonadIO m, Show a) => Gen a -> m ()
printTree :: Gen a -> m ()
printTree gen :: 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 30 Seed
seed Gen a
gen
printTreeWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()
printTreeWith :: Size -> Seed -> Gen a -> m ()
printTreeWith size :: Size
size seed :: Seed
seed gen :: 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
renderTree :: Show a => Size -> Seed -> Gen a -> String
renderTree :: Size -> Seed -> Gen a -> String
renderTree size :: Size
size seed :: Seed
seed gen :: 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
Nothing ->
"<discard>"
Just x :: 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)