compdata-0.8: Compositional Data Types

Copyright(c) 2011 Patrick Bahr
LicenseBSD3
MaintainerPatrick Bahr <paba@diku.dk>
Stabilityexperimental
Portabilitynon-portable (GHC Extensions)
Safe HaskellSafe-Inferred
LanguageHaskell98

Data.Comp.Multi.Ops

Description

This module provides operators on higher-order functors. All definitions are generalised versions of those in Data.Comp.Ops.

Synopsis

Documentation

data (f :+: g) h e infixr 5 Source

Data type defining coproducts.

Constructors

Inl (f h e) 
Inr (g h e) 

Instances

(:<:) f g => f :<: ((:+:) h g) 
f :<: ((:+:) f g) 
(HFunctor f, HFunctor g) => HFunctor ((:+:) f g) 
(HFoldable f, HFoldable g) => HFoldable ((:+:) f g) 
(HTraversable f, HTraversable g) => HTraversable ((:+:) f g) 
(ShowHF f, ShowHF g) => ShowHF ((:+:) f g) 
(EqHF f, EqHF g) => EqHF ((:+:) f g)

EqF is propagated through sums.

(OrdHF f, OrdHF g) => OrdHF ((:+:) f g)

OrdHF is propagated through sums.

(Desugar f h, Desugar g h) => Desugar ((:+:) f g) h 
(HasVars f v0, HasVars g v0) => HasVars ((:+:) f g) v 
DistAnn s p s' => DistAnn ((:+:) f s) p ((:+:) ((:&:) f p) s') 
RemA s s' => RemA ((:+:) ((:&:) f p) s) ((:+:) f s') 

caseH :: (f a b -> c) -> (g a b -> c) -> (f :+: g) a b -> c Source

Utility function to case on a higher-order functor sum, without exposing the internal representation of sums.

class sub :<: sup where Source

The subsumption relation.

Methods

inj :: sub a :-> sup a Source

proj :: NatM Maybe (sup a) (sub a) Source

Instances

f :<: f 
(:<:) f g => f :<: ((:+:) h g) 
f :<: ((:+:) f g) 

data (f :*: g) a infixr 8 Source

Constructors

(f a) :*: (g a) infixr 8 

fst :: (f :*: g) a -> f a Source

snd :: (f :*: g) a -> g a Source

data (f :&: a) g e infixr 7 Source

This data type adds a constant product to a signature. Alternatively, this could have also been defined as

data (f :&: a) (g ::  * -> *) e = f g e :&: a e

This is too general, however, for example for productHHom.

Constructors

(f g e) :&: a infixr 7 

Instances

DistAnn f p ((:&:) f p) 
HFunctor f => HFunctor ((:&:) f a) 
HFoldable f => HFoldable ((:&:) f a) 
HTraversable f => HTraversable ((:&:) f a) 
(ShowHF f, Show p) => ShowHF ((:&:) f p) 
RemA ((:&:) f p) f 
DistAnn s p s' => DistAnn ((:+:) f s) p ((:+:) ((:&:) f p) s') 
RemA s s' => RemA ((:+:) ((:&:) f p) s) ((:+:) f s') 

class DistAnn s p s' | s' -> s, s' -> p where Source

This class defines how to distribute an annotation over a sum of signatures.

Methods

injectA :: p -> s a :-> s' a Source

This function injects an annotation over a signature.

projectA :: s' a :-> (s a :&: p) Source

Instances

DistAnn f p ((:&:) f p) 
DistAnn s p s' => DistAnn ((:+:) f s) p ((:+:) ((:&:) f p) s') 

class RemA s s' | s -> s' where Source

Methods

remA :: s a :-> s' a Source

Instances

RemA ((:&:) f p) f 
RemA s s' => RemA ((:+:) ((:&:) f p) s) ((:+:) f s')