{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      :  Control.Monad.Exception.Instances
-- Copyright   :  (c) Harvard University 2008-2011
--                (c) Geoffrey Mainland 2011-2014
-- License     :  BSD-style
-- Maintainer  :  mainland@cs.drexel.edu

module Control.Monad.Exception.Instances where

import Control.Monad.Cont (MonadCont(..))
import Control.Monad.Exception (ExceptionT(..),
                                runExceptionT)
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Writer.Class (MonadWriter(..))
import Control.Monad.Trans.Class (MonadTrans(..))

--
-- mtl2 instances for transformed monads.
--

instance (MonadCont m) => MonadCont (ExceptionT m) where
    callCC :: forall a b.
((a -> ExceptionT m b) -> ExceptionT m a) -> ExceptionT m a
callCC (a -> ExceptionT m b) -> ExceptionT m a
f = forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC forall a b. (a -> b) -> a -> b
$ \Either SomeException a -> m (Either SomeException b)
c ->
        forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ((a -> ExceptionT m b) -> ExceptionT m a
f (\a
a -> forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException b)
c (forall a b. b -> Either a b
Right a
a)))

instance (MonadRWS r w s m) => MonadRWS r w s (ExceptionT m)

instance (MonadReader r m) => MonadReader r (ExceptionT m) where
    ask :: ExceptionT m r
ask       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (r -> r) -> ExceptionT m a -> ExceptionT m a
local r -> r
f ExceptionT m a
m = forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m)

instance (MonadState s m) => MonadState s (ExceptionT m) where
    get :: ExceptionT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> ExceptionT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance (MonadWriter w m) => MonadWriter w (ExceptionT m) where
    tell :: w -> ExceptionT m ()
tell     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: forall a. ExceptionT m a -> ExceptionT m (a, w)
listen ExceptionT m a
m = forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT forall a b. (a -> b) -> a -> b
$ do
        (Either SomeException a
a, w
w) <- forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m)
        case Either SomeException a
a of
          Left  SomeException
l -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
l
          Right a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (a
r, w
w)
    pass :: forall a. ExceptionT m (a, w -> w) -> ExceptionT m a
pass ExceptionT m (a, w -> w)
m   = forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall a b. (a -> b) -> a -> b
$ do
        Either SomeException (a, w -> w)
a <- forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m (a, w -> w)
m
        case Either SomeException (a, w -> w)
a of
          Left SomeException
l       -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left SomeException
l, forall a. a -> a
id)
          Right (a
r, w -> w
f) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right a
r, w -> w
f)