unfoldable-0.8.2: Class of data structures that can be unfolded.

Copyright(c) Sjoerd Visscher 2014
LicenseBSD-style (see the file LICENSE)
Maintainersjoerd@w3future.com
Stabilityexperimental
Portabilitynon-portable
Safe HaskellTrustworthy
LanguageHaskell98

Data.Unfolder

Contents

Description

Unfolders provide a way to unfold data structures. They are basically Alternative instances, but the choose method allows the unfolder to do something special for the recursive positions of the data structure.

Synopsis

Unfolder

class Alternative f => Unfolder f where Source

Unfolders provide a way to unfold data structures. The methods have default implementations in terms of Alternative, but you can implement choose to act on recursive positions of the data structure, or simply to provide a faster implementation than asum.

Minimal complete definition

Nothing

Methods

choose :: [f x] -> f x Source

Choose one of the values from the list.

chooseInt :: Int -> f Int Source

Given a number n, return a number between '0' and 'n - 1'.

Instances

Unfolder []

Don't choose but return all items.

Unfolder Maybe

Always choose the first item.

Unfolder Arb

Limit the depth of the generated data structure by dividing the given size by the number of recursive positions.

MonadPlus m => Unfolder (WrappedMonad m)

Derived instance.

Unfolder f => Unfolder (Reverse f)

Derived instance.

Unfolder f => Unfolder (Backwards f)

Derived instance.

(Functor m, Monad m) => Unfolder (MaybeT m)

Derived instance.

Applicative f => Unfolder (ListT f)

Derived instance.

Unfolder f => Unfolder (Lift f)

Derived instance.

Num a => Unfolder (NumConst a)

Unfolds to a constant numeric value. Useful for counting shapes.

Applicative f => Unfolder (BFS f)

Choose between values of a given depth only.

Unfolder f => Unfolder (WithRec f)

Applies a certain function depending on the depth at every recursive position.

Unfolder f => Unfolder (DualA f)

Reverse the list passed to choose.

(ArrowZero a, ArrowPlus a) => Unfolder (WrappedArrow a b)

Derived instance.

(Unfolder p, Unfolder q) => Unfolder (Product p q)

Derived instance.

(Unfolder p, Applicative q) => Unfolder (Compose p q)

Derived instance.

(Monoid w, Unfolder m) => Unfolder (WriterT w m)

Derived instance.

(Functor m, Monad m, Error e) => Unfolder (ErrorT e m)

Derived instance.

(MonadPlus m, Unfolder m) => Unfolder (StateT s m)

Derived instance.

Unfolder m => Unfolder (ReaderT r m)

Derived instance.

(Functor m, Monad m, RandomGen g) => Unfolder (Random g m)

Choose randomly.

(Monoid w, MonadPlus m, Unfolder m) => Unfolder (RWST r w s m)

Derived instance.

chooseMonadDefault :: (Monad m, Unfolder m) => [m x] -> m x Source

If an unfolder is monadic, choose can be implemented in terms of chooseInt.

between :: (Unfolder f, Enum a) => a -> a -> f a Source

If a datatype is enumerable, we can use chooseInt to generate a value. This is the function to use if you want to unfold a datatype that has no type arguments (has kind *).

betweenD :: (Unfolder f, Enum a) => a -> a -> f a Source

betweenD uses choose to generate a value. It chooses between the lower bound and one of the higher values. This means that f.e. breadth-first unfolding and arbitrary will prefer lower values.

boundedEnum :: (Unfolder f, Bounded a, Enum a) => f a Source

If a datatype is also bounded, we choose between all possible values.

boundedEnum = between minBound maxBound

boundedEnumD :: (Unfolder f, Bounded a, Enum a) => f a Source

boundedEnumD = betweenD minBound maxBound

Unfolder instances

newtype Random g m a Source

Constructors

Random 

Fields

getRandom :: StateT g m a
 

Instances

(Functor m, Monad m, RandomGen g) => Alternative (Random g m) 
Monad m => Monad (Random g m) 
Functor m => Functor (Random g m) 
(Functor m, Monad m, RandomGen g) => MonadPlus (Random g m) 
(Monad m, Functor m) => Applicative (Random g m) 
(Functor m, Monad m, RandomGen g) => Unfolder (Random g m)

