% Barrier Monads
% [Public domain]
\input birdstyle
\birdleftrule=1pt
\emergencystretch=1em
\def\hugebreak{\penalty-600\vskip 30pt plus 8pt minus 4pt\relax}
\newcount\chapno
\def\: #1.{\advance\chapno by 1\relax\hugebreak{\bf\S\the\chapno. #1. }}
\: Introduction. This module implements barrier monads. Read the next
chapter for a description of barrier monads.
> {-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
Exports:
> module Control.Monad.Barrier (
> Barrier(..), convert, rebind, yield, approach, continue, collect,
> uncollect, perform, operate, opencont, closecont, crosstalk,
> BarrierStream(..), collectBS, streamify, unstreamify, initializeBS,
> convertBS, BarrierT(..), yieldT, approachT, continueT, convertT,
> operateT, collectT, opencontT, closecontT, crosstalkT, operatesT,
> liftBarrier, unliftBarrier, displayBarrier
> ) where {
Imports:
> import Control.Applicative;
> import Control.Comonad;
> import Control.Monad;
> import Control.Monad.Error;
> import Control.Monad.Trans.Class;
\: The Barrier Monad. To make a barrier monad requires two additional
types, called the front type ({\tt f}) and the back type ({\tt b}). A
barrier monad has either the unit value, or a barrier with a front value
(the ``approach'') which is made visible externally, where the external
function must provide a back value in order to continue.
This implementation also has failure, because of the way monads are
defined in Haskell (failure is not actually required).
> data Barrier f b t = Unit t | Barrier f (b -> Barrier f b t)
> | Fail String;
This is the definition of the monad. The {\tt return} function is simple
because it is a unit value. Fail is defined for convenience (for a pattern
mismatch in do-notation, in case you want that information).
> instance Monad (Barrier f b) where {
> return = Unit;
> fail = Fail;
Now binding operation. Unit is known from the monad laws but then you must
bind a barrier, which is done by Kleisli composition.
> Unit x >>= f = f x;
> Fail x >>= f = Fail x;
> Barrier a c >>= f = Barrier a $ c >=> f;
> };
The first law is obviously true by definition.
The other law is shown by coinduction. %(Please prove it properly!)
A monad must be a functor, too, but unfortunately Haskell doesn't work
that way! Therefore, I defined it in here.
> instance Functor (Barrier f b) where {
> fmap = liftM;
> };
As well as applicative.
> instance Applicative (Barrier f b) where {
> pure = return;
> (<*>) = ap;
> };
There are various purposes of barrier monads, including overridable I/O,
forking to binary trees, conversion between front and back types, states,
flow control, and something like Javascript's generator functions.
\: Barrier Operations. One operation converts a barrier monad with one set
of front and back types to another. It is possible to do endomorphic
conversion where the front and back types are the same as before, but they
have different effects.
The convert operation is a bifunctor. Note that the barrier monads are
covariant in the front type and contravariant in the back type, which is
why the convert requires function from the new back type to the old back
type. (This is shown from the definition of the {\tt Barrier} datatype
above.)
> convert :: (f -> f') -> (b' -> b) -> Barrier f b t
> -> Barrier f' b' t;
> convert _ _ (Unit x) = Unit x;
> convert f b (Barrier a c) = Barrier (f a) $ convert f b . c . b;
> convert _ _ (Fail x) = Fail x;
Another operation is rebind. It allows replacing the barriers with zero or
more. You could compute some barriers ahead of time, for example.
> rebind :: (f -> Barrier f' b b) -> Barrier f b t -> Barrier f' b t;
> rebind _ (Unit x) = Unit x;
> rebind _ (Fail x) = Fail x;
> rebind f (Barrier a c) = f a >>= rebind f . c;
This is the identity of {\tt rebind}, rebinding each barrier with a front
value to itself: {\tt rebind yield} = {\tt id}
> yield :: f -> Barrier f b b;
> yield = flip Barrier Unit;
A pair of operations is approach and continue. If you use approach to take
the next front value, and continue to continue to the next one, requiring
a back value in order to do so.
> approach :: Barrier f b t -> Maybe f;
> approach (Unit _) = Nothing;
> approach (Fail _) = Nothing;
> approach (Barrier x _) = Just x;
> continue :: Barrier f b t -> b -> Barrier f b t;
> continue (Unit x) = const $ Unit x;
> continue (Fail x) = const $ Fail x;
> continue (Barrier a c) = c;
Here is the collect operation, now. It collects all the front values into
a list. This is a demonstration of the use of the approach and continue
operations.
> collect :: Barrier f () t -> [f];
> collect x = maybe [] (: collect (continue x ())) $ approach x;
This is the reverse operation.
> uncollect :: [x] -> Barrier x a ();
> uncollect = mapM_ yield;
Here is the {\tt perform} operation, which is used for performing a
stateful computation on a barrier monad, and returning the result. You can
have {\tt perform (,) error const 0} for barrier monads with the same
front and back type, in order to pass through front to back and return the
final value, not using the state.
> perform :: (f -> s -> (b, s)) -> (String -> s -> o) -> (t -> s -> o)
> -> s -> Barrier f b t -> o;
> perform _ _ f s (Unit x) = f x s;
> perform _ f _ s (Fail x) = f x s;
> perform f j k s (Barrier a c) = perform f j k (snd $ f a s)
> (c . fst $ f a s);
We also have {\tt operate}, which operates a barrier monad in another
monad.
> operate :: Monad m => (f -> m b) -> Barrier f b t -> m t;
> operate _ (Unit x) = return x;
> operate _ (Fail x) = fail x;
> operate f (Barrier a c) = f a >>= operate f . c;
And this functions converts it so that you have the access to the
continuations in {\tt operate} and {\tt convert} and so on.
> opencont :: Barrier f b t -> Barrier (f, b -> Barrier f b t)
> (Barrier f b t) t;
> opencont (Unit x) = Unit x;
> opencont (Fail x) = Fail x;
> opencont (Barrier a c) = Barrier (a, c) opencont;
> closecont :: Barrier (f, b -> Barrier f b t) (Barrier f b t) t
> -> Barrier f b t;
> closecont (Unit x) = Unit x;
> closecont (Fail x) = Fail x;
> closecont (Barrier (a, c) f) = Barrier a $ closecont . f . c;
This function makes crosstalk so that they call each other, and then
returns the list.
> crosstalk :: Barrier f b t1 -> Barrier b f t2 -> [(f, b)];
> crosstalk (Barrier a1 c1) (Barrier a2 c2) = (a1, a2)
> : crosstalk (c1 a2) (c2 a1);
> crosstalk _ _ = [];
\: Alternatives. There can be an instance of the {\tt Alternative} class
for barrier monads; it follows the identity and associativity rules. When
one fails, it will use the other one, combining the error messages if any.
However, everything yielded from the first one will probably not be
cancelled out. (This is different from Parsec, where only a parser that
does not consume any input can use this operation.)
However, it cannot be a proper instance of {\tt MonadPlus} if according to
the documentation exactly, but it does follow the left zero law, and some
people (including myself) agrees that it shouldn't necessarily require the
right zero law.
> instance Alternative (Barrier f b) where {
> empty = Fail [];
> Unit x <|> _ = Unit x;
> Fail y <|> x = annotateFail y x;
> Barrier a c <|> x = Barrier a $ \y -> (c y <|> x);
> };
> instance MonadPlus (Barrier f b) where {
> mzero = empty;
> mplus = (<|>);
> };
This function is an extra function used above. Due to this function, the
identity laws hold above. Multiple error messages are separated by the
ASCII record separator code, but a blank error message does not add the
delimiter (this is required to cause the identity law).
> annotateFail :: String -> Barrier f b t -> Barrier f b t;
> annotateFail [] x = x;
> annotateFail y (Fail []) = Fail y;
> annotateFail y (Fail x) = Fail $ y ++ ('\RS' : x);
> annotateFail y (Unit x) = Unit x;
> annotateFail y (Barrier a c) = Barrier a $ annotateFail y . c;
\: Error Handling. It is possible for errors to occur in barrier monads,
and there provides a way to catch the errors.
> instance MonadError String (Barrier f b) where {
> throwError = fail;
> catchError (Unit x) _ = Unit x;
> catchError (Fail x) f = f x;
> catchError (Barrier a c) f = Barrier a $ \y -> (catchError (c y) f);
> };
\: Barrier Streams. Similar to barrier monads are barrier streams, which
are always infinite. Barrier streams form both a monad and a comonad.
Since it is infinite, there can never be a return value like a normal
barrier monad can have. The return type used is therefore the front type
of a barrier stream.
> data BarrierStream b f = BarrierStream f (b -> BarrierStream b f);
> instance Functor (BarrierStream b) where {
> fmap f (BarrierStream a c) = BarrierStream (f a) (fmap f . c);
> };
Instead of defining the monad in terms of return and bind, it is defined
in terms of join.
> instance Monad (BarrierStream b) where {
> return x = BarrierStream x $ const (return x);
> x >>= y = join $ fmap y x where {
> join :: BarrierStream b (BarrierStream b f) -> BarrierStream b f;
> join (BarrierStream (BarrierStream a b) c) = BarrierStream a $
> \x -> join (fmap (\(BarrierStream a' c') -> c' x) $ c x);
> };
> };
And applicative, since all monads can form applicative.
> instance Applicative (BarrierStream b) where {
> pure = return;
> (<*>) = ap;
> };
It also forms a comonad as shown here.
> instance Extend (BarrierStream b) where {
> duplicate x@(BarrierStream _ c) = BarrierStream x $ duplicate . c;
> };
> instance Comonad (BarrierStream b) where {
> extract (BarrierStream a _) = a;
> };
These monad and comonad instances are very similar to a stream but where
the tail requires an input.
We can have a collect operation for barrier streams as well. It is a bit
more general, having a list for the back values.
> collectBS :: BarrierStream b f -> [b] -> [f];
> collectBS (BarrierStream a c) (h:t) = a : collectBS (c h) t;
> collectBS (BarrierStream a c) [] = [a];
Infinite barrier monads that do not fail can also be made into barrier
streams.
> streamify :: Barrier f b t -> BarrierStream b f;
> streamify (Barrier a c) = BarrierStream a $ streamify . c;
You can also do the reverse. (Notice the similarity!)
> unstreamify :: BarrierStream b f -> Barrier f b t;
> unstreamify (BarrierStream a c) = Barrier a $ unstreamify . c;
With an initial value, you can make a barrier stream such that {\tt
collectBS} on it with a list will result in the same list but with the
initial value at first.
> initializeBS :: t -> BarrierStream t t;
> initializeBS x = BarrierStream x initializeBS;
Like barrier monads, there is a contravariant functor on the back types of
the barrier streams.
> convertBS :: (b' -> b) -> BarrierStream b f -> BarrierStream b' f;
> convertBS f (BarrierStream a c) = BarrierStream a $ convertBS f . c . f;
\: Barrier Transforms. Here is the definition of the monad transformer of
barrier monads. This specification requires the {\tt Functor} instance as
well, but any monad is a functor anyways but Haskell doesn't require that.
> newtype BarrierT f b m t = BarrierT { runBarrierT :: m (Either t (f,
> b -> BarrierT f b m t)) };
> instance MonadTrans (BarrierT f b) where {
> lift = BarrierT . liftM Left;
> };
> instance Functor m => Functor (BarrierT f b m) where {
> fmap f (BarrierT x) = BarrierT
> (either (Left . f) (Right . z f) <$> x) where {
> z :: Functor m => (t -> u) -> (f, b -> BarrierT f b m t)
> -> (f, b -> BarrierT f b m u);
> z j (a, k) = (a, \b -> j <$> k b);
> };
> };
> instance (Functor m, Monad m) => Monad (BarrierT f b m) where {
> return = BarrierT . return . Left;
> x >>= f = join $ fmap f x where {
> join :: (Functor m, Monad m) => BarrierT f b m (BarrierT f b m t)
> -> BarrierT f b m t;
> join (BarrierT x) = BarrierT (x >>= runBarrierT . either id jR);
> jR :: (Functor m, Monad m) => (f, b -> BarrierT f b m
> (BarrierT f b m t)) -> BarrierT f b m t;
> jR (a, x) = BarrierT . return . Right . (,) a $ join . x;
> };
> fail = BarrierT . fail;
> };
> instance (Functor m, Monad m) => Applicative (BarrierT f b m) where {
> pure = return;
> (<*>) = ap;
> };
> instance (Alternative m, Monad m) => Alternative (BarrierT f b m) where {
> empty = BarrierT empty;
> BarrierT x <|> BarrierT y = BarrierT (x <|> y);
> };
> instance (Functor m, MonadPlus m) => MonadPlus (BarrierT f b m) where {
> mzero = BarrierT mzero;
> mplus (BarrierT x) (BarrierT y) = BarrierT $ mplus x y;
> };
> instance (Functor m, MonadIO m) => MonadIO (BarrierT f b m) where {
> liftIO = lift . liftIO;
> };
It can perform operations like that of normal barrier monads too.
> yieldT :: (Functor m, Monad m) => f -> BarrierT f b m b;
> yieldT x = BarrierT . return $ Right (x, return);
> approachT :: Functor m => BarrierT f b m t -> m (Maybe f);
> approachT = fmap (either (const Nothing) $ Just . fst) . runBarrierT;
> continueT :: (Functor m, Monad m) => BarrierT f b m t -> b
> -> BarrierT f b m t;
> continueT (BarrierT x) c = BarrierT (x >>= either (return . Left)
> (runBarrierT . ($ c) . snd));
> convertT :: Functor m => (f -> f') -> (b' -> b) -> BarrierT f b m t
> -> BarrierT f' b' m t;
> convertT f b = BarrierT . fmap (either Left $ (\(a, c) ->
> Right (f a, convertT f b . c . b))) . runBarrierT;
> operateT :: (Functor m, Monad m) => (f -> m b) -> BarrierT f b m t
> -> m t;
> operateT f (BarrierT x) = x >>= either return (\(a, c) -> f a >>=
> operateT f . c);
> collectT :: (Functor m, Monad m) => BarrierT f () m t -> m [f];
> collectT (BarrierT x) = x >>= either (const $ return [])
> (\(a, c) -> (a :) <$> (collectT $ c ()));
> opencontT :: Functor m => BarrierT f b m t -> BarrierT (f,
> b -> BarrierT f b m t) (BarrierT f b m t) m t;
> opencontT = BarrierT . fmap (either Left $ Right . flip (,) opencontT)
> . runBarrierT;
> closecontT :: Functor m => BarrierT (f, b -> BarrierT f b m t)
> (BarrierT f b m t) m t -> BarrierT f b m t;
> closecontT = BarrierT . fmap (either Left $ \((a, c), f) ->
> Right (a, closecontT . f . c)) . runBarrierT;
> crosstalkT :: (Functor m, Monad m) => BarrierT f b m t1
> -> BarrierT b f m t2 -> m [(f, b)];
> crosstalkT x y = liftM2 (liftA2 (,)) (runBarrierT ([] <$ x))
> (runBarrierT ([] <$ y)) >>= either return
> (\((a1, c1), (a2, c2)) -> ((a1, a2) :) <$> crosstalkT (c1 a2) (c2 a1));
It can also transform a comonad. It can extend.
> instance Comonad w => Extend (BarrierT f b w) where {
> duplicate (BarrierT x) = BarrierT (x =>> \y -> case extract y of {
> Left _ -> Left (BarrierT y);
> Right (a, c) -> Right (a, duplicate . c);
> });
> };
If the front and back type is the same, it can transform a comonad into
a comonad, too (the back values will always be passed the same as the
front values in order to extract).
> instance Comonad w => Comonad (BarrierT z z w) where {
> extract (BarrierT x) = case (extract x) of {
> Left z -> z;
> Right (a, c) -> extract $ c a;
> };
> };
You can also do stateful operate.
> operatesT :: (Functor m, Monad m) => (s -> f -> m (s, b)) -> s
> -> BarrierT f b m t -> m (s, t);
> operatesT f s (BarrierT x) = x >>= either (return . (,) s) (\(a, c) ->
> f s a >>= \(s', r) -> operatesT f s' (c r));
This is also the command to lift normal barrier monad to transform monad.
> liftBarrier :: Monad m => Barrier f b t -> BarrierT f b m t;
> liftBarrier (Unit x) = BarrierT . return $ Left x;
> liftBarrier (Fail x) = BarrierT $ fail x;
> liftBarrier (Barrier a c) = BarrierT . return $
> Right (a, liftBarrier . c);
For comonads, it does the other way around.
> unliftBarrier :: Comonad w => BarrierT f b w t -> Barrier f b t;
> unliftBarrier = either Unit (\(a, c) -> Barrier a $ unliftBarrier . c)
> . extract . runBarrierT;
\: Display. A function to display barrier monads, which can be used with
GHCi.
> displayBarrier :: (Show f, Show t) => Barrier f b t -> String;
> displayBarrier (Unit x) = "Unit: " ++ show x;
> displayBarrier (Barrier x _) = "Front: " ++ show x;
> displayBarrier (Fail x) = "Fail: " ++ x;
%\input example.lhs\relax % Example file included in printout
% End of document (final "}" is suppressed from printout)
\toks0={{
> } -- }\bye