module Freckle.App.Exception
(
module Freckle.App.Exception.MonadUnliftIO
, annotatedExceptionMessage
, annotatedExceptionMessageFrom
) where
import Prelude
import Control.Exception.Annotated (annotatedExceptionCallStack)
import qualified Control.Exception.Annotated as AnnotatedException
import Control.Monad.Logger.Aeson (Message (..), (.=))
import Data.Aeson (object)
import Freckle.App.Exception.MonadUnliftIO
import GHC.Exception (prettyCallStack)
annotatedExceptionMessage :: Exception ex => AnnotatedException ex -> Message
annotatedExceptionMessage :: forall ex. Exception ex => AnnotatedException ex -> Message
annotatedExceptionMessage = forall ex.
Exception ex =>
(ex -> Message) -> AnnotatedException ex -> Message
annotatedExceptionMessageFrom forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Message
"Exception"
annotatedExceptionMessageFrom
:: Exception ex => (ex -> Message) -> AnnotatedException ex -> Message
annotatedExceptionMessageFrom :: forall ex.
Exception ex =>
(ex -> Message) -> AnnotatedException ex -> Message
annotatedExceptionMessageFrom ex -> Message
f AnnotatedException ex
ann = case ex -> Message
f ex
ex of
Text
msg :# [SeriesElem]
series -> Text
msg Text -> [SeriesElem] -> Message
:# [SeriesElem]
series forall a. Semigroup a => a -> a -> a
<> [Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
errorObject]
where
ex :: ex
ex = forall exception. AnnotatedException exception -> exception
AnnotatedException.exception AnnotatedException ex
ann
errorObject :: Value
errorObject =
[Pair] -> Value
object
[ Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall e. Exception e => e -> String
displayException ex
ex
, Key
"stack" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (CallStack -> String
prettyCallStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall exception. AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException ex
ann)
]