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 = (ex -> Message) -> AnnotatedException ex -> Message
forall ex.
Exception ex =>
(ex -> Message) -> AnnotatedException ex -> Message
annotatedExceptionMessageFrom ((ex -> Message) -> AnnotatedException ex -> Message)
-> (ex -> Message) -> AnnotatedException ex -> Message
forall a b. (a -> b) -> a -> b
$ Message -> ex -> Message
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 [SeriesElem] -> [SeriesElem] -> [SeriesElem]
forall a. Semigroup a => a -> a -> a
<> [Key
"error" Key -> Value -> SeriesElem
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> SeriesElem
.= Value
errorObject]
where
ex :: ex
ex = AnnotatedException ex -> ex
forall exception. AnnotatedException exception -> exception
AnnotatedException.exception AnnotatedException ex
ann
errorObject :: Value
errorObject =
[Pair] -> Value
object
[ Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ex -> String
forall e. Exception e => e -> String
displayException ex
ex
, Key
"stack" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (CallStack -> String
prettyCallStack (CallStack -> String) -> Maybe CallStack -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotatedException ex -> Maybe CallStack
forall exception. AnnotatedException exception -> Maybe CallStack
annotatedExceptionCallStack AnnotatedException ex
ann)
]