module Control.Monad.DeepError where

import Data.DeepPrisms (DeepPrisms, hoist, retrieve)
import Data.Either.Combinators (mapLeft)

import Control.Exception (IOException)
import Control.Exception.Lifted (try)
import Control.Monad.Error.Class (MonadError(throwError, catchError))
import Control.Monad.Trans.Control (MonadBaseControl)

class (MonadError e m, DeepPrisms e e') => MonadDeepError e e' m where
  throwHoist :: e' -> m a

instance (MonadError e m, DeepPrisms e e') => MonadDeepError e e' m where
  throwHoist :: e' -> m a
throwHoist =
    e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m a) -> (e' -> e) -> e' -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> e
forall e e'. DeepPrisms e e' => e' -> e
hoist

catchAt ::
  ∀ e' e m a .
  MonadDeepError e e' m =>
  (e' -> m a) ->
  m a ->
  m a
catchAt :: (e' -> m a) -> m a -> m a
catchAt e' -> m a
handle m a
ma =
  m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m a
ma e -> m a
f
  where
    f :: e -> m a
f e
e = m a -> (e' -> m a) -> Maybe e' -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e) e' -> m a
handle (e -> Maybe e'
forall e e'. DeepPrisms e e' => e -> Maybe e'
retrieve e
e)

catchAs ::
  ∀ e' e m a .
  MonadDeepError e e' m =>
  a ->
  m a ->
  m a
catchAs :: a -> m a -> m a
catchAs =
  forall e' e (m :: * -> *) a.
MonadDeepError e e' m =>
(e' -> m a) -> m a -> m a
forall e (m :: * -> *) a.
MonadDeepError e e' m =>
(e' -> m a) -> m a -> m a
catchAt @e' ((e' -> m a) -> m a -> m a) -> (a -> e' -> m a) -> a -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> e' -> m a
forall a b. a -> b -> a
const (m a -> e' -> m a) -> (a -> m a) -> a -> e' -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

ignoreError ::
  ∀ e' e m .
  MonadDeepError e e' m =>
  m () ->
  m ()
ignoreError :: m () -> m ()
ignoreError =
  () -> m () -> m ()
forall e' e (m :: * -> *) a.
MonadDeepError e e' m =>
a -> m a -> m a
catchAs @e' ()

hoistEither ::
  MonadDeepError e e' m =>
  Either e' a ->
  m a
hoistEither :: Either e' a -> m a
hoistEither =
  (e' -> m a) -> (a -> m a) -> Either e' a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e' -> m a
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

hoistEitherWith ::
  MonadDeepError e e'' m =>
  (e' -> e'') ->
  Either e' a ->
  m a
hoistEitherWith :: (e' -> e'') -> Either e' a -> m a
hoistEitherWith e' -> e''
f =
  Either e'' a -> m a
forall e e' (m :: * -> *) a.
MonadDeepError e e' m =>
Either e' a -> m a
hoistEither (Either e'' a -> m a)
-> (Either e' a -> Either e'' a) -> Either e' a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e' -> e'') -> Either e' a -> Either e'' a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft e' -> e''
f

hoistEitherAs ::
  MonadDeepError e e'' m =>
  e'' ->
  Either e' a ->
  m a
hoistEitherAs :: e'' -> Either e' a -> m a
hoistEitherAs =
  (e' -> e'') -> Either e' a -> m a
forall e e'' (m :: * -> *) e' a.
MonadDeepError e e'' m =>
(e' -> e'') -> Either e' a -> m a
hoistEitherWith ((e' -> e'') -> Either e' a -> m a)
-> (e'' -> e' -> e'') -> e'' -> Either e' a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e'' -> e' -> e''
forall a b. a -> b -> a
const

hoistMaybe ::
  MonadDeepError e e' m =>
  e' ->
  Maybe a ->
  m a
hoistMaybe :: e' -> Maybe a -> m a
hoistMaybe e'
e' =
  m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e' -> m a
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist e'
e') a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

tryHoist ::
  MonadBaseControl IO m =>
  MonadDeepError e e' m =>
  Exception ex =>
  (ex -> e') ->
  m a ->
  m a
tryHoist :: (ex -> e') -> m a -> m a
tryHoist ex -> e'
f =
  (ex -> e') -> Either ex a -> m a
forall e e'' (m :: * -> *) e' a.
MonadDeepError e e'' m =>
(e' -> e'') -> Either e' a -> m a
hoistEitherWith ex -> e'
f (Either ex a -> m a) -> (m a -> m (Either ex a)) -> m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m a -> m (Either ex a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try

tryHoistAs ::
  ∀ ex e e' m a .
  MonadBaseControl IO m =>
  MonadDeepError e e' m =>
  Exception ex =>
  e' ->
  m a ->
  m a
tryHoistAs :: e' -> m a -> m a
tryHoistAs e'
e =
  e' -> Either ex a -> m a
forall e e'' (m :: * -> *) e' a.
MonadDeepError e e'' m =>
e'' -> Either e' a -> m a
hoistEitherAs e'
e (Either ex a -> m a) -> (m a -> m (Either ex a)) -> m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a.
(MonadBaseControl IO m, Exception ex) =>
m a -> m (Either ex a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try @m @ex

tryHoistIO ::
  MonadBaseControl IO m =>
  MonadDeepError e e' m =>
  (IOException -> e') ->
  m a ->
  m a
tryHoistIO :: (IOException -> e') -> m a -> m a
tryHoistIO =
  (IOException -> e') -> m a -> m a
forall (m :: * -> *) e e' ex a.
(MonadBaseControl IO m, MonadDeepError e e' m, Exception ex) =>
(ex -> e') -> m a -> m a
tryHoist

tryHoistIOAs ::
  MonadBaseControl IO m =>
  MonadDeepError e e' m =>
  e' ->
  m a ->
  m a
tryHoistIOAs :: e' -> m a -> m a
tryHoistIOAs =
  forall ex e e' (m :: * -> *) a.
(MonadBaseControl IO m, MonadDeepError e e' m, Exception ex) =>
e' -> m a -> m a
forall e e' (m :: * -> *) a.
(MonadBaseControl IO m, MonadDeepError e e' m,
 Exception IOException) =>
e' -> m a -> m a
tryHoistAs @IOException

tryHoistAny ::
  MonadBaseControl IO m =>
  MonadDeepError e e' m =>
  (SomeException -> e') ->
  m a ->
  m a
tryHoistAny :: (SomeException -> e') -> m a -> m a
tryHoistAny =
  (SomeException -> e') -> m a -> m a
forall (m :: * -> *) e e' ex a.
(MonadBaseControl IO m, MonadDeepError e e' m, Exception ex) =>
(ex -> e') -> m a -> m a
tryHoist

tryHoistAnyAs ::
  MonadBaseControl IO m =>
  MonadDeepError e e' m =>
  e' ->
  m a ->
  m a
tryHoistAnyAs :: e' -> m a -> m a
tryHoistAnyAs =
  forall ex e e' (m :: * -> *) a.
(MonadBaseControl IO m, MonadDeepError e e' m, Exception ex) =>
e' -> m a -> m a
forall e e' (m :: * -> *) a.
(MonadBaseControl IO m, MonadDeepError e e' m,
 Exception SomeException) =>
e' -> m a -> m a
tryHoistAs @SomeException

-- TODO derive multiple errors with HList + Generic