Copyright | (c) Conal Elliott 2007 |
---|---|
License | BSD3 |
Maintainer | conal@conal.net |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell98 |
Pair-related type constructor classes.
This module is similar to Control.Functor.Pair
in the
category-extras
package, but it does not require a Functor
superclass.
Temporarily, there is also Data.Zip, which contains the same functionality with different naming. I'm unsure which I prefer.
Synopsis
- type PairTy f = forall a b. f a -> f b -> f (a, b)
- class Pair f where
- apPair :: (Applicative h, Pair f) => PairTy (h :. f)
- ppPair :: (Functor g, Pair g, Pair f) => PairTy (g :. f)
- arPair :: (Arrow j, Unpair f, Pair g) => PairTy (Arrw j f g)
- type UnpairTy f = forall a b. f (a, b) -> (f a, f b)
- class Unpair f where
- class Copair f where
- copair :: (Copair f, Monoid_f f) => PairTy f
- pairEdit :: (Functor m, Monoid (m ((c, d) -> (c, d)))) => (m c, m d) -> m ((c, d) -> (c, d))
- pairEditM :: MonadPlus m => (m c, m d) -> m ((c, d) -> (c, d))
Pairpings
Type constructor class for pair
-like things.
Here are some standard instance templates you can fill in. They're not
defined in the general forms below, because they would lead to a lot of
overlap.
instance Applicative f => Pair f where pair = liftA2 (,) instance (Applicative h, Pair f) => Pair (h :. f) where pair = apPair instance (Functor g, Pair g, Pair f) => Pair (g :. f) where pair = ppPair instance (Arrow (~>), Unpair f, Pair g) => Pair (Arrw (~>) f g) where pair = arPair instance (Monoid_f h, Copair h) => Pair h where pair = copair
Also, if you have a type constructor that's a Functor
and a Pair
,
here is a way to define '(*)' for Applicative
:
(<*>) = pairWith ($)
Minimum definitions for instances.
Instances
Pair [] Source # | |
Pair IO Source # | |
Pair Endo Source # | |
Pair Id Source # | |
Monoid u => Pair ((,) u) Source # | |
Monoid o => Pair (Const o :: Type -> Type) Source # | |
Pair ((->) u :: Type -> Type) Source # | |
(Pair f, Pair g) => Pair (f :*: g) Source # | |
(Arrow j, Monoid_f (Flip j o)) => Pair (Flip j o) Source # | |
(Arrow j, Unpair f, Pair g) => Pair (Arrw j f g) Source # | |
Unpairings
Unpairpable. Minimal instance definition: either (a) unpair
or (b)
both of fsts
and snds
. A standard template to substitute any
Functor
f.
But watch out for effects!
instance Functor f => Unpair f where {fsts = fmap fst; snds = fmap snd}
Nothing
:: UnpairTy f | generalized unpair |
:: f (a, b) | |
-> f a | First part of pair-like value |
:: f (a, b) | |
-> f b | Second part of pair-like value |
Dual unpairings
Dual to Unpair
.
Especially handy for contravariant functors (ContraFunctor
) . Use this
template (filling in f
) :
instance ContraFunctor f => Copair f where { cofsts = cofmap fst ; cosnds = cofmap snd }
:: f a | |
-> f (a, b) | Pair-like value from first part |
:: f b | |
-> f (a, b) | Pair-like value from second part |
copair :: (Copair f, Monoid_f f) => PairTy f Source #
Pairing of Copair
values. Combines contribution of each.