pointless-haskell-0.0.4: Pointless Haskell library

Portabilitynon-portable
Stabilityexperimental
Maintainerhpacheco@di.uminho.pt

Generics.Pointless.Functors

Contents

Description

Pointless Haskell: point-free programming with recursion patterns as hylomorphisms

This module defines data types as fixed points of functor. Pointless Haskell works on a view of data types as fixed points of functors, in the same style as the PolyP (http://www.cse.chalmers.se/~patrikj/poly/polyp/) library. Instead of using an explicit fixpoint operator, a type function is used to relate the data types with their equivalent functor representations.

Synopsis

Functors

Definition and operations over functors

newtype Id x Source

Identity functor.

Constructors

Id 

Fields

unId :: x
 

Instances

Functor Id

The identity functor applies the mapping function the argument type

FunctorO Id 
Fctrable Id 

newtype Const t x Source

Constant functor.

Constructors

Cons 

Fields

unCons :: t
 

Instances

Functor (Const t)

The constant functor preserves the argument type

(Typeable a, Observable a) => FunctorO (Const a) 
Fctrable (Const c) 

data (g :+: h) x Source

Sum of functors.

Constructors

Inl (g x) 
Inr (h x) 

Instances

(Functor g, Functor h) => Functor (:+: g h)

The sum functor recursively applies the mapping function to each alternative

(FunctorO f, FunctorO g) => FunctorO (:+: f g) 
(Functor f, Fctrable f, Functor g, Fctrable g) => Fctrable (:+: f g) 

data (g :*: h) x Source

Product of functors.

Constructors

Prod (g x) (h x) 

Instances

(Functor g, Functor h) => Functor (:*: g h)

The product functor recursively applies the mapping function to both sides

(FunctorO f, FunctorO g) => FunctorO (:*: f g) 
(Functor f, Fctrable f, Functor g, Fctrable g) => Fctrable (:*: f g) 

newtype (g :@: h) x Source

Composition of functors.

Constructors

Comp 

Fields

unComp :: g (h x)
 

Instances

(Functor g, Functor h) => Functor (:@: g h)

The composition functor applies in the nesting of the mapping function to the nested functor applications

(FunctorO g, FunctorO h) => FunctorO (:@: g h) 
(Functor f, Fctrable f, Functor g, Fctrable g) => Fctrable (:@: f g) 

newtype Fix f Source

Explicit fixpoint operator.

Constructors

Fix 

Fields

unFix :: Rep f (Fix f)

The unfolding of the fixpoint of a functor is the functor applied to its fixpoint.

unFix is specialized with the application of Rep in order to subsume functor application

Instances

Show (Rep f (Fix f)) => Show (Fix f) 
(Functor f, FunctorO f) => Observable (Fix f) 
Mu (Fix f)

Expandingcontracting the fixed point of a functor is the same as consumingapplying it's single type constructor

type family PF a :: * -> *Source

Family of patterns functors of data types.

The type function is not necessarily injective, this is, different data types can have the same base functor.

Semantically, we can say that a = Fix f.

type family Rep f x :: *Source

Family of functor representations.

The Rep family implements the implicit coercion between the application of a functor and the structurally equivalent sum of products.

Functors applied to types can be represented as sums of products.

class Functor f whereSource

Polytypic Prelude.Functor class for functor representations

Methods

fmapSource

Arguments

:: Fix f

For desambiguation purposes, the type of the functor must be passed as an explicit paramaeter to fmap

-> (x -> y) 
-> Rep f x 
-> Rep f y

The mapping over representations

Instances

Functor []

The list functor maps the specific map function over lists of types

Functor Id

The identity functor applies the mapping function the argument type

Functor (Const t)

The constant functor preserves the argument type

(Functor g, Functor h) => Functor (:@: g h)

The composition functor applies in the nesting of the mapping function to the nested functor applications

(Functor g, Functor h) => Functor (:*: g h)

The product functor recursively applies the mapping function to both sides

(Functor g, Functor h) => Functor (:+: g h)

The sum functor recursively applies the mapping function to each alternative

type F a x = Rep (PF a) xSource

Short alias to express the structurally equivalent sum of products for some data type

pmapSource

Arguments

:: Functor (PF a) 
=> a

A value of a data type that is the fixed point of the desired functor

-> (x -> y) 
-> F a x 
-> F a y

The mapping over the equivalent sum of products

Polytypic map function

class Mu a whereSource

The Mu class provides the value-level translation between data types and their sum of products representations

Methods

inn :: F a a -> aSource

Packs a sum of products into one equivalent data type

out :: a -> F a aSource

unpacks a data type into the equivalent sum of products

Instances

Mu Bool 
Mu Int 
Mu Nat 
Mu I 
Mu [a] 
Mu (Maybe a) 
Mu (K a) 
Mu (Fix f)

Expandingcontracting the fixed point of a functor is the same as consumingapplying it's single type constructor

Mu (Rose a) 
Mu (LTree a) 
Mu (Tree a) 
Mu (NeLis a) 
Mu (:@!: a b) 
Mu (:*!: a b) 
Mu (:+!: a b) 

Fixpoint combinators

data I Source

In order to simplify type-level composition of functors, we can create fixpoint combinators that implicitely assume fixpoint application.

Semantically, we can say that I = Fix Id.

Constructors

FixId 

Instances

data K a Source

Semantically, we can say that K t = Fix (Const t).

Constructors

FixConst 

Fields

unFixConst :: a
 

Instances

(Typeable a, Observable a) => Observable (K a) 
Mu (K a) 

data a :+!: b Source

Semantically, we can say that Fix f :+!: Fix g = Fix (f :+: g).

Constructors

FixSum 

Fields

unFixSum :: F (a :+!: b) (a :+!: b)
 

Instances

(FunctorO (PF a), FunctorO (PF b)) => Observable (:+!: a b) 
Mu (:+!: a b) 

data a :*!: b Source

Semantically, we can say that Fix f :*!: Fix g = Fix (f :*: g).

Constructors

FixProd 

Fields

unFixProd :: F (a :*!: b) (a :*!: b)
 

Instances

(FunctorO (PF a), FunctorO (PF b)) => Observable (:*!: a b) 
Mu (:*!: a b) 

data a :@!: b Source

Semantically, we can say that Fix f :@!: Fix g = Fix (f ':@: g).

Constructors

FixComp 

Fields

unFixComp :: F (a :@!: b) (a :@!: b)
 

Instances

(FunctorO (PF a), FunctorO (PF b)) => Observable (:@!: a b) 
Mu (:@!: a b) 

Default definitions for commonly used data types

List

nil :: One -> [a]Source

cons :: (a, [a]) -> [a]Source

Natural Numbers

data Nat Source

Constructors

Zero 
Succ Nat 

Instances

Int (positive only)

Bool

Maybe