{- |
Module:        Network.Monad.Exception
Copyright:     (c) 2009 Henning Thielemann
License:       BSD

Stability:     experimental
Portability:   non-portable (not tested)


Functions that might be moved to explicit-exception package
when they prove to be universally useful.
-}
module Network.Monad.Exception where

import qualified Control.Monad.Exception.Asynchronous as Async
import qualified Control.Monad.Exception.Synchronous  as Sync
import Control.Applicative (WrappedMonad(WrapMonad), unwrapMonad, )

import Control.Monad (liftM, )
import Data.Monoid (Monoid, mappend, )

import Prelude hiding (map, )


type AsyncExceptionalT e m a = m (Async.Exceptional e a)

-- in contrast to 'fmap' it does require Monad instance, not Functor
map ::
   (Monad m) =>
   (a -> b) ->
   Async.ExceptionalT body m a -> Async.ExceptionalT body m b
map :: forall (m :: * -> *) a b body.
Monad m =>
(a -> b) -> ExceptionalT body m a -> ExceptionalT body m b
map a -> b
f =
   forall (m :: * -> *) e0 a (n :: * -> *) e1 b.
(m (Exceptional e0 a) -> n (Exceptional e1 b))
-> ExceptionalT e0 m a -> ExceptionalT e1 n b
Async.mapExceptionalT forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (m :: * -> *) e0 a (n :: * -> *) e1 b.
(m (Exceptional e0 a) -> n (Exceptional e1 b))
-> ExceptionalT e0 m a -> ExceptionalT e1 n b
Async.mapExceptionalT forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad

infixr 1 `bind`, `append`, `continue`

bind :: (Monad m, Monoid b) =>
   Sync.ExceptionalT e m a -> (a -> AsyncExceptionalT e m b) -> AsyncExceptionalT e m b
bind :: forall (m :: * -> *) b e a.
(Monad m, Monoid b) =>
ExceptionalT e m a
-> (a -> AsyncExceptionalT e m b) -> AsyncExceptionalT e m b
bind ExceptionalT e m a
x a -> AsyncExceptionalT e m b
y =
   forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> m (Exceptional e a)
Sync.tryT ExceptionalT e m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Exceptional e a
result ->
      forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Exceptional e a -> Exceptional e a
Async.force
      (case Exceptional e a
result of
         Sync.Exception e
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a e. Monoid a => e -> Exceptional e a
Async.throwMonoid e
e
         Sync.Success a
s -> a -> AsyncExceptionalT e m b
y a
s)

append :: (Monad m, Monoid a) => Sync.ExceptionalT e m a -> AsyncExceptionalT e m a -> AsyncExceptionalT e m a
append :: forall (m :: * -> *) a e.
(Monad m, Monoid a) =>
ExceptionalT e m a
-> AsyncExceptionalT e m a -> AsyncExceptionalT e m a
append ExceptionalT e m a
x AsyncExceptionalT e m a
y =
   forall (m :: * -> *) b e a.
(Monad m, Monoid b) =>
ExceptionalT e m a
-> (a -> AsyncExceptionalT e m b) -> AsyncExceptionalT e m b
bind ExceptionalT e m a
x (\a
s -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend a
s)) AsyncExceptionalT e m a
y)
{-
   liftM2
      (\x0 y0 -> Async.fromSynchronousMonoid x0 `Async.append` y0)
      (Sync.tryT x) y
-}

continue :: (Monad m, Monoid a) => Sync.ExceptionalT e m () -> AsyncExceptionalT e m a -> AsyncExceptionalT e m a
continue :: forall (m :: * -> *) a e.
(Monad m, Monoid a) =>
ExceptionalT e m ()
-> AsyncExceptionalT e m a -> AsyncExceptionalT e m a
continue ExceptionalT e m ()
x AsyncExceptionalT e m a
y =
   forall (m :: * -> *) b e a.
(Monad m, Monoid b) =>
ExceptionalT e m a
-> (a -> AsyncExceptionalT e m b) -> AsyncExceptionalT e m b
bind ExceptionalT e m ()
x (\()
_s -> AsyncExceptionalT e m a
y)
{-
   liftM2
      (\x0 y0 -> Sync.getExceptionNull x0 `Async.continue` y0)
      (Sync.tryT x) y
-}


switch :: Async.Exceptional e a -> (a -> b) -> (a -> Async.Exceptional e b) -> Async.Exceptional e b
switch :: forall e a b.
Exceptional e a
-> (a -> b) -> (a -> Exceptional e b) -> Exceptional e b
switch ea :: Exceptional e a
ea@(Async.Exceptional Maybe e
mea a
a) a -> b
exception a -> Exceptional e b
success =
   case Maybe e
mea of
      Just e
_  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
exception Exceptional e a
ea
      Maybe e
Nothing -> a -> Exceptional e b
success a
a

switchM :: (Monad m) => m (Async.Exceptional e a) -> (a -> m b) -> (a -> m (Async.Exceptional e b)) -> m (Async.Exceptional e b)
switchM :: forall (m :: * -> *) e a b.
Monad m =>
m (Exceptional e a)
-> (a -> m b) -> (a -> m (Exceptional e b)) -> m (Exceptional e b)
switchM m (Exceptional e a)
actA a -> m b
exception a -> m (Exceptional e b)
success =
   do ea :: Exceptional e a
ea@(Async.Exceptional Maybe e
mea a
a) <- m (Exceptional e a)
actA
      case Maybe e
mea of
         Just e
_  -> forall (m :: * -> *) a b e.
Monad m =>
(a -> m b) -> Exceptional e a -> m (Exceptional e b)
Async.mapM a -> m b
exception Exceptional e a
ea
         Maybe e
Nothing -> a -> m (Exceptional e b)
success a
a