{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- | This module defines an exception wrapper 'AnnotatedException' that
-- carries a list of 'Annotation's, along with some helper methods for
-- throwing and catching that can make the annotations transparent.
--
-- While this library can be used directly, it is recommended that you
-- define your own types and functions specific to your domain. As an
-- example, 'checkpoint' is useful *only* for providing exception
-- annotation information. However, you probably want to use 'checkpoint'
-- in concert with other context adding features, like logging.
--
-- Likewise, the 'Annotation' type defined in "Data.Annotation" is
-- essentially a wrapper for a dynamically typed value. So you probably
-- want to define your own 'checkpoint' that uses a custom type that you
-- want to enforce throughout your application.
module Control.Exception.Annotated
    ( -- * The Main Type
      AnnotatedException(..)
    , new
    , throwWithCallStack
    -- * Annotating Exceptions
    , checkpoint
    , checkpointMany
    , checkpointCallStack
    , checkpointCallStackWith
    -- * Handling Exceptions
    , catch
    , tryAnnotated
    , try

    -- * Manipulating Annotated Exceptions
    , check
    , hide
    , annotatedExceptionCallStack
    , addCallStackToException

    -- * Re-exports from "Data.Annotation"
    , Annotation(..)
    , CallStackAnnotation(..)
    -- * Re-exports from "Control.Exception.Safe"
    , Exception(..)
    , Safe.SomeException(..)
    , Safe.throw
    , Handler (..)
    ) where

import Control.Exception.Safe
       (Exception, Handler(..), MonadCatch, MonadThrow, SomeException(..))
import qualified Control.Exception.Safe as Safe
import Data.Annotation
import Data.Maybe
import Data.Typeable
import GHC.Stack

-- | The 'AnnotatedException' type wraps an @exception@ with
-- a @['Annotation']@. This can provide a sort of a manual stack trace with
-- programmer provided data.
--
-- @since 0.1.0.0
data AnnotatedException exception
    = AnnotatedException
    { AnnotatedException exception -> [Annotation]
annotations :: [Annotation]
    , AnnotatedException exception -> exception
exception   :: exception
    }
    deriving (AnnotatedException exception
-> AnnotatedException exception -> Bool
(AnnotatedException exception
 -> AnnotatedException exception -> Bool)
-> (AnnotatedException exception
    -> AnnotatedException exception -> Bool)
-> Eq (AnnotatedException exception)
forall exception.
Eq exception =>
AnnotatedException exception
-> AnnotatedException exception -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotatedException exception
-> AnnotatedException exception -> Bool
$c/= :: forall exception.
Eq exception =>
AnnotatedException exception
-> AnnotatedException exception -> Bool
== :: AnnotatedException exception
-> AnnotatedException exception -> Bool
$c== :: forall exception.
Eq exception =>
AnnotatedException exception
-> AnnotatedException exception -> Bool
Eq, Int -> AnnotatedException exception -> ShowS
[AnnotatedException exception] -> ShowS
AnnotatedException exception -> String
(Int -> AnnotatedException exception -> ShowS)
-> (AnnotatedException exception -> String)
-> ([AnnotatedException exception] -> ShowS)
-> Show (AnnotatedException exception)
forall exception.
Show exception =>
Int -> AnnotatedException exception -> ShowS
forall exception.
Show exception =>
[AnnotatedException exception] -> ShowS
forall exception.
Show exception =>
AnnotatedException exception -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnotatedException exception] -> ShowS
$cshowList :: forall exception.
Show exception =>
[AnnotatedException exception] -> ShowS
show :: AnnotatedException exception -> String
$cshow :: forall exception.
Show exception =>
AnnotatedException exception -> String
showsPrec :: Int -> AnnotatedException exception -> ShowS
$cshowsPrec :: forall exception.
Show exception =>
Int -> AnnotatedException exception -> ShowS
Show, a -> AnnotatedException b -> AnnotatedException a
(a -> b) -> AnnotatedException a -> AnnotatedException b
(forall a b.
 (a -> b) -> AnnotatedException a -> AnnotatedException b)
-> (forall a b. a -> AnnotatedException b -> AnnotatedException a)
-> Functor AnnotatedException
forall a b. a -> AnnotatedException b -> AnnotatedException a
forall a b.
(a -> b) -> AnnotatedException a -> AnnotatedException b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AnnotatedException b -> AnnotatedException a
$c<$ :: forall a b. a -> AnnotatedException b -> AnnotatedException a
fmap :: (a -> b) -> AnnotatedException a -> AnnotatedException b
$cfmap :: forall a b.
(a -> b) -> AnnotatedException a -> AnnotatedException b
Functor, AnnotatedException a -> Bool
(a -> m) -> AnnotatedException a -> m
(a -> b -> b) -> b -> AnnotatedException a -> b
(forall m. Monoid m => AnnotatedException m -> m)
-> (forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m)
-> (forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m)
-> (forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b)
-> (forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b)
-> (forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b)
-> (forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b)
-> (forall a. (a -> a -> a) -> AnnotatedException a -> a)
-> (forall a. (a -> a -> a) -> AnnotatedException a -> a)
-> (forall a. AnnotatedException a -> [a])
-> (forall a. AnnotatedException a -> Bool)
-> (forall a. AnnotatedException a -> Int)
-> (forall a. Eq a => a -> AnnotatedException a -> Bool)
-> (forall a. Ord a => AnnotatedException a -> a)
-> (forall a. Ord a => AnnotatedException a -> a)
-> (forall a. Num a => AnnotatedException a -> a)
-> (forall a. Num a => AnnotatedException a -> a)
-> Foldable AnnotatedException
forall a. Eq a => a -> AnnotatedException a -> Bool
forall a. Num a => AnnotatedException a -> a
forall a. Ord a => AnnotatedException a -> a
forall m. Monoid m => AnnotatedException m -> m
forall a. AnnotatedException a -> Bool
forall a. AnnotatedException a -> Int
forall a. AnnotatedException a -> [a]
forall a. (a -> a -> a) -> AnnotatedException a -> a
forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: AnnotatedException a -> a
$cproduct :: forall a. Num a => AnnotatedException a -> a
sum :: AnnotatedException a -> a
$csum :: forall a. Num a => AnnotatedException a -> a
minimum :: AnnotatedException a -> a
$cminimum :: forall a. Ord a => AnnotatedException a -> a
maximum :: AnnotatedException a -> a
$cmaximum :: forall a. Ord a => AnnotatedException a -> a
elem :: a -> AnnotatedException a -> Bool
$celem :: forall a. Eq a => a -> AnnotatedException a -> Bool
length :: AnnotatedException a -> Int
$clength :: forall a. AnnotatedException a -> Int
null :: AnnotatedException a -> Bool
$cnull :: forall a. AnnotatedException a -> Bool
toList :: AnnotatedException a -> [a]
$ctoList :: forall a. AnnotatedException a -> [a]
foldl1 :: (a -> a -> a) -> AnnotatedException a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AnnotatedException a -> a
foldr1 :: (a -> a -> a) -> AnnotatedException a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> AnnotatedException a -> a
foldl' :: (b -> a -> b) -> b -> AnnotatedException a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
foldl :: (b -> a -> b) -> b -> AnnotatedException a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
foldr' :: (a -> b -> b) -> b -> AnnotatedException a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
foldr :: (a -> b -> b) -> b -> AnnotatedException a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
foldMap' :: (a -> m) -> AnnotatedException a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
foldMap :: (a -> m) -> AnnotatedException a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
fold :: AnnotatedException m -> m
$cfold :: forall m. Monoid m => AnnotatedException m -> m
Foldable, Functor AnnotatedException
Foldable AnnotatedException
Functor AnnotatedException
-> Foldable AnnotatedException
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> AnnotatedException a -> f (AnnotatedException b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    AnnotatedException (f a) -> f (AnnotatedException a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AnnotatedException a -> m (AnnotatedException b))
-> (forall (m :: * -> *) a.
    Monad m =>
    AnnotatedException (m a) -> m (AnnotatedException a))
-> Traversable AnnotatedException
(a -> f b) -> AnnotatedException a -> f (AnnotatedException b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AnnotatedException (m a) -> m (AnnotatedException a)
forall (f :: * -> *) a.
Applicative f =>
AnnotatedException (f a) -> f (AnnotatedException a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AnnotatedException a -> m (AnnotatedException b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnnotatedException a -> f (AnnotatedException b)
sequence :: AnnotatedException (m a) -> m (AnnotatedException a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AnnotatedException (m a) -> m (AnnotatedException a)
mapM :: (a -> m b) -> AnnotatedException a -> m (AnnotatedException b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AnnotatedException a -> m (AnnotatedException b)
sequenceA :: AnnotatedException (f a) -> f (AnnotatedException a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AnnotatedException (f a) -> f (AnnotatedException a)
traverse :: (a -> f b) -> AnnotatedException a -> f (AnnotatedException b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnnotatedException a -> f (AnnotatedException b)
$cp2Traversable :: Foldable AnnotatedException
$cp1Traversable :: Functor AnnotatedException
Traversable)

instance Applicative AnnotatedException where
    pure :: a -> AnnotatedException a
pure =
        [Annotation] -> a -> AnnotatedException a
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException []

    AnnotatedException [Annotation]
anns0 a -> b
f <*> :: AnnotatedException (a -> b)
-> AnnotatedException a -> AnnotatedException b
<*> AnnotatedException [Annotation]
anns1 a
a =
        [Annotation] -> b -> AnnotatedException b
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException ([Annotation]
anns0 [Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<> [Annotation]
anns1) (a -> b
f a
a)

-- | This instance of 'Exception' is a bit interesting. It tries to do as
-- much hiding and packing and flattening as possible to ensure that even
-- exception handling machinery outside of this package can still
-- intelligently handle it.
--
-- Any 'Exception' can be caught as a 'AnnotatedException' with
-- an empty context, so catching a @'AnnotatedException' e@ will also catch
-- a regular @e@ and give it an empty set of annotations.
--
-- Likewise, if a @'AnnotatedException' ('AnnotatedException' e)@ is thrown
-- somehow, then the 'fromException' will flatten it and combine their
-- contexts.
--
-- For the most up to date details, see the test suite.
--
-- @since 0.1.0.0
instance (Exception exception) => Exception (AnnotatedException exception) where
    toException :: AnnotatedException exception -> SomeException
toException AnnotatedException exception
loc = AnnotatedException SomeException -> SomeException
forall e. Exception e => e -> SomeException
SomeException (AnnotatedException SomeException -> SomeException)
-> AnnotatedException SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$ AnnotatedException exception -> AnnotatedException SomeException
forall e.
Exception e =>
AnnotatedException e -> AnnotatedException SomeException
hide AnnotatedException exception
loc
    fromException :: SomeException -> Maybe (AnnotatedException exception)
fromException (SomeException e
exn)
        | Just AnnotatedException exception
x <- e -> Maybe (AnnotatedException exception)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
exn
        =
            AnnotatedException exception
-> Maybe (AnnotatedException exception)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnotatedException exception
x
        | Just (AnnotatedException [Annotation]
ann (SomeException
e :: SomeException)) <- e -> Maybe (AnnotatedException SomeException)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
exn
        , Just exception
a <- SomeException -> Maybe exception
forall e. Exception e => SomeException -> Maybe e
Safe.fromException SomeException
e
        =
            AnnotatedException exception
-> Maybe (AnnotatedException exception)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedException exception
 -> Maybe (AnnotatedException exception))
-> AnnotatedException exception
-> Maybe (AnnotatedException exception)
forall a b. (a -> b) -> a -> b
$ [Annotation] -> exception -> AnnotatedException exception
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException [Annotation]
ann exception
a
    fromException SomeException
exn
        | Just (exception
e :: exception) <- SomeException -> Maybe exception
forall e. Exception e => SomeException -> Maybe e
Safe.fromException SomeException
exn
        =
            AnnotatedException exception
-> Maybe (AnnotatedException exception)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedException exception
 -> Maybe (AnnotatedException exception))
-> AnnotatedException exception
-> Maybe (AnnotatedException exception)
forall a b. (a -> b) -> a -> b
$ exception -> AnnotatedException exception
forall a. a -> AnnotatedException a
new exception
e
        | Just AnnotatedException exception
x <- AnnotatedException (AnnotatedException exception)
-> AnnotatedException exception
forall e.
AnnotatedException (AnnotatedException e) -> AnnotatedException e
flatten (AnnotatedException (AnnotatedException exception)
 -> AnnotatedException exception)
-> Maybe (AnnotatedException (AnnotatedException exception))
-> Maybe (AnnotatedException exception)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException
-> Maybe (AnnotatedException (AnnotatedException exception))
forall e. Exception e => SomeException -> Maybe e
Safe.fromException SomeException
exn
        =
            AnnotatedException exception
-> Maybe (AnnotatedException exception)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnotatedException exception
x
        | Bool
otherwise
        =
            Maybe (AnnotatedException exception)
forall a. Maybe a
Nothing

-- | Attach an empty @['Annotation']@ to an exception.
--
-- @since 0.1.0.0
new :: e -> AnnotatedException e
new :: e -> AnnotatedException e
new = e -> AnnotatedException e
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Append the @['Annotation']@ to the 'AnnotatedException'.
--
-- @since 0.1.0.0
annotate :: [Annotation] -> AnnotatedException e -> AnnotatedException e
annotate :: [Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
ann (AnnotatedException [Annotation]
anns e
e) = [Annotation] -> e -> AnnotatedException e
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException ([Annotation]
ann [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
anns) e
e

-- | Call 'toException' on the underlying 'Exception'.
--
-- @since 0.1.0.0
hide :: Exception e => AnnotatedException e -> AnnotatedException SomeException
hide :: AnnotatedException e -> AnnotatedException SomeException
hide = (e -> SomeException)
-> AnnotatedException e -> AnnotatedException SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> SomeException
forall e. Exception e => e -> SomeException
Safe.toException

-- | Call 'fromException' on the underlying 'Exception', attaching the
-- annotations to the result.
--
-- @since 0.1.0.0
check :: Exception e => AnnotatedException SomeException -> Maybe (AnnotatedException e)
check :: AnnotatedException SomeException -> Maybe (AnnotatedException e)
check = (SomeException -> Maybe e)
-> AnnotatedException SomeException -> Maybe (AnnotatedException e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
Safe.fromException

-- | Catch an exception. This works just like 'Safe.catch', but it also
-- will attempt to catch @'AnnotatedException' e@. The annotations will be
-- preserved in the handler, so rethrowing exceptions will retain the
-- context.
--
-- Let's consider a few examples, that share this import and exception
-- type.
--
-- > import qualified Control.Exception.Safe as Safe
-- > import Control.Exception.Annotated
-- >
-- > data TestException deriving (Show, Exception)
--
-- We can throw an exception and catch it as usual.
--
-- > throw TestException `catch` \TestException ->
-- >     putStrLn "ok!"
--
-- We can throw an exception and catch it with location.
--
-- > throw TestException `catch` \(AnnotatedException anns TestException) ->
-- >     putStrLn "ok!"
--
--
-- We can throw an exception and catch it as a @'AnnotatedException'
-- 'SomeException'@.
--
-- > throw TestException `catch` \(AnnotatedException anns (e :: SomeException) ->
-- >     putStrLn "ok!"
--
-- @since 0.1.0.0
catch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a
catch :: m a -> (e -> m a) -> m a
catch m a
action e -> m a
handler =
    m a -> [Handler m a] -> m a
forall (m :: * -> *) a. MonadCatch m => m a -> [Handler m a] -> m a
catches m a
action [(e -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler e -> m a
handler]

-- | Like 'Safe.catches', but this function enhance the provided 'Handler's
-- to "see through" any 'AnnotatedException's.
--
-- @since 0.1.1.0
catches :: (MonadCatch m) => m a -> [Handler m a] -> m a
catches :: m a -> [Handler m a] -> m a
catches m a
action [Handler m a]
handlers =
    m a -> [Handler m a] -> m a
forall (m :: * -> *) a.
(MonadCatch m, MonadThrow m) =>
m a -> [Handler m a] -> m a
Safe.catches m a
action ([Handler m a] -> [Handler m a]
forall (m :: * -> *) a.
MonadCatch m =>
[Handler m a] -> [Handler m a]
mkAnnotatedHandlers [Handler m a]
handlers)

-- | Extends each 'Handler' in the list with a variant that sees through
-- the 'AnnotatedException' and re-annotates any rethrown exceptions.
--
-- @since 0.1.1.0
mkAnnotatedHandlers :: MonadCatch m => [Handler m a] -> [Handler m a]
mkAnnotatedHandlers :: [Handler m a] -> [Handler m a]
mkAnnotatedHandlers [Handler m a]
xs =
    [Handler m a]
xs [Handler m a] -> (Handler m a -> [Handler m a]) -> [Handler m a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Handler e -> m a
hndlr) ->
        [ (e -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler e -> m a
hndlr
        , (AnnotatedException e -> m a) -> Handler m a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((AnnotatedException e -> m a) -> Handler m a)
-> (AnnotatedException e -> m a) -> Handler m a
forall a b. (a -> b) -> a -> b
$ \(AnnotatedException [Annotation]
anns e
e) ->
            [Annotation] -> m a -> m a
forall (m :: * -> *) a. MonadCatch m => [Annotation] -> m a -> m a
checkpointMany [Annotation]
anns (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ e -> m a
hndlr e
e
        ]

-- | Like 'catch', but always returns a 'AnnotatedException'.
--
-- @since 0.1.0.0
tryAnnotated :: (Exception e, MonadCatch m) => m a -> m (Either (AnnotatedException e) a)
tryAnnotated :: m a -> m (Either (AnnotatedException e) a)
tryAnnotated m a
action =
    (a -> Either (AnnotatedException e) a
forall a b. b -> Either a b
Right (a -> Either (AnnotatedException e) a)
-> m a -> m (Either (AnnotatedException e) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action) m (Either (AnnotatedException e) a)
-> (AnnotatedException e -> m (Either (AnnotatedException e) a))
-> m (Either (AnnotatedException e) a)
forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
`catch` (Either (AnnotatedException e) a
-> m (Either (AnnotatedException e) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (AnnotatedException e) a
 -> m (Either (AnnotatedException e) a))
-> (AnnotatedException e -> Either (AnnotatedException e) a)
-> AnnotatedException e
-> m (Either (AnnotatedException e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedException e -> Either (AnnotatedException e) a
forall a b. a -> Either a b
Left)

-- | Like 'Safe.try', but can also handle an 'AnnotatedException' or the
-- underlying value. Useful when you want to 'try' to catch a type of
-- exception, but you may not care about the 'Annotation's that it may or
-- may not have.
--
-- Example:
--
-- > Left exn <- try $ throw (AnnotatedException [] TestException)
-- > exn == TestException
--
-- > Left exn <- try $ throw TestException
-- > exn == AnnotatedException [] TestException
--
-- @since 0.1.0.1
try :: (Exception e, MonadCatch m) => m a -> m (Either e a)
try :: m a -> m (Either e a)
try m a
action = do
    (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action)
      m (Either e a) -> [Handler m (Either e a)] -> m (Either e a)
forall (m :: * -> *) a. MonadCatch m => m a -> [Handler m a] -> m a
`catches`
          [Handler m (Either e a)] -> [Handler m (Either e a)]
forall (m :: * -> *) a.
MonadCatch m =>
[Handler m a] -> [Handler m a]
mkAnnotatedHandlers [(e -> m (Either e a)) -> Handler m (Either e a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\e
exn -> Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left e
exn)]

-- | Attaches the 'CallStack' to the 'AnnotatedException' that is thrown.
--
-- The 'CallStack' will *not* be present as a 'CallStack' - it will be
-- a 'CallStackAnnotation'.
--
-- @since 0.1.0.0
throwWithCallStack
    :: (HasCallStack, MonadThrow m, Exception e)
    => e -> m a
throwWithCallStack :: e -> m a
throwWithCallStack e
e =
    AnnotatedException e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Safe.throw ([Annotation] -> e -> AnnotatedException e
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException [Annotation
HasCallStack => Annotation
callStackAnnotation] e
e)

-- | Concatenate two lists of annotations.
--
-- @since 0.1.0.0
flatten :: AnnotatedException (AnnotatedException e)  -> AnnotatedException e
flatten :: AnnotatedException (AnnotatedException e) -> AnnotatedException e
flatten (AnnotatedException [Annotation]
a (AnnotatedException [Annotation]
b e
c)) = [Annotation] -> e -> AnnotatedException e
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException ([Annotation]
a [Annotation] -> [Annotation] -> [Annotation]
forall a. [a] -> [a] -> [a]
++ [Annotation]
b) e
c

-- | Add a single 'Annotation' to any exceptions thrown in the following
-- action.
--
-- Example:
--
-- > main = do
-- >     checkpoint "Foo" $ do
-- >         print =<< readFile "I don't exist.markdown"
--
-- The exception thrown due to a missing file will now have an 'Annotation'
-- @"Foo"@.
--
-- @since 0.1.0.0
checkpoint :: MonadCatch m => Annotation -> m a -> m a
checkpoint :: Annotation -> m a -> m a
checkpoint Annotation
ann = [Annotation] -> m a -> m a
forall (m :: * -> *) a. MonadCatch m => [Annotation] -> m a -> m a
checkpointMany [Annotation
ann]

-- | Add the current 'CallStack' to the checkpoint. This function searches any
-- thrown exception for a pre-existing 'CallStack' and will not overwrite or
-- replace the 'CallStack' if one is already present.
--
-- Primarily useful when you're wrapping a third party library.
--
-- @since 0.1.0.0
checkpointCallStackWith
    :: (MonadCatch m, HasCallStack)
    => [Annotation]
    -> m a
    -> m a
checkpointCallStackWith :: [Annotation] -> m a -> m a
checkpointCallStackWith [Annotation]
ann m a
action =
    m a
action m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Safe.catch` \(SomeException
exn :: SomeException) ->
        AnnotatedException SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Safe.throw
            (AnnotatedException SomeException -> m a)
-> (AnnotatedException SomeException
    -> AnnotatedException SomeException)
-> AnnotatedException SomeException
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Annotation]
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
ann
            (AnnotatedException SomeException
 -> AnnotatedException SomeException)
-> (AnnotatedException SomeException
    -> AnnotatedException SomeException)
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall exception.
CallStack
-> AnnotatedException exception -> AnnotatedException exception
addCallStackToException CallStack
HasCallStack => CallStack
callStack
            (AnnotatedException SomeException -> m a)
-> AnnotatedException SomeException -> m a
forall a b. (a -> b) -> a -> b
$ case SomeException -> Maybe (AnnotatedException SomeException)
forall e. Exception e => SomeException -> Maybe e
Safe.fromException SomeException
exn of
                Just (AnnotatedException SomeException
e' :: AnnotatedException SomeException) ->
                    case AnnotatedException SomeException -> Maybe CallStack
forall exception. AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException SomeException
e' of
                        Maybe CallStack
Nothing ->
                            [Annotation]
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
ann AnnotatedException SomeException
e'
                        Just CallStack
_preexistingCallstack ->
                            AnnotatedException SomeException
e'
                Maybe (AnnotatedException SomeException)
Nothing -> do
                    [Annotation]
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
ann (AnnotatedException SomeException
 -> AnnotatedException SomeException)
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall a b. (a -> b) -> a -> b
$ SomeException -> AnnotatedException SomeException
forall a. a -> AnnotatedException a
new SomeException
exn

-- | Add the current 'CallStack' to the checkpoint. This function searches any
-- thrown exception for a pre-existing 'CallStack' and will not overwrite or
-- replace the 'CallStack' if one is already present.
--
-- Primarily useful when you're wrapping a third party library.
--
-- @since 0.1.0.0
checkpointCallStack
    :: (MonadCatch m, HasCallStack)
    => m a
    -> m a
checkpointCallStack :: m a -> m a
checkpointCallStack =
    [Annotation] -> m a -> m a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointCallStackWith []

-- | Add the list of 'Annotations' to any exception thrown in the following
-- action.
--
-- @since 0.1.0.0
checkpointMany :: (MonadCatch m) => [Annotation] -> m a -> m a
checkpointMany :: [Annotation] -> m a -> m a
checkpointMany [Annotation]
ann m a
action =
    m a
action m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Safe.catch` \(SomeException
exn :: SomeException) ->
        AnnotatedException SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Safe.throw (AnnotatedException SomeException -> m a)
-> (AnnotatedException SomeException
    -> AnnotatedException SomeException)
-> AnnotatedException SomeException
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Annotation]
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
ann (AnnotatedException SomeException -> m a)
-> AnnotatedException SomeException -> m a
forall a b. (a -> b) -> a -> b
$ case SomeException -> Maybe (AnnotatedException SomeException)
forall e. Exception e => SomeException -> Maybe e
Safe.fromException SomeException
exn of
            Just (AnnotatedException SomeException
e' :: AnnotatedException SomeException) ->
                AnnotatedException SomeException
e'
            Maybe (AnnotatedException SomeException)
Nothing -> do
                SomeException -> AnnotatedException SomeException
forall a. a -> AnnotatedException a
new SomeException
exn

-- | Retrieves the 'CallStack' from an 'AnnotatedException' if one is present.
--
-- @since 0.1.0.0
annotatedExceptionCallStack :: AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack :: AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException exception
exn =
    let ([CallStack]
stacks, [Annotation]
_rest) = [Annotation] -> ([CallStack], [Annotation])
callStackInAnnotations (AnnotatedException exception -> [Annotation]
forall exception. AnnotatedException exception -> [Annotation]
annotations AnnotatedException exception
exn)
    in [CallStack] -> Maybe CallStack
forall a. [a] -> Maybe a
listToMaybe [CallStack]
stacks

-- | Adds a 'CallStack' to the given 'AnnotatedException'. This function will
-- search through the existing annotations, and it will not add a second
-- 'CallStack' to the list.
--
-- @since 0.1.0.0
addCallStackToException
    :: CallStack
    -> AnnotatedException exception
    -> AnnotatedException exception
addCallStackToException :: CallStack
-> AnnotatedException exception -> AnnotatedException exception
addCallStackToException CallStack
cs AnnotatedException exception
exn =
    case AnnotatedException exception -> Maybe CallStack
forall exception. AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException exception
exn of
        Maybe CallStack
Nothing ->
            [Annotation]
-> AnnotatedException exception -> AnnotatedException exception
forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [CallStack -> Annotation
callStackToAnnotation CallStack
cs] AnnotatedException exception
exn
        Just CallStack
_ ->
            AnnotatedException exception
exn