free-functors-0.6.5: Free functors, adjoint to functors that forget class constraints.

LicenseBSD-style (see the file LICENSE)
Maintainersjoerd@w3future.com
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Data.Functor.Free

Contents

Description

A free functor is left adjoint to a forgetful functor. In this package the forgetful functor forgets class constraints.

Synopsis

Documentation

newtype Free c a Source

The free functor for class c.

Free c a is basically an expression tree with operations from class c and variables/placeholders of type a, created with unit. Monadic bind allows you to replace each of these variables with another sub-expression.

Constructors

Free 

Fields

runFree :: forall b. c b => (a -> b) -> b
 

Instances

(~) (* -> Constraint) c (Class f) => Algebra f (Free c a) Source 
Monad (Free c) Source 
Functor (Free c) Source 
Applicative (Free c) Source 
ForallT * (* -> *) * c (LiftAFree c) => Foldable (Free c) Source 
ForallT * (* -> *) * c (LiftAFree c) => Traversable (Free c) Source 
(ForallF * * c Identity, ForallF * * c (Compose (Free c) (Free c))) => Comonad (Free c) Source 
(Show a, Show (Signature c (ShowHelper (Signature c) a)), c (ShowHelper (Signature c) a)) => Show (Free c a) Source 

deriveInstances :: Name -> Q [Dec] Source

Derive the instances of Free c a for the class c, Show, Foldable and Traversable.

For example:

deriveInstances ''Num

unit :: a -> Free c a Source

unit allows you to create `Free c` values, together with the operations from the class c.

rightAdjunct :: c b => (a -> b) -> Free c a -> b Source

rightAdjunct is the destructor of `Free c` values.

rightAdjunctF :: ForallF c f => (a -> f b) -> Free c a -> f b Source

rightAdjunctT :: ForallT c t => (a -> t f b) -> Free c a -> t f b Source

counit :: c a => Free c a -> a Source

counit = rightAdjunct id

leftAdjunct :: (Free c a -> b) -> a -> b Source

leftAdjunct f = f . unit

transform :: (forall r. c r => (b -> r) -> a -> r) -> Free c a -> Free c b Source

transform f as = as >>= f unit
transform f . transform g = transform (g . f)

unfold :: (b -> Coproduct c b a) -> b -> Free c a Source

unfold f = coproduct (unfold f) unit . f

inL and inR are useful here. For example, the following creates the list [1..10] as a Free Monoid:

unfold (b -> if b == 0 then mempty else inL (b - 1) <> inR b) 10

convert :: (c (f a), Applicative f) => Free c a -> f a Source

convert = rightAdjunct pure

convertClosed :: c r => Free c Void -> r Source

convertClosed = rightAdjunct absurd

Coproducts

type Coproduct c m n = Free c (Either m n) Source

Products of Monoids are Monoids themselves. But coproducts of Monoids are not. However, the free Monoid applied to the coproduct is a Monoid, and it is the coproduct in the category of Monoids. This is also called the free product, and generalizes to any algebraic class.

coproduct :: c r => (m -> r) -> (n -> r) -> Coproduct c m n -> r Source

inL :: m -> Coproduct c m n Source

inR :: n -> Coproduct c m n Source

initial :: c r => InitialObject c -> r Source