Arrow Libraries (arrows package)ParentContentsIndex
Control.Sequence
Portability portable
Stability experimental
Maintainer ross@soi.city.ac.uk
Contents
Lifting
Application of pure functions
Sequencing
Alternatives
Instances
Description

This module describes a structure intermediate between a functor and a monad: it provides pure expressions and sequencing, but no binding. (Technically, a lax monoidal premonad with a weak symmetry condition; if anyone knows the Real Name for these things, please let me know.)

This interface was introduced for parsers by Niklas Röjemo, because it admits more sharing than the monadic interface. The names here are mostly based on recent parsing work by Doaitse Swierstra.

Synopsis
class Functor f => Sequence f where
lift0 :: a -> f a
lift2 :: (a -> b -> c) -> f a -> f b -> f c
(<*>) :: f (a -> b) -> f a -> f b
lift1 :: Sequence f => (a -> b) -> f a -> f b
lift3 :: Sequence f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
(<$>) :: Functor f => (a -> b) -> f a -> f b
(<$) :: Functor f => a -> f b -> f a
(<*) :: Sequence f => f a -> f b -> f a
(*>) :: Sequence f => f a -> f b -> f b
(<**>) :: Sequence f => f a -> f (a -> b) -> f b
class Sequence f => Alternative f where
empty :: f a
(<|>) :: f a -> f a -> f a
newtype ArrowSequence a b c = ArrowSequence {
runArrowSequence :: (a b c)
}
newtype MonadSequence m a = MonadSequence {
runMonadSequence :: (m a)
}
Documentation
class Functor f => Sequence f where

A functor with sequencing.

Minimal definition: lift0 and either lift2 or <*>.

If the functor is also a monad, define lift0 = return and lift2 = liftM2.

Methods
lift0 :: a -> f a
Lift a value
lift2 :: (a -> b -> c) -> f a -> f b -> f c

Lift a binary function. lift0 and lift2 should satisfy

 lift2 f (unit x) v = fmap (\y -> f x y) v
 lift2 f u (unit y) = fmap (\x -> f x y) u
 lift2 f u (lift2 g v w) = lift2 ($) (lift2 (\x y z -> f x (g y z))) u v) w)
(<*>) :: f (a -> b) -> f a -> f b

Sequential application. This function should satisfy

 lift0 f <*> v = fmap f v
 u <*> lift0 y = fmap ($ y) u
 u <*> (v <*> w) = (fmap (.) u <*> v) <*> w
Instances
Arrow a => Sequence (ArrowSequence a s)
Sequence IO
Sequence Maybe
Monad m => Sequence (MonadSequence m)
Sequence []
Lifting
lift1 :: Sequence f => (a -> b) -> f a -> f b
Lift a unary function (a synonym for fmap)
lift3 :: Sequence f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
Lift a ternary function
Application of pure functions
(<$>) :: Functor f => (a -> b) -> f a -> f b
Apply a unary function (a synonym for fmap)
(<$) :: Functor f => a -> f b -> f a
Replace the value
Sequencing
(<*) :: Sequence f => f a -> f b -> f a
Sequence, discarding the value of the second argument
(*>) :: Sequence f => f a -> f b -> f b
Sequence, discarding the value of the first argument
(<**>) :: Sequence f => f a -> f (a -> b) -> f b
A variant of <*> with the arguments reversed
Alternatives
class Sequence f => Alternative f where
A monoid on sequences
Methods
empty :: f a
The identity of <|>
(<|>) :: f a -> f a -> f a
An associative binary operation
Instances
(ArrowZero a, ArrowPlus a) => Alternative (ArrowSequence a s)
MonadPlus m => Alternative (MonadSequence m)
Instances
newtype ArrowSequence a b c
Constructors
ArrowSequence
runArrowSequence :: (a b c)
Instances
(ArrowZero a, ArrowPlus a) => Alternative (ArrowSequence a s)
Arrow a => Functor (ArrowSequence a s)
Arrow a => Sequence (ArrowSequence a s)
newtype MonadSequence m a
Constructors
MonadSequence
runMonadSequence :: (m a)
Instances
MonadPlus m => Alternative (MonadSequence m)
Monad m => Functor (MonadSequence m)
Monad m => Sequence (MonadSequence m)
Produced by Haddock version 0.5