module Freckle.App.Exception
  ( -- * Re-export of our current preferred implementation module

    -- | Currently 'MonadUnliftIO'-based
      module Freckle.App.Exception.MonadUnliftIO

    -- * Helpers that are agnostic to either implementation
  , 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)

-- | Construct a log 'Message' for any @'AnnotatedException' exception@
--
-- Produces a log message that works with Datadog /Standard Attributes/.
--
-- <https://docs.datadoghq.com/standard-attributes/?search=error.>
--
-- @
-- Exception
--    error.message: {displayException on underlying exception}
--    error.stack: {prettyCallStack from the annotation, if available}
-- @
--
-- You are expected to call this with a @TypeApplication@, for example:
--
-- @
-- 'catch' myAction $ 'logError' . 'annotatedExceptionMessage' @MyException
-- @
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"

-- | Like 'annotatedExceptionMessage', but use the supplied function to
--   construct an initial 'Message' that it will augment.
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)
      ]