{-# LANGUAGE ScopedTypeVariables #-}
module Control.Error.Context.Exception where
import Control.Error.Context.Types
import Control.Exception.Safe (SomeException (..), catchJust)
import Control.Monad
import Control.Monad.Catch (Exception (..), MonadCatch (..))
catchWithContext
:: (MonadCatch m, Exception e)
=> m a
-> (ErrorWithContext e -> m a)
-> m a
catchWithContext m handler = catchJust pre m handler
where pre :: Exception e => SomeException -> Maybe (ErrorWithContext e)
pre someExn =
case fromException someExn of
Just (ErrorWithContext ctx someExnWithoutCtx :: ErrorWithContext SomeException) ->
case fromException someExnWithoutCtx of
Just exn -> Just (ErrorWithContext ctx exn)
Nothing -> Nothing
Nothing ->
case fromException someExn of
Just exn ->
Just (ErrorWithContext mempty exn)
Nothing ->
Nothing
catchWithoutContext
:: forall a e m
. (MonadCatch m, Exception e)
=> m a
-> (e -> m a)
-> m a
catchWithoutContext m handler = catchJust pre m handler
where pre :: SomeException -> Maybe e
pre someExn =
case fromException someExn :: Maybe (ErrorWithContext SomeException) of
Just (ErrorWithContext _ctx someExnWithoutContext) ->
case fromException someExnWithoutContext :: Maybe e of
Just exn ->
Just exn
Nothing ->
Nothing
Nothing ->
case fromException someExn :: Maybe e of
Just exn ->
Just exn
Nothing ->
Nothing
tryAnyWithContext
:: MonadCatch m
=> m a
-> m (Either (ErrorWithContext SomeException) a)
tryAnyWithContext m =
catchWithContext (Right `liftM` m) (return . Left)
tryAnyWithoutContext
:: MonadCatch m
=> m a
-> m (Either SomeException a)
tryAnyWithoutContext m =
catchWithoutContext (Right `liftM` m) (return . Left)
tryWithContext
:: (MonadCatch m, Exception e)
=> m a
-> m (Either (ErrorWithContext e) a)
tryWithContext m =
catchWithContext (Right `liftM` m) (return . Left)
tryWithoutContext
:: (MonadCatch m, Exception e)
=> m a
-> m (Either e a)
tryWithoutContext m =
catchWithoutContext (Right `liftM` m) (return . Left)
errorContextForget
:: ErrorWithContext e
-> e
errorContextForget (ErrorWithContext _ctx e) = e
catchAnyWithContext
:: MonadCatch m
=> m a
-> (ErrorWithContext SomeException -> m a)
-> m a
catchAnyWithContext m handler = catchJust pre m handler
where pre :: SomeException -> Maybe (ErrorWithContext SomeException)
pre someExn =
case fromException someExn :: Maybe (ErrorWithContext SomeException) of
Just exn ->
Just exn
Nothing ->
Just (ErrorWithContext mempty someExn)
catchAnyWithoutContext
:: MonadCatch m
=> m a
-> (SomeException -> m a)
-> m a
catchAnyWithoutContext m handler = catchJust pre m handler
where pre :: SomeException -> Maybe SomeException
pre someExn =
case fromException someExn :: Maybe (ErrorWithContext SomeException) of
Just (ErrorWithContext _ctx exnWithoutContext) ->
Just exnWithoutContext
Nothing ->
Just someExn