daily pastebin goal
45%
SHARE
TWEET

Untitled

a guest Jan 23rd, 2019 66 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# LANGUAGE RankNTypes          #-}
  2. {-# LANGUAGE RecordWildCards     #-}
  3. {-# LANGUAGE ScopedTypeVariables #-}
  4.  
  5. -- | Error handling
  6. --
  7. -- Intended for qualified import
  8. --
  9. -- > import Ouroboros.Storage.Util.ErrorHandling (ErrorHandling(..))
  10. -- > import qualified Ouroboros.Storage.Util.ErrorHandling as EH
  11. module Ouroboros.Storage.Util.ErrorHandling (
  12.     ErrorHandling(..)
  13.   , try
  14.   , monadError
  15.   , exceptions
  16.   , embed
  17.   , liftNewtype
  18.   , liftReader
  19.   , liftState
  20.   ) where
  21.  
  22. import           Control.Exception (Exception)
  23. import qualified Control.Exception as E
  24. import           Control.Monad.Except (MonadError)
  25. import qualified Control.Monad.Except as M
  26. import           Control.Monad.Reader (ReaderT (..), runReaderT)
  27. import           Control.Monad.State (StateT (..), runStateT)
  28. import           Data.Type.Coercion
  29.  
  30. -- | Reification of the 'MonadError' class
  31. --
  32. -- Unlike 'MonadError', it is perfectly fine to have multiple 'ErrorHandling'
  33. -- objects available in a single context, as the caller can decide explicitly
  34. -- which to call. Moreover, being regular records, they can have additional
  35. -- information in the closure, if necessary (logging handles, for instance).
  36. data ErrorHandling e m = ErrorHandling {
  37.       throwError :: forall a. e -> m a
  38.     , catchError :: forall a. m a -> (e -> m a) -> m a
  39.     }
  40.  
  41. try :: Monad m => ErrorHandling e m -> m a -> m (Either e a)
  42. try ErrorHandling{..} act = (Right <$> act) `catchError` (return . Left)
  43.  
  44. monadError :: MonadError e m => ErrorHandling e m
  45. monadError = ErrorHandling {
  46.       throwError = M.throwError
  47.     , catchError = M.catchError
  48.     }
  49.  
  50. exceptions :: Exception e => ErrorHandling e IO
  51. exceptions = ErrorHandling {
  52.       throwError = E.throwIO
  53.     , catchError = E.catch
  54.     }
  55.  
  56. -- | Embed one kind of error in another
  57. embed :: (e' -> e)
  58.       -> (e -> Maybe e')
  59.       -> ErrorHandling e m -> ErrorHandling e' m
  60. embed intro elim ErrorHandling{..} = ErrorHandling{
  61.       throwError = \e -> throwError (intro e)
  62.     , catchError = \act handler -> catchError act $ \e ->
  63.                      case elim e of
  64.                        Nothing -> throwError e
  65.                        Just e' -> handler e'
  66.     }
  67.  
  68. -- | Lift for a newtype
  69. --
  70. -- TODO: This would be much nicer with QuantifiedConstraints.
  71. liftNewtype :: forall e m m'.
  72.                (forall a. Coercion (m a) (m' a))
  73.             -> ErrorHandling e m -> ErrorHandling e m'
  74. liftNewtype c ErrorHandling{..} = ErrorHandling {
  75.       throwError = \err         -> to $ throwError err
  76.     , catchError = \act handler -> to $ catchError (from act) (\e -> from $ handler e)
  77.     }
  78.   where
  79.     to :: forall a. m a -> m' a
  80.     to = coerceWith c
  81.  
  82.     from :: forall a. m' a -> m a
  83.     from = coerceWith (sym c)
  84.  
  85. -- | Lift for a reader monad
  86. liftReader :: proxy env -> ErrorHandling e m -> ErrorHandling e (ReaderT env m)
  87. liftReader _ ErrorHandling{..} = ErrorHandling{
  88.       throwError = \err         -> ReaderT $ \_env ->
  89.                                      throwError err
  90.     , catchError = \act handler -> ReaderT $ \env ->
  91.                                      catchError (runReaderT act env) $ \e ->
  92.                                        runReaderT (handler e) env
  93.     }
  94.  
  95. liftState :: proxy st -> ErrorHandling e m -> ErrorHandling e (StateT st m)
  96. liftState _ ErrorHandling{..} = ErrorHandling{
  97.       throwError = \err         -> StateT $ \_st ->
  98.                                      throwError err
  99.     , catchError = \act handler -> StateT $ \st ->
  100.                                      catchError (runStateT act st) $ \e ->
  101.                                        runStateT (handler e) st
  102.     }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top