Portability | non-portable (depends on GHC extensions) |
---|---|
Stability | provisional |
Maintainer | Kevin Jardine <kevinjardine@yahoo.com> |
Data.PolyToMonoid
Contents
Description
Creates polyvariadic functions that map their parameters into a given monoid.
- class Monoid m => Monoidable a m where
- toMonoid :: a -> m
- class Monoid m => PolyVariadic m r where
- ptm :: m -> r
- class Monoid m => CPolyVariadic m r where
- ctm :: m -> r
- data Terminate m = Terminate {
- trm :: m
Introduction
Haskell lists contain an indefinite number of elements of a single type. It is sometimes useful to create list-like functions that accept an indefinite number of parameters of multiple types.
PolyToMonoid provides two such functions, ptm
and ctm
, as well as a typeclass Monoidable
.
The only precondition is that the
parameters of ptm
and ctm
can be mapped to an underlying monoid using
the toMonoid
function provided by Monoidable
.
Concept
To understand how the polyToMonoid functions work, consider a function list
that maps its parameters to
a list:
list p1 p2 ... pN = [p1] ++ [p2] ++ ... ++ [pN]
(which is the same as [p1,p2, ..., pN]
)
list
can be generalised to any monoid conceptually as:
polyToMonoid p1 p2 ... pN = (toMonoid p1) `mappend` (toMonoid p2) `mappend` ... `mappend` (toMonoid pN)
Remember that a monoid, defined in Data.Monoid, is any set of elements
with an identity element mempty
and an associative operator mappend
.
As any list type is automatically a monoid with mempty = []
and mappend = (++)
,
the list
function defined above is just a specific version of polyToMonoid
.
The main difficulty with defining a polyToMonoid
function is communicating to Haskell what
underlying monoid to use.
Through Haskell type magic, this can be done with a simple type annotation.
Specifically, you can pass mempty
as the first element of the function and annotate it with the type of the
monoid it belongs to. Think of the mempty
value as like the initial value of a fold.
This library provides two variants of a polyToMonoid function. The first, ptm
,
simply takes a list of arguments starting with mempty and returns the monoid result.
The second variant, ctm
, is composible. In effect, it returns a function that consumes the next parameter.
You can feed the ctm
result to a second termination function trm
to get the actual result.
Examples
We can first tell Haskell how to map a set of types to a list of strings using Monoidable
:
instance Show a => Monoidable a [String] where toMonoid a = [show a]
and then tell ptm
to use the [String]
monoid:
ptm (mempty :: [String]) True "alpha" [(5 :: Int)]
The result returned would be:
["True","\"alpha]\"","[5]"]
In this case, Monoidable
tells the ptm
function to accept a wide variety of types
(anything with a show
function) when using the [String]
monoid.
The first parameter of ptm
, (mempty :: [String])
tells it to map its parameters into the
[String]
monoid.
Unlike ptm
, the ctm
function in effect returns a partial function ready to consume
the next parameter rather than a monoid result.
It is therefore more composable, at the cost of requiring a second termination function trm
to return the actual monoid result.
ctmfirstbit = ctm mempty :: [String]) True "alpha" ctmsecondbit = ctmfirstbit [(5 :: Int)] finalresult = trm ctmsecondbit
The result returned would be the same as above:
["True","\"alpha]\"","[5]"]
Monoids, of course, do not have to be lists.
Here's a second example which multiplies together numbers of several types:
instance Monoid Double where mappend = (*) mempty = (1.0) :: Double
instance Monoidable Int Double where toMonoid = fromIntegral
instance Monoidable Double Double where toMonoid = id
ptm (mempty :: Double) (5 :: Int) (2.3 :: Double) (3 :: Int)
In this case, ptm
accepts parameters that are either ints or doubles, converts them to doubles,
and then multiplies them together.
You can use the composibility of ctm
to define a productOf
function:
productOf = ctm (mempty :: Double) trm $ productOf (5 :: Int) (2.3 :: Double) (3 :: Int)
As before the trm
function is required to terminate the ctm
calculation and deliver the final result.
Note that since ptm
returns its result immediately, it is not possible to use it to
define other functions using Haskell. You can use it in CPP defines, however. For example:
#define productOf ptm (mempty :: Double) productOf (5 :: Int) (2.3 :: Double) (3 :: Int)
Extensions
You will probably need to enable the following extensions to use this library:
TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses
class Monoid m => Monoidable a m whereSource
Define instances of Monoidable to tell Haskell how to convert your parameters into values in the underlying monoid
class Monoid m => PolyVariadic m r whereSource
Conceptually, ptm is defined as:
ptm (mempty :: MyMonoid) p1 p2 ... pN = (toMonoid p1) `mappend` (toMonoid p2) `mappend` ... `mappend` (toMonoid pN)
Instances
(m' ~ m, Monoid m') => PolyVariadic m m' | |
(Monoidable a m, PolyVariadic m r) => PolyVariadic m (a -> r) |
class Monoid m => CPolyVariadic m r whereSource
ctm is a composable variant of ptm.
To actually get its value, use the terminator function trm.
Instances
(m' ~ m, Monoid m') => CPolyVariadic m (Terminate m') | |
(Monoidable a m, CPolyVariadic m r) => CPolyVariadic m (a -> r) |