one-liner-0.2: Constraint-based generics

Portabilitynon-portable
Stabilityexperimental
Maintainersjoerd@w3future.com
Safe HaskellNone

Generics.OneLiner.ADT

Contents

Description

This module is for writing generic functions on algebraic data types of kind *. These data types must be an instance of the ADT type class.

Here's an example how to write such an instance for this data type:

 data T a = A Int a | B a (T a)
 instance ADT (T a) where
   ctorIndex A{} = 0
   ctorIndex B{} = 1
   type Constraints (T a) c = (c Int, c a, c (T a))
   buildsRecA For sub rec = 
     [ (ctor "A", A <$> sub (FieldInfo (\(A i _) -> i)) <*> sub (FieldInfo (\(A _ a) -> a)))
     , (ctor "B", B <$> sub (FieldInfo (\(B a _) -> a)) <*> rec (FieldInfo (\(B _ t) -> t)))
     ]

And this is how you would write generic equality, using the All monoid:

 eqADT :: (ADT t, Constraints t Eq) => t -> t -> Bool
 eqADT s t = ctorIndex s == ctorIndex t && 
   getAll (mbuilds (For :: For Eq) (\fld -> All $ s ! fld == t ! fld) `at` s)

Synopsis

Re-exports

The kind of constraints

The ADT type class

class ADT t whereSource

Type class for algebraic data types of kind *. Minimal implementation: ctorIndex and either buildsA if the type t is not recursive, or buildsRecA if the type t is recursive.

Associated Types

type Constraints t c :: ConstraintSource

The constraints needed to run buildsA and buildsRecA. It should be a list of all the types of the subcomponents of t, each applied to c.

Methods

ctorIndex :: t -> IntSource

Gives the index of the constructor of the given value in the list returned by buildsA and buildsRecA.

ctorInfo :: t -> Int -> CtorInfoSource

ctorInfo n gives constructor information, f.e. its name, for the nth constructor. The first argument is a dummy argument and can be (undefined :: t).

buildsASource

Arguments

:: (Constraints t c, Applicative f) 
=> For c

Witness for the constraint c.

-> (forall s. c s => FieldInfo (t -> s) -> f s)

This function should return a value for each subcomponent of t, wrapped in an applicative functor f. It is given information about the field, which contains a projector function to get the subcomponent from a value of type t. The type of the subcomponent is an instance of class c.

-> [f t]

A list of results, one for each constructor of type t. Each element is the result of applicatively applying the constructor to the results of the given function for each field of the constructor.

buildsRecASource

Arguments

:: (Constraints t c, Applicative f) 
=> For c

Witness for the constraint c.

-> (forall s. c s => FieldInfo (t -> s) -> f s)

This function should return a value for each subcomponent of t, wrapped in an applicative functor f. It is given information about the field, which contains a projector function to get the subcomponent from a value of type t. The type of the subcomponent is an instance of class c.

-> (FieldInfo (t -> t) -> f t)

This function should return a value for each subcomponent of t that is itself of type t.

-> [f t]

A list of results, one for each constructor of type t. Each element is the result of applicatively applying the constructor to the results of the given function for each field of the constructor.

Instances

ADT Bool 
ADT () 
ADT [a] 
ADT (Maybe a) 
ADT (Either a b) 
ADT (a, b) 
ADT (a, b, c) 
ADT (a, b, c, d) 

class ADT t => ADTRecord t Source

Add an instance for this class if the data type has exactly one constructor.

This class has no methods.

Instances

ADTRecord () 
ADTRecord (a, b) 
ADTRecord (a, b, c) 
ADTRecord (a, b, c, d) 

data For c Source

Tell the compiler which class we want to use in the traversal. Should be used like this:

 (For :: For Show)

Where Show can be any class.

Constructors

For 

Helper functions

(!) :: t -> FieldInfo (t -> s) -> sSource

Get the subcomponent by using the projector from the field information.

at :: ADT t => [a] -> t -> aSource

Get the value from the result of one of the builds functions that matches the constructor of t.

Derived traversal schemes

builds :: (ADT t, Constraints t c) => For c -> (forall s. c s => FieldInfo (t -> s) -> s) -> [t]Source

buildsA specialized to the Identity applicative functor.

mbuilds :: forall t c m. (ADT t, Constraints t c, Monoid m) => For c -> (forall s. c s => FieldInfo (t -> s) -> m) -> [m]Source

buildsA specialized to the Constant applicative functor, which collects monoid values m.

gmap :: (ADT t, Constraints t c) => For c -> (forall s. c s => s -> s) -> t -> tSource

Transform a value by transforming each subcomponent.

gfoldMap :: (ADT t, Constraints t c, Monoid m) => For c -> (forall s. c s => s -> m) -> t -> mSource

Fold a value, by mapping each subcomponent to a monoid value and collecting those.

gtraverse :: (ADT t, Constraints t c, Applicative f) => For c -> (forall s. c s => s -> f s) -> t -> f tSource

Applicative traversal given a way to traverse each subcomponent.

...for single constructor data types

build :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => FieldInfo (t -> s) -> s) -> tSource

builds for data types with exactly one constructor

op0 :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => s) -> tSource

Derive a 0-ary operation by applying the operation to every subcomponent.

op1 :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => s -> s) -> t -> tSource

Derive a unary operation by applying the operation to every subcomponent.

op2 :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => s -> s -> s) -> t -> t -> tSource

Derive a binary operation by applying the operation to every subcomponent.