{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module:       $HEADER$
-- Description:  Support for hidden exceptions.
-- Copyright:    (c) 2009-2016, Peter Trško
-- License:      BSD3
--
-- Stability:    provisional
-- Portability:  non-portable (CPP, NoImplicitPrelude, depends on non-portable
--               module)
module Control.Monad.TaggedException.Hidden
    (
    -- * HiddenException class
    --
    -- | Since 'HiddenException' provides default implementation for 'hide'
    -- method making instances of it is trivial. Example of how to create
    -- instance of HiddenException:
    --
    -- > data MyException = MyException String
    -- >   deriving (Typeable)
    -- >
    -- > instance Show MyException where
    -- >     showsPrec _ (MyException msg) =
    -- >         showString "MyException: " . shows msg
    -- >
    -- > instance Exception MyException
    -- > instance HiddenException MyException
      HiddenException(..)

    -- ** Mapping existing visible exception to hidden ones
    --
    -- | This is a prefered way of hiding exceptions. Difference from just
    -- hiding the type tag and mapping it in to hidden exception is that in
    -- later case we can provide additional information. Most important is to
    -- specify why that particluar exception was hidden.
    --
    -- Example:
    --
    -- > data UnrecoverableException
    -- >     = UnrecoverableIOException String IOException
    -- >   deriving (Typeable)
    -- >
    -- > instance Show UnrecoverableException where
    -- >     showsPrec _ (UnrecoverableIOException info e)
    -- >         showString "Unrecoverable exception occurred in "
    -- >         . showString info . showString ": " . shows e
    -- >
    -- > instance Exception UnrecoverableException
    -- > instance HiddenException UnrecoverableException
    -- >
    -- > hideIOException
    -- >     :: (MonadCatch e)
    -- >     => String
    -- >     -> Throws IOException m a
    -- >     -> m a
    -- > hideIOException = hideWith . UnrecoverableIOException
    , hideWith

    -- ** Raising hidden exceptions
    , throwHidden
    , throw'
    )
  where

import Control.Exception (Exception)
import qualified Control.Exception as E
#if MIN_VERSION_base(4,8,0)
    ( AllocationLimitExceeded
    , ArithException
#else
    ( ArithException
#endif
    , ArrayException
    , AssertionFailed
    , AsyncException
#if MIN_VERSION_base(4,2,0)
    , BlockedIndefinitelyOnMVar
    , BlockedIndefinitelyOnSTM
#else
    , BlockedIndefinitely
    , BlockedOnDeadMVar
#endif
    , Deadlock
    , ErrorCall
    , IOException
    , NestedAtomically
    , NoMethodError
    , NonTermination
    , PatternMatchFail
    , RecConError
    , RecSelError
    , RecUpdError
#if MIN_VERSION_base(4,7,0)
    , SomeAsyncException
#endif
    , SomeException
#if MIN_VERSION_base(4,9,0)
    , TypeError
#endif
    )
import Data.Dynamic (Dynamic)
import Data.Function ((.))
#if MIN_VERSION_base(4,8,0)
import Data.Void (Void)
#endif
import System.Exit (ExitCode)

import Control.Monad.Catch (MonadCatch, MonadThrow)
import qualified Control.Monad.Catch as Exceptions
    ( MonadCatch(catch)
    , MonadThrow(throwM)
    )

-- This module depends only on internals and nothing else from this package.
-- Try, hard, to keep it that way.
import Control.Monad.TaggedException.Internal.Throws (Throws(Throws))
import qualified Control.Monad.TaggedException.Internal.Throws as Internal
    (Throws(hideException))


-- | Class for exception that can be removed from the type signature. Default
-- implementation for 'hideException' method is provided.
class Exception e => HiddenException e where
    -- | Hide exception tag.
    hideException :: MonadThrow m => Throws e m a -> m a
    hideException = Internal.hideException
    {-# INLINE hideException #-}

-- {{{ HiddenException -- Instances -------------------------------------------
-- (sorted alphabetically)

instance HiddenException Dynamic
instance HiddenException E.ArithException
instance HiddenException E.ArrayException
instance HiddenException E.AssertionFailed
instance HiddenException E.AsyncException
instance HiddenException E.BlockedIndefinitelyOnMVar
instance HiddenException E.BlockedIndefinitelyOnSTM
instance HiddenException E.Deadlock
instance HiddenException E.ErrorCall
instance HiddenException E.IOException
instance HiddenException E.NestedAtomically
instance HiddenException E.NoMethodError
instance HiddenException E.NonTermination
instance HiddenException E.PatternMatchFail
instance HiddenException E.RecConError
instance HiddenException E.RecSelError
instance HiddenException E.RecUpdError
instance HiddenException E.SomeException
instance HiddenException ExitCode

#if MIN_VERSION_base(4,7,0)
instance HiddenException E.SomeAsyncException
#endif

#if MIN_VERSION_base(4,8,0)
instance HiddenException E.AllocationLimitExceeded
instance HiddenException Void
#endif

#if MIN_VERSION_base(4,9,0)
instance HiddenException E.TypeError
#endif

-- }}} HiddenException -- Instances -------------------------------------------

-- | Map exception before hiding it.
--
-- This is the preferred way to do exception hiding, by mapping it in to a
-- different exception that better describes its fatality.
hideWith
    :: (Exception e, HiddenException e', MonadCatch m)
    => (e -> e')
    -> Throws e m a
    -> m a
hideWith f (Throws ma) = Exceptions.catch ma (Exceptions.throwM . f)

-- | Throw exceptions and then disregard type tag.
throwHidden
    :: (HiddenException e, MonadThrow m)
    => e
    -> m a
throwHidden = Exceptions.throwM
{-# INLINE throwHidden #-}

-- | Alias for @throwHidden@.
throw'
    :: (HiddenException e, MonadThrow m)
    => e
    -> m a
throw' = Exceptions.throwM
{-# INLINE throw' #-}