A Reader monad composed with an Exception monad.

ReadExcept.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGe FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module ReadExcept (
  module ReadExcept
  , module Control.Monad.Reader
  , module Control.Monad.Except
  , module Control.Monad.Identity
  ) where

import Control.Monad.Reader
import Control.Monad.Except
import Control.Monad.Identity
import Data.Aeson.Types (Result(..))

throwReadError :: (MonadReader r m, MonadError e m) => (r -> e) -> m a
throwReadError re = ask >>= \r -> throwError (re r) 

withReadExceptT :: (MonadReader r m) => (e -> r -> e') -> ExceptT e m a -> ExceptT e' m a
withReadExceptT aske a = ask >>= \r -> withExceptT (flip aske r) a

liftMaybe :: (MonadError () m) => Maybe a -> m a
liftMaybe Nothing  = throwError ()
liftMaybe (Just a) = return a

withReadMaybe :: (MonadError e m, MonadReader r m) => (r -> e) -> (r -> Maybe a) -> m a
withReadMaybe f ma = do
  r <- ask
  case ma r of 
    Nothing -> throwReadError f
    Just a  -> return a 

withReadMaybe_ :: (MonadError e m, MonadReader r m) => (r -> e) -> Maybe a -> m a
withReadMaybe_ f ma = do
  r <- ask
  case ma of 
    Nothing -> throwReadError f
    Just a  -> return a 

instance MonadError String Result where 
  throwError = Error 
  Error msg `catchError` h = h msg
  Success a `catchError` _ = Success a

liftResult :: (MonadError String m) => Result a -> m a
liftResult (Error msg) = throwError msg
liftResult (Success a) = return a

withReadResult :: (MonadReader r m, MonadError e m) => 
                  (String -> r -> e) -> Result a -> m a
withReadResult f (Error msg) = throwReadError (f msg)
withReadResult f (Success a) = return a