    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE RoleAnnotations #-}

    #include "lens-common.h"

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Internal.Exception
    -- Copyright   :  (C) 2013-2016 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- This module uses dirty tricks to generate a 'Handler' from an arbitrary
    -- 'Fold'.
    ----------------------------------------------------------------------------
    module Control.Lens.Internal.Exception
      ( Handleable(..)
      , HandlingException(..)
      ) where

    import Control.Exception as Exception
    import Control.Lens.Fold
    import Control.Lens.Getter
    import Control.Monad.Catch as Catch
    import Data.Kind
    import Data.Monoid
    import Data.Proxy
    import Data.Reflection
    import Data.Typeable

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

    -- | Both @exceptions@ and "Control.Exception" provide a 'Handler' type.
    --
    -- This lets us write combinators to build handlers that are agnostic about the choice of
    -- which of these they use.
    class Handleable e (m :: Type -> Type) (h :: Type -> Type) | h -> e m where
      -- | This builds a 'Handler' for just the targets of a given 'Control.Lens.Type.Prism' (or any 'Getter', really).
      --
      -- @
      -- 'catches' ... [ 'handler' 'Control.Exception.Lens._AssertionFailed' (\s -> 'print' '$' \"Assertion Failed\\n\" '++' s)
      --             , 'handler' 'Control.Exception.Lens._ErrorCall' (\s -> 'print' '$' \"Error\\n\" '++' s)
      --             ]
      -- @
      --
      -- This works ith both the 'Exception.Handler' type provided by @Control.Exception@:
      --
      -- @
      -- 'handler' :: 'Getter'     'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r
      -- 'handler' :: 'Fold'       'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r
      -- 'handler' :: 'Control.Lens.Prism.Prism''     'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r
      -- 'handler' :: 'Control.Lens.Lens.Lens''      'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r
      -- 'handler' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> (a -> 'IO' r) -> 'Exception.Handler' r
      -- @
      --
      -- and with the 'Catch.Handler' type provided by @Control.Monad.Catch@:
      --
      -- @
      -- 'handler' :: 'Getter'     'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r
      -- 'handler' :: 'Fold'       'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r
      -- 'handler' :: 'Control.Lens.Prism.Prism''     'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r
      -- 'handler' :: 'Control.Lens.Lens.Lens''      'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r
      -- 'handler' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> (a -> m r) -> 'Catch.Handler' m r
      -- @
      --
      -- and with the 'Control.Monad.Error.Lens.Handler' type provided by @Control.Monad.Error.Lens@:
      --
      -- @
      -- 'handler' :: 'Getter'     e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler' :: 'Fold'       e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler' :: 'Control.Lens.Prism.Prism''     e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler' :: 'Control.Lens.Lens.Lens''      e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler' :: 'Control.Lens.Traversal.Traversal'' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r
      -- @
      handler :: Typeable a => Getting (First a) e a -> (a -> m r) -> h r

      -- | This builds a 'Handler' for just the targets of a given 'Control.Lens.Prism.Prism' (or any 'Getter', really).
      -- that ignores its input and just recovers with the stated monadic action.
      --
      -- @
      -- 'catches' ... [ 'handler_' 'Control.Exception.Lens._NonTermination' ('return' \"looped\")
      --             , 'handler_' 'Control.Exception.Lens._StackOverflow' ('return' \"overflow\")
      --             ]
      -- @
      --
      -- This works with the 'Exception.Handler' type provided by @Control.Exception@:
      --
      -- @
      -- 'handler_' :: 'Getter'     'SomeException' a -> 'IO' r -> 'Exception.Handler' r
      -- 'handler_' :: 'Fold'       'SomeException' a -> 'IO' r -> 'Exception.Handler' r
      -- 'handler_' :: 'Control.Lens.Prism.Prism''     'SomeException' a -> 'IO' r -> 'Exception.Handler' r
      -- 'handler_' :: 'Control.Lens.Lens.Lens''      'SomeException' a -> 'IO' r -> 'Exception.Handler' r
      -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> 'IO' r -> 'Exception.Handler' r
      -- @
      --
      -- and with the 'Catch.Handler' type provided by @Control.Monad.Catch@:
      --
      -- @
      -- 'handler_' :: 'Getter'     'SomeException' a -> m r -> 'Catch.Handler' m r
      -- 'handler_' :: 'Fold'       'SomeException' a -> m r -> 'Catch.Handler' m r
      -- 'handler_' :: 'Control.Lens.Prism.Prism''     'SomeException' a -> m r -> 'Catch.Handler' m r
      -- 'handler_' :: 'Control.Lens.Lens.Lens''      'SomeException' a -> m r -> 'Catch.Handler' m r
      -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' 'SomeException' a -> m r -> 'Catch.Handler' m r
      -- @
      --
      -- and with the 'Control.Monad.Error.Lens.Handler' type provided by @Control.Monad.Error.Lens@:
      --
      -- @
      -- 'handler_' :: 'Getter'     e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler_' :: 'Fold'       e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler_' :: 'Control.Lens.Prism.Prism''     e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler_' :: 'Control.Lens.Lens.Lens''      e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r
      -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r
      -- @
      handler_ :: Typeable a => Getting (First a) e a -> m r -> h r
      handler_ Getting (First a) e a
    l = Getting (First a) e a -> (a -> m r) -> h r
    forall a r.
    Typeable a =>
    Getting (First a) e a -> (a -> m r) -> h r
    forall e (m :: * -> *) (h :: * -> *) a r.
    (Handleable e m h, Typeable a) =>
    Getting (First a) e a -> (a -> m r) -> h r
    handler Getting (First a) e a
    l ((a -> m r) -> h r) -> (m r -> a -> m r) -> m r -> h r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m r -> a -> m r
    forall a b. a -> b -> a
    const
      {-# INLINE handler_ #-}

    instance Handleable SomeException IO Exception.Handler where
      handler :: forall a r.
    Typeable a =>
    Getting (First a) SomeException a -> (a -> IO r) -> Handler r
    handler = Getting (First a) SomeException a -> (a -> IO r) -> Handler r
    forall a r.
    Typeable a =>
    Getting (First a) SomeException a -> (a -> IO r) -> Handler r
    handlerIO

    instance Typeable m => Handleable SomeException m (Catch.Handler m) where
      handler :: forall a r.
    Typeable a =>
    Getting (First a) SomeException a -> (a -> m r) -> Handler m r
    handler = Getting (First a) SomeException a -> (a -> m r) -> Handler m r
    forall (m :: * -> *) a r.
    (Typeable a, Typeable m) =>
    Getting (First a) SomeException a -> (a -> m r) -> Handler m r
    handlerCatchIO

    handlerIO :: forall a r. Typeable a => Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r
    handlerIO :: forall a r.
    Typeable a =>
    Getting (First a) SomeException a -> (a -> IO r) -> Handler r
    handlerIO Getting (First a) SomeException a
    l a -> IO r
    f = (SomeException -> Maybe a)
    -> (forall {s}.
        (Typeable s, Reifies s (SomeException -> Maybe a)) =>
        Proxy s -> Handler r)
    -> Handler r
    forall a r.
    Typeable a =>
    a -> (forall s. (Typeable s, Reifies s a) => Proxy s -> r) -> r
    reifyTypeable (Getting (First a) SomeException a -> SomeException -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First a) SomeException a
    l) ((forall {s}.
      (Typeable s, Reifies s (SomeException -> Maybe a)) =>
      Proxy s -> Handler r)
     -> Handler r)
    -> (forall {s}.
        (Typeable s, Reifies s (SomeException -> Maybe a)) =>
        Proxy s -> Handler r)
    -> Handler r
    forall a b. (a -> b) -> a -> b
    $ \ (Proxy s
    _ :: Proxy s) -> (Handling a s IO -> IO r) -> Handler r
    forall a e. Exception e => (e -> IO a) -> Handler a
    Exception.Handler (\(Handling a
    a :: Handling a s IO) -> a -> IO r
    f a
    a)

    handlerCatchIO :: forall m a r. (Typeable a, Typeable m) => Getting (First a) SomeException a -> (a -> m r) -> Catch.Handler m r
    handlerCatchIO :: forall (m :: * -> *) a r.
    (Typeable a, Typeable m) =>
    Getting (First a) SomeException a -> (a -> m r) -> Handler m r
    handlerCatchIO Getting (First a) SomeException a
    l a -> m r
    f = (SomeException -> Maybe a)
    -> (forall {s}.
        (Typeable s, Reifies s (SomeException -> Maybe a)) =>
        Proxy s -> Handler m r)
    -> Handler m r
    forall a r.
    Typeable a =>
    a -> (forall s. (Typeable s, Reifies s a) => Proxy s -> r) -> r
    reifyTypeable (Getting (First a) SomeException a -> SomeException -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First a) SomeException a
    l) ((forall {s}.
      (Typeable s, Reifies s (SomeException -> Maybe a)) =>
      Proxy s -> Handler m r)
     -> Handler m r)
    -> (forall {s}.
        (Typeable s, Reifies s (SomeException -> Maybe a)) =>
        Proxy s -> Handler m r)
    -> Handler m r
    forall a b. (a -> b) -> a -> b
    $ \ (Proxy s
    _ :: Proxy s) -> (Handling a s m -> m r) -> Handler m r
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    Catch.Handler (\(Handling a
    a :: Handling a s m) -> a -> m r
    f a
    a)

    ------------------------------------------------------------------------------
    -- Helpers
    ------------------------------------------------------------------------------

    -- | There was an 'Exception' caused by abusing the internals of a 'Handler'.
    data HandlingException = HandlingException deriving Int -> HandlingException -> ShowS
    [HandlingException] -> ShowS
    HandlingException -> String
    (Int -> HandlingException -> ShowS)
    -> (HandlingException -> String)
    -> ([HandlingException] -> ShowS)
    -> Show HandlingException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HandlingException -> ShowS
    showsPrec :: Int -> HandlingException -> ShowS
    $cshow :: HandlingException -> String
    show :: HandlingException -> String
    $cshowList :: [HandlingException] -> ShowS
    showList :: [HandlingException] -> ShowS
    Show

    instance Exception HandlingException

    {-
    -- | This supplies a globally unique set of IDs so we can hack around the default use of 'cast' in 'SomeException'
    -- if someone, somehow, somewhere decides to reach in and catch and rethrow a @Handling@ 'Exception' by existentially
    -- opening a 'Handler' that uses it.
    supply :: IORef Int
    supply = unsafePerformIO $ newIORef 0
    {-# NOINLINE supply #-}
    -}

    -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does.
    newtype Handling a s (m :: Type -> Type) = Handling a

    type role Handling representational nominal nominal

    -- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here.
    instance Show (Handling a s m) where
      showsPrec :: Int -> Handling a s m -> ShowS
    showsPrec Int
    d Handling a s m
    _ = Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    "Handling ..."
      {-# INLINE showsPrec #-}

    instance ( Reifies s (SomeException -> Maybe a)
             , Typeable a, Typeable s
             , Typeable m
             )
        => Exception (Handling a (s :: Type) m) where
      toException :: Handling a s m -> SomeException
    toException Handling a s m
    _ = HandlingException -> SomeException
    forall e. Exception e => e -> SomeException
    SomeException HandlingException
    HandlingException
      {-# INLINE toException #-}
      fromException :: SomeException -> Maybe (Handling a s m)
    fromException = (a -> Handling a s m) -> Maybe a -> Maybe (Handling a s m)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Handling a s m
    forall {k} a (s :: k) (m :: * -> *). a -> Handling a s m
    Handling (Maybe a -> Maybe (Handling a s m))
    -> (SomeException -> Maybe a)
    -> SomeException
    -> Maybe (Handling a s m)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy s -> SomeException -> Maybe a
    forall {k} (s :: k) a (proxy :: k -> *).
    Reifies s a =>
    proxy s -> a
    forall (proxy :: * -> *). proxy s -> SomeException -> Maybe a
    reflect (Proxy s
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy s)
      {-# INLINE fromException #-}