% 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