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 = (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"

-- | 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 [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)
      ]