Choose randomly.

data Arb a Source

A variant of Test.QuickCheck.Gen, with failure and a count of the number of recursive positions.

Constructors

Arb Int (Gen (Maybe a)) 

Instances

Alternative Arb 
Functor Arb 
Applicative Arb 
Unfolder Arb

Limit the depth of the generated data structure by dividing the given size by the number of recursive positions.

newtype NumConst a x Source

Variant of Constant that does multiplication of the constants for <*> and addition for <|>.

Constructors

NumConst 

Fields

getNumConst :: a
 

Instances

Num a => Alternative (NumConst a) 
Functor (NumConst a) 
Num a => Applicative (NumConst a) 
Num a => Unfolder (NumConst a)

Unfolds to a constant numeric value. Useful for counting shapes.

Eq a => Eq (NumConst a x) 
Show a => Show (NumConst a x) 

UnfolderTransformer

class UnfolderTransformer t where Source

An UnfolderTransformer changes the way an Unfolder unfolds.

Methods

lift :: Unfolder f => f a -> t f a Source

Lift a computation from the argument unfolder to the constructed unfolder.

ala :: (UnfolderTransformer t, Unfolder f) => (t f b -> f b) -> (t f a -> t f b) -> f a -> f b Source

Run an unfolding function with one argument using an UnfolderTransformer, given a way to run the transformer.

ala2 :: (UnfolderTransformer t, Unfolder f) => (t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c Source

Run an unfolding function with two arguments using an UnfolderTransformer, given a way to run the transformer.

ala3 :: (UnfolderTransformer t, Unfolder f) => (t f d -> f d) -> (t f a -> t f b -> t f c -> t f d) -> f a -> f b -> f c -> f d Source

Run an unfolding function with three arguments using an UnfolderTransformer, given a way to run the transformer.

UnfolderTransformer instances

newtype DualA f a Source

DualA flips the <|> operator from Alternative.

Constructors

DualA 

Fields

getDualA :: f a
 

Instances

UnfolderTransformer DualA 
Alternative f => Alternative (DualA f) 
Functor f => Functor (DualA f) 
Applicative f => Applicative (DualA f) 
Unfolder f => Unfolder (DualA f)

Reverse the list passed to choose.

Eq (f a) => Eq (DualA f a) 
Show (f a) => Show (DualA f a) 

data NT f g Source

Natural transformations

Constructors

NT 

Fields

getNT :: forall a. f a -> g a
 

newtype WithRec f a Source

Constructors

WithRec 

Fields

getWithRec :: ReaderT (Int -> NT f f) f a
 

Instances

UnfolderTransformer WithRec 
Alternative f => Alternative (WithRec f) 
Functor f => Functor (WithRec f) 
Applicative f => Applicative (WithRec f) 
Unfolder f => Unfolder (WithRec f)

Applies a certain function depending on the depth at every recursive position.

withRec :: (Int -> NT f f) -> WithRec f a -> f a Source

Apply a certain function of type f a -> f a to the result of a choose. The depth is passed as Int, so you can apply a different function at each depth. Because of a forall, the function needs to be wrapped in a NT constructor. See limitDepth for an example how to use this function.

limitDepth :: Unfolder f => Int -> WithRec f a -> f a Source

Limit the depth of an unfolding.

newtype BFS f x Source

Return a generator of values of a given depth. Returns Nothing if there are no values of that depth or deeper. The depth is the number of choose calls.

Constructors

BFS 

Fields

getBFS :: (Int, Split) -> Maybe [f x]
 

Instances

UnfolderTransformer BFS 
Applicative f => Alternative (BFS f) 
Functor f => Functor (BFS f) 
Applicative f => Applicative (BFS f) 
Applicative f => Unfolder (BFS f)

Choose between values of a given depth only.

type Split = Int -> [(Int, Int)] Source

bfs :: Unfolder f => BFS f x -> f x Source

Change the order of unfolding to be breadth-first, by maximum depth of the components.

bfsBySum :: Unfolder f => BFS f x -> f x Source

Change the order of unfolding to be breadth-first, by the sum of depths of the components.