Exception.hs

{- |
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.Monad (liftM, )
import Data.Monoid (Monoid, mappend, )


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

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 x y =
   Sync.tryT x >>= \result ->
      liftM Async.force
      (case result of
         Sync.Exception e -> return $ Async.throwMonoid e
         Sync.Success s -> y s)

append :: (Monad m, Monoid a) => Sync.ExceptionalT e m a -> AsyncExceptionalT e m a -> AsyncExceptionalT e m a
append x y =
   bind x (\s -> liftM (fmap (mappend s)) 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 x y =
   bind x (\_s -> 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 ea@(Async.Exceptional mea a) exception success =
   case mea of
      Just _  -> fmap exception ea
      Nothing -> success a

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