    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Monad.Error.Lens
    -- Copyright   :  (C) 2014-2016 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  Control.Monad.Error
    --
    ----------------------------------------------------------------------------
    module Control.Monad.Error.Lens
      (
      -- * Catching
        catching, catching_
      -- * Handling
      , handling, handling_
      -- * Trying
      , trying
      -- * Handlers
      , catches
      , Handler(..)
      , Handleable(..)
      -- * Throwing
      , throwing, throwing_
      ) where

    import Control.Applicative
    import Control.Lens
    import Control.Lens.Internal.Exception
    import Control.Monad
    import Control.Monad.Error.Class
    import Data.Functor.Plus
    import qualified Data.Monoid as M

    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup (Semigroup(..))
    #endif

    ------------------------------------------------------------------------------
    -- Catching
    ------------------------------------------------------------------------------

    -- | Catch exceptions that match a given t'Prism' (or any t'Getter', really).
    --
    -- @
    -- 'catching' :: 'MonadError' e m => 'Prism'' e a     -> m r -> (a -> m r) -> m r
    -- 'catching' :: 'MonadError' e m => 'Lens'' e a      -> m r -> (a -> m r) -> m r
    -- 'catching' :: 'MonadError' e m => 'Traversal'' e a -> m r -> (a -> m r) -> m r
    -- 'catching' :: 'MonadError' e m => 'Iso'' e a       -> m r -> (a -> m r) -> m r
    -- 'catching' :: 'MonadError' e m => t'Getter' e a    -> m r -> (a -> m r) -> m r
    -- 'catching' :: 'MonadError' e m => t'Fold' e a      -> m r -> (a -> m r) -> m r
    -- @
    catching :: MonadError e m => Getting (M.First a) e a -> m r -> (a -> m r) -> m r
    catching :: forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> (a -> m r) -> m r
    catching Getting (First a) e a
    l = (e -> Maybe a) -> m r -> (a -> m r) -> m r
    forall e (m :: * -> *) t a.
    MonadError e m =>
    (e -> Maybe t) -> m a -> (t -> m a) -> m a
    catchJust (Getting (First a) e a -> e -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First a) e a
    l)
    {-# INLINE catching #-}

    -- | Catch exceptions that match a given t'Prism' (or any t'Getter'), discarding
    -- the information about the match. This is particularly useful when you have
    -- a @'Prism'' e ()@ where the result of the t'Prism' or t'Fold' isn't
    -- particularly valuable, just the fact that it matches.
    --
    -- @
    -- 'catching_' :: 'MonadError' e m => 'Prism'' e a     -> m r -> m r -> m r
    -- 'catching_' :: 'MonadError' e m => 'Lens'' e a      -> m r -> m r -> m r
    -- 'catching_' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m r -> m r
    -- 'catching_' :: 'MonadError' e m => 'Iso'' e a       -> m r -> m r -> m r
    -- 'catching_' :: 'MonadError' e m => t'Getter' e a    -> m r -> m r -> m r
    -- 'catching_' :: 'MonadError' e m => t'Fold' e a      -> m r -> m r -> m r
    -- @
    catching_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r
    catching_ :: forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> m r -> m r
    catching_ Getting (First a) e a
    l m r
    a m r
    b = (e -> Maybe a) -> m r -> (a -> m r) -> m r
    forall e (m :: * -> *) t a.
    MonadError e m =>
    (e -> Maybe t) -> m a -> (t -> m a) -> m a
    catchJust (Getting (First a) e a -> e -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First a) e a
    l) m r
    a (m r -> a -> m r
    forall a b. a -> b -> a
    const m r
    b)
    {-# INLINE catching_ #-}

    ------------------------------------------------------------------------------
    -- Handling
    ------------------------------------------------------------------------------

    -- | A version of 'catching' with the arguments swapped around; useful in
    -- situations where the code for the handler is shorter.
    --
    -- @
    -- 'handling' :: 'MonadError' e m => 'Prism'' e a     -> (a -> m r) -> m r -> m r
    -- 'handling' :: 'MonadError' e m => 'Lens'' e a      -> (a -> m r) -> m r -> m r
    -- 'handling' :: 'MonadError' e m => 'Traversal'' e a -> (a -> m r) -> m r -> m r
    -- 'handling' :: 'MonadError' e m => 'Iso'' e a       -> (a -> m r) -> m r -> m r
    -- 'handling' :: 'MonadError' e m => t'Fold' e a      -> (a -> m r) -> m r -> m r
    -- 'handling' :: 'MonadError' e m => t'Getter' e a    -> (a -> m r) -> m r -> m r
    -- @
    handling :: MonadError e m => Getting (M.First a) e a -> (a -> m r) -> m r -> m r
    handling :: forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> (a -> m r) -> m r -> m r
    handling Getting (First a) e a
    l = (m r -> (a -> m r) -> m r) -> (a -> m r) -> m r -> m r
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Getting (First a) e a -> m r -> (a -> m r) -> m r
    forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> (a -> m r) -> m r
    catching Getting (First a) e a
    l)
    {-# INLINE handling #-}

    -- | A version of 'catching_' with the arguments swapped around; useful in
    -- situations where the code for the handler is shorter.
    --
    -- @
    -- 'handling_' :: 'MonadError' e m => 'Prism'' e a     -> m r -> m r -> m r
    -- 'handling_' :: 'MonadError' e m => 'Lens'' e a      -> m r -> m r -> m r
    -- 'handling_' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m r -> m r
    -- 'handling_' :: 'MonadError' e m => 'Iso'' e a       -> m r -> m r -> m r
    -- 'handling_' :: 'MonadError' e m => t'Getter' e a    -> m r -> m r -> m r
    -- 'handling_' :: 'MonadError' e m => t'Fold' e a      -> m r -> m r -> m r
    -- @
    handling_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r
    handling_ :: forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> m r -> m r
    handling_ Getting (First a) e a
    l = (m r -> m r -> m r) -> m r -> m r -> m r
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Getting (First a) e a -> m r -> m r -> m r
    forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> m r -> m r
    catching_ Getting (First a) e a
    l)
    {-# INLINE handling_ #-}

    ------------------------------------------------------------------------------
    -- Trying
    ------------------------------------------------------------------------------

    -- | 'trying' takes a t'Prism' (or any t'Getter') to select which exceptions are caught
    -- If the exception does not match the predicate, it is re-thrown.
    --
    -- @
    -- 'trying' :: 'MonadError' e m => 'Prism'' e a     -> m r -> m ('Either' a r)
    -- 'trying' :: 'MonadError' e m => 'Lens'' e a      -> m r -> m ('Either' a r)
    -- 'trying' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m ('Either' a r)
    -- 'trying' :: 'MonadError' e m => 'Iso'' e a       -> m r -> m ('Either' a r)
    -- 'trying' :: 'MonadError' e m => t'Getter' e a    -> m r -> m ('Either' a r)
    -- 'trying' :: 'MonadError' e m => t'Fold' e a      -> m r -> m ('Either' a r)
    -- @
    trying :: MonadError e m => Getting (M.First a) e a -> m r -> m (Either a r)
    trying :: forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> m (Either a r)
    trying Getting (First a) e a
    l m r
    m = Getting (First a) e a
    -> m (Either a r) -> (a -> m (Either a r)) -> m (Either a r)
    forall e (m :: * -> *) a r.
    MonadError e m =>
    Getting (First a) e a -> m r -> (a -> m r) -> m r
    catching Getting (First a) e a
    l ((r -> Either a r) -> m r -> m (Either a r)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM r -> Either a r
    forall a b. b -> Either a b
    Right m r
    m) (Either a r -> m (Either a r)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either a r -> m (Either a r))
    -> (a -> Either a r) -> a -> m (Either a r)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either a r
    forall a b. a -> Either a b
    Left)

    ------------------------------------------------------------------------------
    -- Catches
    ------------------------------------------------------------------------------

    -- |
    -- This function exists to remedy a gap between the functionality of @Control.Exception@
    -- and @Control.Monad.Error@. @Control.Exception@ supplies 'Control.Exception.catches' and
    -- a notion of 'Control.Exception.Handler', which we duplicate here in a form suitable for
    -- working with any 'MonadError' instance.
    --
    -- Sometimes you want to catch two different sorts of error. You could
    -- do something like
    --
    -- @
    -- f = 'handling' _Foo handleFoo ('handling' _Bar handleBar expr)
    -- @
    --
    --
    -- However, there are a couple of problems with this approach. The first is
    -- that having two exception handlers is inefficient. However, the more
    -- serious issue is that the second exception handler will catch exceptions
    -- in the first, e.g. in the example above, if @handleFoo@ uses 'throwError'
    -- then the second exception handler will catch it.
    --
    -- Instead, we provide a function 'catches', which would be used thus:
    --
    -- @
    -- f = 'catches' expr [ 'handler' _Foo handleFoo
    --                  , 'handler' _Bar handleBar
    --                  ]
    -- @
    catches :: MonadError e m => m a -> [Handler e m a] -> m a
    catches :: forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> [Handler e m a] -> m a
    catches m a
    m [Handler e m a]
    hs = m a -> (e -> m a) -> m a
    forall a. m a -> (e -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError m a
    m e -> m a
    go where
      go :: e -> m a
    go e
    e = (Handler e m a -> m a -> m a) -> m a -> [Handler e m a] -> m a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Handler e m a -> m a -> m a
    forall {m :: * -> *} {r}. Handler e m r -> m r -> m r
    tryHandler (e -> m a
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError e
    e) [Handler e m a]
    hs where
        tryHandler :: Handler e m r -> m r -> m r
    tryHandler (Handler e -> Maybe a
    ema a -> m r
    amr) m r
    res = m r -> (a -> m r) -> Maybe a -> m r
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m r
    res a -> m r
    amr (e -> Maybe a
    ema e
    e)

    ------------------------------------------------------------------------------
    -- Handlers
    ------------------------------------------------------------------------------

    -- | You need this when using 'catches'.
    data Handler e m r = forall a. Handler (e -> Maybe a) (a -> m r)

    instance Monad m => Functor (Handler e m) where
      fmap :: forall a b. (a -> b) -> Handler e m a -> Handler e m b
    fmap a -> b
    f (Handler e -> Maybe a
    ema a -> m a
    amr) = (e -> Maybe a) -> (a -> m b) -> Handler e m b
    forall e (m :: * -> *) r a.
    (e -> Maybe a) -> (a -> m r) -> Handler e m r
    Handler e -> Maybe a
    ema ((a -> m b) -> Handler e m b) -> (a -> m b) -> Handler e m b
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> do
         r <- a -> m a
    amr a
    a
         return (f r)
      {-# INLINE fmap #-}

    instance Monad m => Semigroup (Handler e m a) where
      <> :: Handler e m a -> Handler e m a -> Handler e m a
    (<>) = Handler e m a -> Handler e m a -> Handler e m a
    forall a. Handler e m a -> Handler e m a -> Handler e m a
    forall (f :: * -> *) a. Alt f => f a -> f a -> f a
    (<!>)
      {-# INLINE (<>) #-}

    instance Monad m => Alt (Handler e m) where
      Handler e -> Maybe a
    ema a -> m a
    amr <!> :: forall a. Handler e m a -> Handler e m a -> Handler e m a
    <!> Handler e -> Maybe a
    emb a -> m a
    bmr = (e -> Maybe (Either a a)) -> (Either a a -> m a) -> Handler e m a
    forall e (m :: * -> *) r a.
    (e -> Maybe a) -> (a -> m r) -> Handler e m r
    Handler e -> Maybe (Either a a)
    emab Either a a -> m a
    abmr where
        emab :: e -> Maybe (Either a a)
    emab e
    e = a -> Either a a
    forall a b. a -> Either a b
    Left (a -> Either a a) -> Maybe a -> Maybe (Either a a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> e -> Maybe a
    ema e
    e Maybe (Either a a) -> Maybe (Either a a) -> Maybe (Either a a)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> a -> Either a a
    forall a b. b -> Either a b
    Right (a -> Either a a) -> Maybe a -> Maybe (Either a a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> e -> Maybe a
    emb e
    e
        abmr :: Either a a -> m a
    abmr = (a -> m a) -> (a -> m a) -> Either a a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either a -> m a
    amr a -> m a
    bmr
      {-# INLINE (<!>) #-}

    instance Monad m => Plus (Handler e m) where
      zero :: forall a. Handler e m a
    zero = (e -> Maybe (ZonkAny 0)) -> (ZonkAny 0 -> m a) -> Handler e m a
    forall e (m :: * -> *) r a.
    (e -> Maybe a) -> (a -> m r) -> Handler e m r
    Handler (Maybe (ZonkAny 0) -> e -> Maybe (ZonkAny 0)
    forall a b. a -> b -> a
    const Maybe (ZonkAny 0)
    forall a. Maybe a
    Nothing) ZonkAny 0 -> m a
    forall a. HasCallStack => a
    undefined
      {-# INLINE zero #-}

    instance Monad m => M.Monoid (Handler e m a) where
      mempty :: Handler e m a
    mempty = Handler e m a
    forall a. Handler e m a
    forall (f :: * -> *) a. Plus f => f a
    zero
      {-# INLINE mempty #-}
    #if !(MIN_VERSION_base(4,11,0))
      mappend = (<!>)
      {-# INLINE mappend #-}
    #endif

    instance Handleable e m (Handler e m) where
      handler :: forall a r.
    Typeable a =>
    Getting (First a) e a -> (a -> m r) -> Handler e m r
    handler = (e -> Maybe a) -> (a -> m r) -> Handler e m r
    forall e (m :: * -> *) r a.
    (e -> Maybe a) -> (a -> m r) -> Handler e m r
    Handler ((e -> Maybe a) -> (a -> m r) -> Handler e m r)
    -> (Getting (First a) e a -> e -> Maybe a)
    -> Getting (First a) e a
    -> (a -> m r)
    -> Handler e m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Getting (First a) e a -> e -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview
      {-# INLINE handler #-}

    ------------------------------------------------------------------------------
    -- Throwing
    ------------------------------------------------------------------------------

    -- | Throw an exception described by a t'Prism'.
    --
    -- @'throwing' l ≡ 'reviews' l 'throwError'@
    --
    -- @
    -- 'throwing' :: 'MonadError' e m => 'Prism'' e t -> t -> m a
    -- 'throwing' :: 'MonadError' e m => 'Iso'' e t   -> t -> m a
    -- @
    throwing :: MonadError e m => AReview e t -> t -> m x
    throwing :: forall e (m :: * -> *) t x.
    MonadError e m =>
    AReview e t -> t -> m x
    throwing AReview e t
    l = AReview e t -> (e -> m x) -> t -> m x
    forall b (m :: * -> *) t r.
    MonadReader b m =>
    AReview t b -> (t -> r) -> m r
    reviews AReview e t
    l e -> m x
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError
    {-# INLINE throwing #-}

    ------------------------------------------------------------------------------
    -- Misc.
    ------------------------------------------------------------------------------

    -- | Helper function to provide conditional catch behavior.
    catchJust :: MonadError e m => (e -> Maybe t) -> m a -> (t -> m a) -> m a
    catchJust :: forall e (m :: * -> *) t a.
    MonadError e m =>
    (e -> Maybe t) -> m a -> (t -> m a) -> m a
    catchJust e -> Maybe t
    f m a
    m t -> m a
    k = m a -> (e -> m a) -> m a
    forall a. m a -> (e -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError m a
    m ((e -> m a) -> m a) -> (e -> m a) -> m a
    forall a b. (a -> b) -> a -> b
    $ \ e
    e -> case e -> Maybe t
    f e
    e of
      Maybe t
    Nothing -> e -> m a
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError e
    e
      Just t
    x  -> t -> m a
    k t
    x
    {-# INLINE catchJust #-}

    -- | Similar to 'throwing' but specialised for the common case of
    --   error constructors with no arguments.
    --
    -- @
    -- data MyError = Foo | Bar
    -- makePrisms ''MyError
    -- 'throwing_' _Foo :: 'MonadError' MyError m => m a
    -- @
    throwing_ :: MonadError e m => AReview e () -> m x
    throwing_ :: forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
    throwing_ AReview e ()
    l = AReview e () -> () -> m x
    forall e (m :: * -> *) t x.
    MonadError e m =>
    AReview e t -> t -> m x
    throwing AReview e ()
    l ()
    {-# INLINE throwing_ #-}