pointless-haskell-0.0.9: Pointless Haskell library

Copyright(c) 2009 University of Minho
LicenseBSD3
Maintainerhpacheco@di.uminho.pt
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell98

Generics.Pointless.Bifunctors

Contents

Description

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

This module defines polymorphic data types as fixed points of bifunctor. 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

Bifunctors

newtype BId a x Source

Constructors

BId 

Fields

unBId :: x
 

Instances

Bifunctor BId 
Bifctrable BId 
type BRep BId a = Id

Representation of bifunctors with the BRep bifunctor representation class.

type Rep (BId a) x = x

Representation of bifunctors with the Rep functor representation class.

newtype BConst t a x Source

Constructors

BConst 

Fields

unBConst :: t
 

Instances

Bifunctor (BConst t) 
Bifctrable (BConst c) 
type BRep (BConst t) a = Const t 
type Rep (BConst t a) x = t 

newtype BPar a x Source

Constructors

Par 

Fields

unPar :: a
 

Instances

Bifunctor BPar 
Bifctrable BPar 
type BRep BPar a = Const a 
type Rep (BPar a) x = a 

data (g :+| h) a x infixr 5 Source

Constructors

BInl (g a x) 
BInr (h a x) 

Instances

(Bifunctor g, Bifunctor h) => Bifunctor ((:+|) g h) 
(Bifunctor f, Bifctrable f, Bifunctor g, Bifctrable g) => Bifctrable ((:+|) f g) 
type BRep ((:+|) g h) a = (:+:) (BRep g a) (BRep h a) 
type Rep ((:+|) g h a) x = Either (Rep (g a) x) (Rep (h a) x) 

data (g :*| h) a x infixr 6 Source

Constructors

BProd (g a x) (h a x) 

Instances

(Bifunctor g, Bifunctor h) => Bifunctor ((:*|) g h) 
(Bifunctor f, Bifctrable f, Bifunctor g, Bifctrable g) => Bifctrable ((:*|) f g) 
type BRep ((:*|) g h) a = (:*:) (BRep g a) (BRep h a) 
type Rep ((:*|) g h a) x = (Rep (g a) x, Rep (h a) x) 

newtype (g :@| h) a x infixr 9 Source

Constructors

BComp 

Fields

unBComp :: g a (h a x)
 

Instances

(Bifunctor g, Bifunctor h) => Bifunctor ((:@|) g h) 
type BRep ((:@|) g h) a = (:@:) (BRep g a) (BRep h a) 
type Rep ((:@|) g h a) x = Rep (g a) (Rep (h a) x) 

newtype BFix f Source

Constructors

BFix 

Fields

unBFix :: f (BFix f) (BFix f)
 

type family BF f :: * -> * -> * Source

Instances

type BF [] = (:+|) (BConst One) ((:*|) BPar BId) 
type BF BI = BId 
type BF (BK a) = BConst a 
type BF ((:@!|) a b) = (:@|) (BF a) (BF b) 
type BF ((:*!|) a b) = (:*|) (BF a) (BF b) 
type BF ((:+!|) a b) = (:+|) (BF a) (BF b) 

type family BRep f a :: * -> * Source

Instances

type BRep BPar a = Const a 
type BRep BId a = Id

Representation of bifunctors with the BRep bifunctor representation class.

type BRep (BConst t) a = Const t 
type BRep ((:@|) g h) a = (:@:) (BRep g a) (BRep h a) 
type BRep ((:*|) g h) a = (:*:) (BRep g a) (BRep h a) 
type BRep ((:+|) g h) a = (:+:) (BRep g a) (BRep h a) 

class Bifunctor f where Source

The polytypic bifunctor zipping combinator. Just maps over the polymorphic parameter. To map over the recursive parameter we can use fzip.

Methods

bmap :: Ann (BFix f) -> (a -> b) -> (x -> y) -> Rep (BRep f a) x -> Rep (BRep f b) y Source

bzip :: Ann x -> Ann (BFix f) -> (a -> c) -> (Rep (BRep f a) x, Rep (BRep f c) x) -> Rep (BRep f (a, c)) x Source

type B d a x = Rep (BRep (BF d) a) x Source

class Bimu d where Source

Methods

binn :: B d a (d a) -> d a Source

bout :: d a -> B d a (d a) Source

Instances

Bimu [] 
Bimu BI 
Bimu (BK a) 
Bimu ((:@!|) a b) 
Bimu ((:*!|) a b) 
Bimu ((:+!|) a b) 

pbmap :: Bifunctor (BF d) => Ann (d a) -> (a -> b) -> (x -> y) -> B d a x -> B d b y Source

Fixpoint combinators

data BI x Source

Constructors

FixBId 

Instances

Bimu BI 
type BF BI = BId 

data BK a x Source

Constructors

FixBConst 

Fields

unFixBConst :: a
 

Instances

Bimu (BK a) 
type BF (BK a) = BConst a 

data (a :+!| b) x infixr 5 Source

Constructors

FixBSum 

Fields

unFixBSum :: B (a :+!| b) x ((a :+!| b) x)
 

Instances

Bimu ((:+!|) a b) 
type BF ((:+!|) a b) = (:+|) (BF a) (BF b) 

data (a :*!| b) x infixr 6 Source

Constructors

FixBProd 

Fields

unFixBProd :: B (a :*!| b) x ((a :*!| b) x)
 

Instances

Bimu ((:*!|) a b) 
type BF ((:*!|) a b) = (:*|) (BF a) (BF b) 

data (a :@!| b) x infixr 9 Source

Constructors

FixBComp 

Fields

unFixBComp :: B (a :@!| b) x ((a :@!| b) x)
 

Instances

Bimu ((:@!|) a b) 
type BF ((:@!|) a b) = (:@|) (BF a) (BF b) 

Default definitions for commonly used data types

Lists