compdata-0.3: Compositional Data Types

Portabilitynon-portable (GHC Extensions)
Stabilityexperimental
MaintainerPatrick Bahr <paba@diku.dk>

Data.Comp.Multi.Derive

Contents

Description

This module contains functionality for automatically deriving boilerplate code using Template Haskell. Examples include instances of HFunctor, HFoldable, and HTraversable.

Synopsis

Documentation

derive :: [Name -> Q [Dec]] -> [Name] -> Q [Dec]Source

Helper function for generating a list of instances for a list of named signatures. For example, in order to derive instances Functor and ShowF for a signature Exp, use derive as follows (requires Template Haskell):

 $(derive [makeFunctor, makeShowF] [''Exp])

Derive boilerplate instances for higher-order signatures, i.e. signatures for generalised compositional data types.

HShowF

class HShowF f whereSource

Signature printing. An instance HShowF f gives rise to an instance KShow (HTerm f).

Instances

(HShowF f, HFunctor f) => HShowF (Cxt h f) 
(HShowF f, Show p) => HShowF (:&: f p) 
(HShowF f, HShowF g) => HShowF (:+: f g) 

class KShow a whereSource

Methods

kshow :: a i -> K String iSource

Instances

KShow Nothing 
KShow (K String) 
(HShowF f, HFunctor f, KShow a) => KShow (Cxt h f a) 

makeHShowF :: Name -> Q [Dec]Source

Derive an instance of HShowF for a type constructor of any higher-order kind taking at least two arguments.

HEqF

class HEqF f whereSource

Signature equality. An instance HEqF f gives rise to an instance KEq (HTerm f).

Methods

heqF :: KEq g => f g i -> f g j -> BoolSource

Instances

HEqF f => HEqF (Cxt h f)

From an EqF functor an Eq instance of the corresponding term type can be derived.

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

EqF is propagated through sums.

class KEq f whereSource

Methods

keq :: f i -> f j -> BoolSource

Instances

KEq Nothing 
Eq a => KEq (K a) 
(HEqF f, KEq a) => KEq (Cxt h f a) 

makeHEqF :: Name -> Q [Dec]Source

Derive an instance of HEqF for a type constructor of any higher-order kind taking at least two arguments.

HFunctor

class HFunctor h Source

This class represents higher-order functors (Johann, Ghani, POPL '08) which are endofunctors on the category of endofunctors.

Instances

HDifunctor f => HFunctor (f a)

A higher-order difunctor gives rise to a higher-order functor when restricted to a particular contravariant argument.

HFunctor f => HFunctor (Cxt h f) 
HFunctor f => HFunctor (:&: f a) 
(HFunctor f, HFunctor g) => HFunctor (:+: f g) 

makeHFunctor :: Name -> Q [Dec]Source

Derive an instance of HFunctor for a type constructor of any higher-order kind taking at least two arguments.

HFoldable

class HFunctor h => HFoldable h Source

Higher-order functors that can be folded.

Minimal complete definition: hfoldMap or hfoldr.

Instances

HFoldable f => HFoldable (Cxt h f) 
HFoldable f => HFoldable (:&: f a) 
(HFoldable f, HFoldable g) => HFoldable (:+: f g) 

makeHFoldable :: Name -> Q [Dec]Source

Derive an instance of HFoldable for a type constructor of any higher-order kind taking at least two arguments.

HTraversable

makeHTraversable :: Name -> Q [Dec]Source

Derive an instance of HTraversable for a type constructor of any higher-order kind taking at least two arguments.

Smart Constructors

smartConstructors :: Name -> Q [Dec]Source

Derive smart constructors for a type constructor of any higher-order kind taking at least two arguments. The smart constructors are similar to the ordinary constructors, but an inject is automatically inserted.

Smart Constructors w/ Annotations

smartAConstructors :: Name -> Q [Dec]Source

Derive smart constructors with products for a type constructor of any parametric kind taking at least two arguments. The smart constructors are similar to the ordinary constructors, but an injectA is automatically inserted.

Lifting to Sums

liftSum :: Name -> Q [Dec]Source

Given the name of a type class, where the first parameter is a higher-order functor, lift it to sums of higher-order. Example: class HShowF f where ... is lifted as instance (HShowF f, HShowF g) => HShowF (f :+: g) where ... .

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

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