{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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(..)
    , exceptionWithCallStack
    , throw
    , throwWithCallStack
    -- * Annotating Exceptions
    , checkpoint
    , checkpointMany
    , checkpointCallStack
    , checkpointCallStackWith
    -- * Handling Exceptions
    , catch
    , catches
    , 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(..)
    , Handler (..)
    ) where

import Control.Applicative ((<|>))
import Control.Exception.Safe
       (Exception, Handler(..), MonadCatch, MonadThrow, SomeException(..))
import qualified Control.Exception.Safe as Safe
import Data.Annotation
import Data.List (intersperse)
import Data.Maybe
import qualified Data.Set as Set
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
    { forall exception. AnnotatedException exception -> [Annotation]
annotations :: [Annotation]
    , forall exception. AnnotatedException exception -> exception
exception   :: exception
    }
    deriving ((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
$cfmap :: forall a b.
(a -> b) -> AnnotatedException a -> AnnotatedException b
fmap :: forall a b.
(a -> b) -> AnnotatedException a -> AnnotatedException b
$c<$ :: forall a b. a -> AnnotatedException b -> AnnotatedException a
<$ :: forall a b. a -> AnnotatedException b -> AnnotatedException a
Functor, (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
$cfold :: forall m. Monoid m => AnnotatedException m -> m
fold :: forall m. Monoid m => AnnotatedException m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> AnnotatedException a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AnnotatedException a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> AnnotatedException a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> AnnotatedException a -> a
foldr1 :: forall a. (a -> a -> a) -> AnnotatedException a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AnnotatedException a -> a
foldl1 :: forall a. (a -> a -> a) -> AnnotatedException a -> a
$ctoList :: forall a. AnnotatedException a -> [a]
toList :: forall a. AnnotatedException a -> [a]
$cnull :: forall a. AnnotatedException a -> Bool
null :: forall a. AnnotatedException a -> Bool
$clength :: forall a. AnnotatedException a -> Int
length :: forall a. AnnotatedException a -> Int
$celem :: forall a. Eq a => a -> AnnotatedException a -> Bool
elem :: forall a. Eq a => a -> AnnotatedException a -> Bool
$cmaximum :: forall a. Ord a => AnnotatedException a -> a
maximum :: forall a. Ord a => AnnotatedException a -> a
$cminimum :: forall a. Ord a => AnnotatedException a -> a
minimum :: forall a. Ord a => AnnotatedException a -> a
$csum :: forall a. Num a => AnnotatedException a -> a
sum :: forall a. Num a => AnnotatedException a -> a
$cproduct :: forall a. Num a => AnnotatedException a -> a
product :: forall a. Num a => AnnotatedException a -> a
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
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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnnotatedException a -> f (AnnotatedException b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnnotatedException a -> f (AnnotatedException b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AnnotatedException (f a) -> f (AnnotatedException a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AnnotatedException (f a) -> f (AnnotatedException a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AnnotatedException a -> m (AnnotatedException b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AnnotatedException a -> m (AnnotatedException b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AnnotatedException (m a) -> m (AnnotatedException a)
sequence :: forall (m :: * -> *) a.
Monad m =>
AnnotatedException (m a) -> m (AnnotatedException a)
Traversable)

instance (Exception exception) => Show (AnnotatedException exception) where
    show :: AnnotatedException exception -> [Char]
show = AnnotatedException exception -> [Char]
forall e. Exception e => e -> [Char]
Safe.displayException

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

    AnnotatedException [Annotation]
anns0 a -> b
f <*> :: forall a b.
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.
--
-- 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 =
        SomeException -> SomeException
tryFlatten (SomeException -> SomeException) -> SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$ 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 a. a -> Maybe a
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 a. a -> Maybe a
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 a. a -> Maybe a
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
forall (f :: * -> *) a. Applicative f => a -> f a
pure exception
e
        | Bool
otherwise
        =
            Maybe (AnnotatedException exception)
forall a. Maybe a
Nothing

    displayException :: AnnotatedException exception -> [Char]
displayException (AnnotatedException{exception
[Annotation]
annotations :: forall exception. AnnotatedException exception -> [Annotation]
exception :: forall exception. AnnotatedException exception -> exception
annotations :: [Annotation]
exception :: exception
..}) =
        [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
"\n" ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
            [ [Char]
"! AnnotatedException !"
            , [Char]
"Underlying exception type: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> [Char]
forall a. Show a => a -> [Char]
show TypeRep
exceptionType
            , [Char]
""
            ]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
showAndDisplayMessage
                [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
annotationsMessage
                [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
callStackMessage
      where
        exceptionType :: TypeRep
exceptionType =
            case exception -> SomeException
forall e. Exception e => e -> SomeException
Safe.toException exception
exception of
                SomeException e
innerException ->
                    e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
innerException

        shown :: [Char]
shown = exception -> [Char]
forall a. Show a => a -> [Char]
show exception
exception
        displayed :: [Char]
displayed = exception -> [Char]
forall e. Exception e => e -> [Char]
Safe.displayException exception
exception

        -- Only include the `show` section if it's not the same as the
        -- `displayException` output.
        --
        -- TODO: If the exception is multiple lines long, subsequent lines will
        -- not be indented.
        showAndDisplayMessage :: [[Char]]
showAndDisplayMessage =
            if [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
displayed
                then
                    [ [Char]
displayed ]
                else
                    [ [Char]
"displayException:"
                    , [Char]
"\t" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
displayed
                    , [Char]
""
                    , [Char]
"show:"
                    , [Char]
"\t" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
shown
                    ]

        ([CallStack]
callStacks, [Annotation]
otherAnnotations) = forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations @CallStack [Annotation]
annotations

        callStackMessage :: [[Char]]
callStackMessage =
            [ [Char]
""
            ] [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<>
            case [CallStack] -> Maybe CallStack
forall a. [a] -> Maybe a
listToMaybe [CallStack]
callStacks of
                Maybe CallStack
Nothing ->
                    [[Char]
"(no callstack available)"]
                Just CallStack
cs ->
                    [CallStack -> [Char]
prettyCallStack CallStack
cs]

        annotationsMessage :: [[Char]]
annotationsMessage =
            case [Annotation]
otherAnnotations of
                [] -> []
                [Annotation]
anns ->
                    [ [Char]
""
                    , [Char]
"Annotations:"
                    ]
                        [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> ((Annotation -> [Char]) -> [Annotation] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\Annotation
ann -> [Char]
"\t * " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Annotation -> [Char]
forall a. Show a => a -> [Char]
show Annotation
ann) [Annotation]
anns)

-- | Annotate the underlying exception with a 'CallStack'.
--
-- @since 0.2.0.0
exceptionWithCallStack :: (Exception e, HasCallStack) => e -> AnnotatedException e
exceptionWithCallStack :: forall e. (Exception e, HasCallStack) => e -> AnnotatedException e
exceptionWithCallStack =
    [Annotation] -> e -> AnnotatedException e
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException [Annotation
HasCallStack => Annotation
callStackAnnotation]

-- | Append the @['Annotation']@ to the 'AnnotatedException'.
--
-- 'CallStack' is a special case - if a 'CallStack' is present in both the
-- 'AnnotatedException' and the @['Annotation']@, then this will append the
-- 'CallStack's in the new list and concatenate them all together.
--
-- @since 0.1.0.0
annotate :: [Annotation] -> AnnotatedException e -> AnnotatedException e
annotate :: forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
newAnnotations (AnnotatedException [Annotation]
oldAnnotations e
e) =
    let
        ([CallStack]
callStacks, [Annotation]
other) =
            [Annotation] -> ([CallStack], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations ([Annotation]
newAnnotations [Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<> [Annotation]
oldAnnotations)
    in
        (CallStack -> AnnotatedException e -> AnnotatedException e)
-> AnnotatedException e -> [CallStack] -> AnnotatedException e
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CallStack -> AnnotatedException e -> AnnotatedException e
forall exception.
CallStack
-> AnnotatedException exception -> AnnotatedException exception
addCallStackToException ([Annotation] -> e -> AnnotatedException e
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException [Annotation]
other e
e) [CallStack]
callStacks

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

-- | Call 'Safe.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 :: forall e.
Exception e =>
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AnnotatedException a -> f (AnnotatedException 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 annotations.
--
-- > 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 :: (HasCallStack, Exception e, MonadCatch m) => m a -> (e -> m a) -> m a
catch :: forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
catch m a
action e -> m a
handler =
    (HasCallStack => m a -> [Handler m a] -> m a)
-> m a -> [Handler m a] -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack m a -> [Handler m a] -> m a
HasCallStack => m a -> [Handler m a] -> m a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
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.2.0
catches :: (MonadCatch m, HasCallStack) => m a -> [Handler m a] -> m a
catches :: forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
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.
(HasCallStack, MonadCatch m, MonadThrow m) =>
m a -> [Handler m a] -> m a
Safe.catches m a
action ((HasCallStack => [Handler m a] -> [Handler m a])
-> [Handler m a] -> [Handler m a]
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => [Handler m a] -> [Handler m a]
[Handler m a] -> [Handler m a]
forall (m :: * -> *) a.
(HasCallStack, 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 :: (HasCallStack, MonadCatch m) => [Handler m a] -> [Handler m a]
mkAnnotatedHandlers :: forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
[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 a b. [a] -> (a -> [b]) -> [b]
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) -> Handler m a) -> (e -> m a) -> Handler m a
forall a b. (a -> b) -> a -> b
$ \e
e ->
            m a -> m a
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
checkpointCallStack (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ e -> m a
hndlr e
e
        , (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, HasCallStack) =>
[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 :: forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
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.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
`catch` (Either (AnnotatedException e) a
-> m (Either (AnnotatedException e) a)
forall a. a -> m 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 :: forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
m a -> m (Either e a)
try m a
action =
    (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) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
`catch`
          (\e
exn -> Either e a -> m (Either e a)
forall a. a -> m 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)

-- | Throws an 'Exception' and annotates it with the current 'CallStack'.
--
-- An alias for 'throwWithCallStack'.
--
-- @since 0.2.0.0
throw :: (HasCallStack, MonadThrow m, Exception e) => e -> m a
throw :: forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw = (HasCallStack => e -> m a) -> e -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack e -> m a
HasCallStack => e -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwWithCallStack

-- | Attaches the 'CallStack' to the 'AnnotatedException' that is thrown.
--
-- @since 0.1.0.0
throwWithCallStack
    :: (HasCallStack, MonadThrow m, Exception e)
    => e -> m a
throwWithCallStack :: forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwWithCallStack e
e =
    (HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$
        AnnotatedException e -> m a
forall (m :: * -> *) e a.
(HasCallStack, 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 :: forall e.
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 (Maybe CallStack -> [Annotation] -> [Annotation] -> [Annotation]
go Maybe CallStack
forall a. Maybe a
Nothing [Annotation]
a [Annotation]
b) e
c
  where
    go :: Maybe CallStack -> [Annotation] -> [Annotation] -> [Annotation]
    go :: Maybe CallStack -> [Annotation] -> [Annotation] -> [Annotation]
go Maybe CallStack
mcallstack [] [Annotation]
bs =
        case Maybe CallStack
mcallstack of
            Just CallStack
cs ->
                CallStack -> [Annotation] -> [Annotation]
addCallStackToAnnotations CallStack
cs [Annotation]
bs
            Maybe CallStack
Nothing ->
                [Annotation]
bs
    go Maybe CallStack
mcallstack (Annotation
ann : [Annotation]
anns) [Annotation]
bs =
        case Annotation -> Maybe CallStack
forall a. Typeable a => Annotation -> Maybe a
castAnnotation Annotation
ann of
            Just CallStack
cs ->
                let newAcc :: Maybe CallStack
newAcc = (CallStack -> CallStack) -> Maybe CallStack -> Maybe CallStack
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CallStack -> CallStack -> CallStack
mergeCallStack CallStack
cs) Maybe CallStack
mcallstack Maybe CallStack -> Maybe CallStack -> Maybe CallStack
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
cs
                 in Maybe CallStack -> [Annotation] -> [Annotation] -> [Annotation]
go Maybe CallStack
newAcc [Annotation]
anns [Annotation]
bs
            Maybe CallStack
Nothing ->
                Annotation
ann Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: Maybe CallStack -> [Annotation] -> [Annotation] -> [Annotation]
go Maybe CallStack
mcallstack [Annotation]
anns [Annotation]
bs

tryFlatten :: SomeException -> SomeException
tryFlatten :: SomeException -> SomeException
tryFlatten SomeException
exn =
    case SomeException
-> Maybe (AnnotatedException (AnnotatedException SomeException))
forall e. Exception e => SomeException -> Maybe e
Safe.fromException SomeException
exn of
        Just (AnnotatedException (AnnotatedException SomeException)
a :: AnnotatedException (AnnotatedException SomeException)) ->
            AnnotatedException SomeException -> SomeException
forall e. Exception e => e -> SomeException
SomeException (AnnotatedException SomeException -> SomeException)
-> AnnotatedException SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$ AnnotatedException (AnnotatedException SomeException)
-> AnnotatedException SomeException
forall e.
AnnotatedException (AnnotatedException e) -> AnnotatedException e
flatten AnnotatedException (AnnotatedException SomeException)
a
        Maybe (AnnotatedException (AnnotatedException SomeException))
Nothing ->
            SomeException
exn

-- | Add a single 'Annotation' to any exceptions thrown in the following
-- action. The 'CallStack' present on any 'AnnotatedException' will also be
-- updated to include this location.
--
-- 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 :: (HasCallStack, MonadCatch m) => Annotation -> m a -> m a
checkpoint :: forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
Annotation -> m a -> m a
checkpoint Annotation
ann = (HasCallStack => m a -> m a) -> m a -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ([Annotation] -> m a -> m a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointMany [Annotation
ann])

-- | Add the current 'CallStack' to the checkpoint, along with the given
-- annotations. This function merges 'CallStack's together, attempting to
-- preserve the call site ordering as GHC does it.
--
-- As of 0.2.0.0, an alias for 'checkpointMany'.
--
-- @since 0.1.0.0
checkpointCallStackWith
    :: (MonadCatch m, HasCallStack)
    => [Annotation]
    -> m a
    -> m a
checkpointCallStackWith :: forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointCallStackWith [Annotation]
anns =
    (HasCallStack => m a -> m a) -> m a -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ([Annotation] -> m a -> m a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointMany [Annotation]
anns)

{-# DEPRECATED checkpointCallStackWith "As of 0.2.0.0 this is exactly equivalent to `checkpointMany`." #-}

-- | Adds only the current 'CallStack' to the checkpoint. This function searches
-- any thrown exception for a pre-existing 'CallStack' and will merge the given
-- pre-existing 'CallStack' with the one on this function, in an attempt to
-- preserve the actual call history.
--
-- @since 0.1.0.0
checkpointCallStack
    :: (MonadCatch m, HasCallStack)
    => m a
    -> m a
checkpointCallStack :: forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
checkpointCallStack =
    (HasCallStack => m a -> m a) -> m a -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (Annotation -> m a -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
Annotation -> m a -> m a
checkpoint (CallStack -> Annotation
forall a. AnnC a => a -> Annotation
Annotation CallStack
HasCallStack => CallStack
callStack))

-- | Add the list of 'Annotation' to any exception thrown in the following
-- action.
--
-- @since 0.1.0.0
checkpointMany :: (MonadCatch m, HasCallStack) => [Annotation] -> m a -> m a
checkpointMany :: forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointMany [Annotation]
anns m a
action =
    m a
action m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Safe.catch` \(SomeException
exn :: SomeException) ->
        AnnotatedException SomeException -> m a
forall (m :: * -> *) e a.
(HasCallStack, 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
. CallStack
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall exception.
CallStack
-> AnnotatedException exception -> AnnotatedException exception
addCallStackToException CallStack
HasCallStack => CallStack
callStack
            (AnnotatedException SomeException
 -> AnnotatedException SomeException)
-> (AnnotatedException SomeException
    -> AnnotatedException SomeException)
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Annotation]
-> AnnotatedException SomeException
-> AnnotatedException SomeException
forall e.
[Annotation] -> AnnotatedException e -> AnnotatedException e
annotate [Annotation]
anns
            (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
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeException
exn

-- | Retrieves the 'CallStack' from an 'AnnotatedException' if one is present.
--
-- The library maintains an internal check that a single 'CallStack' is present
-- in the list, so this only returns the first one found. If you have added
-- a 'CallStack' directly to the @['Annotation']@, then this will likely break.
--
-- @since 0.1.0.0
annotatedExceptionCallStack :: AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack :: forall exception. AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException exception
exn =
    let ([CallStack]
stacks, [Annotation]
_rest) = [Annotation] -> ([CallStack], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations (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. Instead, it will append the contents of the given
-- 'CallStack' to the existing one.
--
-- This mirrors the behavior of the way 'HasCallStack' actually works.
--
-- @since 0.1.0.0
addCallStackToException
    :: CallStack
    -> AnnotatedException exception
    -> AnnotatedException exception
addCallStackToException :: forall exception.
CallStack
-> AnnotatedException exception -> AnnotatedException exception
addCallStackToException CallStack
cs (AnnotatedException [Annotation]
anns exception
e) =
    [Annotation] -> exception -> AnnotatedException exception
forall exception.
[Annotation] -> exception -> AnnotatedException exception
AnnotatedException (CallStack -> [Annotation] -> [Annotation]
addCallStackToAnnotations CallStack
cs [Annotation]
anns) exception
e

addCallStackToAnnotations :: CallStack -> [Annotation] -> [Annotation]
addCallStackToAnnotations :: CallStack -> [Annotation] -> [Annotation]
addCallStackToAnnotations CallStack
cs = [Annotation] -> [Annotation]
go
  where
    -- not a huge fan of the direct recursion, but it seems easier than trying
    -- to finagle a `foldr` or something
    go :: [Annotation] -> [Annotation]
go [] =
        [CallStack -> Annotation
forall a. AnnC a => a -> Annotation
Annotation CallStack
cs]
    go (Annotation
ann : [Annotation]
anns) =
        case Annotation -> Maybe CallStack
forall a. Typeable a => Annotation -> Maybe a
castAnnotation Annotation
ann of
            Just CallStack
preexistingCallStack ->
                CallStack -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (CallStack -> CallStack -> CallStack
mergeCallStack CallStack
preexistingCallStack CallStack
cs) Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: [Annotation]
anns
            Maybe CallStack
Nothing ->
                Annotation
ann Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: [Annotation] -> [Annotation]
go [Annotation]
anns

-- we want to merge callstack but not duplicate entries
mergeCallStack :: CallStack -> CallStack -> CallStack
mergeCallStack :: CallStack -> CallStack -> CallStack
mergeCallStack CallStack
pre CallStack
new =
        [([Char], SrcLoc)] -> CallStack
fromCallSiteList
        ([([Char], SrcLoc)] -> CallStack)
-> [([Char], SrcLoc)] -> CallStack
forall a b. (a -> b) -> a -> b
$ (([Char], ([Char], [Char], [Char], Int, Int, Int, Int))
 -> ([Char], SrcLoc))
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
-> [([Char], SrcLoc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Char], [Char], [Char], Int, Int, Int, Int) -> SrcLoc)
-> ([Char], ([Char], [Char], [Char], Int, Int, Int, Int))
-> ([Char], SrcLoc)
forall a b. (a -> b) -> ([Char], a) -> ([Char], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], [Char], [Char], Int, Int, Int, Int) -> SrcLoc
fromSrcLocOrd)
        ([([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
 -> [([Char], SrcLoc)])
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
-> [([Char], SrcLoc)]
forall a b. (a -> b) -> a -> b
$ [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
forall a. Ord a => [a] -> [a]
ordNub
        ([([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
 -> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))])
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
forall a b. (a -> b) -> a -> b
$ (([Char], SrcLoc)
 -> ([Char], ([Char], [Char], [Char], Int, Int, Int, Int)))
-> [([Char], SrcLoc)]
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SrcLoc -> ([Char], [Char], [Char], Int, Int, Int, Int))
-> ([Char], SrcLoc)
-> ([Char], ([Char], [Char], [Char], Int, Int, Int, Int))
forall a b. (a -> b) -> ([Char], a) -> ([Char], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcLoc -> ([Char], [Char], [Char], Int, Int, Int, Int)
toSrcLocOrd)
        ([([Char], SrcLoc)]
 -> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))])
-> [([Char], SrcLoc)]
-> [([Char], ([Char], [Char], [Char], Int, Int, Int, Int))]
forall a b. (a -> b) -> a -> b
$ CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
pre [([Char], SrcLoc)] -> [([Char], SrcLoc)] -> [([Char], SrcLoc)]
forall a. Semigroup a => a -> a -> a
<> CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
new
  where
    toSrcLocOrd :: SrcLoc -> ([Char], [Char], [Char], Int, Int, Int, Int)
toSrcLocOrd (SrcLoc [Char]
a [Char]
b [Char]
c Int
d Int
e Int
f Int
g) =
        ([Char]
a, [Char]
b, [Char]
c, Int
d, Int
e, Int
f, Int
g)
    fromSrcLocOrd :: ([Char], [Char], [Char], Int, Int, Int, Int) -> SrcLoc
fromSrcLocOrd ([Char]
a, [Char]
b, [Char]
c, Int
d, Int
e, Int
f, Int
g) =
        [Char] -> [Char] -> [Char] -> Int -> Int -> Int -> Int -> SrcLoc
SrcLoc [Char]
a [Char]
b [Char]
c Int
d Int
e Int
f Int
g

-- | Remove duplicates but keep elements in order.
--   O(n * log n)
-- Vendored from GHC
ordNub :: Ord a => [a] -> [a]
ordNub :: forall a. Ord a => [a] -> [a]
ordNub = Set a -> [a] -> [a]
forall {a}. Ord a => Set a -> [a] -> [a]
go Set a
forall a. Set a
Set.empty
  where
    go :: Set a -> [a] -> [a]
go Set a
_ [] = []
    go Set a
s (a
x:[a]
xs)
      | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
s = Set a -> [a] -> [a]
go Set a
s [a]
xs
      | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs