From f52020fb3dacaf687a201fded9ae8375b3cd175b Mon Sep 17 00:00:00 2001
From: Fumiaki Kinoshita <fumiaki.kinoshita@herp.co.jp>
Date: Mon, 26 Dec 2022 20:23:48 +0900
Subject: [PATCH 1/3] add a few more payload constructors

---
 src/Herp/Logger.hs         |  2 ++
 src/Herp/Logger/Payload.hs | 31 +++++++++++++++++++++++++++++++
 2 files changed, 33 insertions(+)

diff --git a/src/Herp/Logger.hs b/src/Herp/Logger.hs
index 7e3c101..2932e88 100644
--- a/src/Herp/Logger.hs
+++ b/src/Herp/Logger.hs
@@ -30,6 +30,8 @@ module Herp.Logger
     , P.level
     , P.message
     , P.object
+    , P.messageString
+    , P.messageShow
     -- * monad-logger
     , runLoggingT
     , toLoggerIO
diff --git a/src/Herp/Logger/Payload.hs b/src/Herp/Logger/Payload.hs
index aa616fc..2df91ad 100644
--- a/src/Herp/Logger/Payload.hs
+++ b/src/Herp/Logger/Payload.hs
@@ -5,12 +5,24 @@ module Herp.Logger.Payload
   , level
   , message
   , object
+  , messageString
+  , messageShow
+  , messageUtf8
+  , messageUtf8Lazy
+  , messageUtf8Builder
+  , messageException
   ) where
 
+import Control.Exception
 import Data.Aeson (Object, KeyValue(..))
+import Data.ByteString (ByteString)
+import Data.ByteString.Builder qualified as BB
+import Data.ByteString.Lazy qualified as BL
 import Data.Semigroup
 import Data.String
 import Data.Text (Text)
+import Data.Text.Encoding
+import Data.Typeable
 import Generic.Data
 import GHC.Exts
 import GHC.OverloadedLabels
@@ -38,6 +50,25 @@ level lvl = mempty { payloadLevel = Max lvl }
 message :: Text -> Payload
 message txt = mempty { payloadMessage = txt }
 
+messageString :: String -> Payload
+messageString = message . fromString
+
+messageShow :: Show a => a -> Payload
+messageShow = messageString . show
+
+messageUtf8 :: ByteString -> Payload
+messageUtf8 = message . decodeUtf8
+
+messageUtf8Lazy :: BL.ByteString -> Payload
+messageUtf8Lazy = messageUtf8 . BL.toStrict
+
+messageUtf8Builder :: BB.Builder -> Payload
+messageUtf8Builder = messageUtf8Lazy . BB.toLazyByteString
+
+messageException :: Exception e => e -> Payload
+messageException e = messageShow e
+  <> "exception_type" .= show (typeOf e)
+
 object :: Object -> Payload
 object obj = mempty { payloadObject = obj }
 

From bb5c23e0cfc64781079484f19629f243bf05d0bf Mon Sep 17 00:00:00 2001
From: Fumiaki Kinoshita <fumiaki.kinoshita@herp.co.jp>
Date: Mon, 26 Dec 2022 20:24:57 +0900
Subject: [PATCH 2/3] add a warning to `object`

---
 src/Herp/Logger/Payload.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Herp/Logger/Payload.hs b/src/Herp/Logger/Payload.hs
index 2df91ad..840f675 100644
--- a/src/Herp/Logger/Payload.hs
+++ b/src/Herp/Logger/Payload.hs
@@ -71,6 +71,7 @@ messageException e = messageShow e
 
 object :: Object -> Payload
 object obj = mempty { payloadObject = obj }
+{-# WARNING object "This might confuse Datadog!" #-}
 
 instance IsString Payload where
   fromString = message . fromString

From d0f6b9da13a0c4cf2e4420713259629e460e7aa4 Mon Sep 17 00:00:00 2001
From: Fumiaki Kinoshita <fumiaki.kinoshita@herp.co.jp>
Date: Tue, 27 Dec 2022 16:16:13 +0900
Subject: [PATCH 3/3] unwrap SomeException automatically

---
 src/Herp/Logger.hs         | 1 +
 src/Herp/Logger/Payload.hs | 8 ++++++--
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/Herp/Logger.hs b/src/Herp/Logger.hs
index 2932e88..697bf09 100644
--- a/src/Herp/Logger.hs
+++ b/src/Herp/Logger.hs
@@ -32,6 +32,7 @@ module Herp.Logger
     , P.object
     , P.messageString
     , P.messageShow
+    , P.messageException
     -- * monad-logger
     , runLoggingT
     , toLoggerIO
diff --git a/src/Herp/Logger/Payload.hs b/src/Herp/Logger/Payload.hs
index 840f675..47bc8d9 100644
--- a/src/Herp/Logger/Payload.hs
+++ b/src/Herp/Logger/Payload.hs
@@ -66,8 +66,12 @@ messageUtf8Builder :: BB.Builder -> Payload
 messageUtf8Builder = messageUtf8Lazy . BB.toLazyByteString
 
 messageException :: Exception e => e -> Payload
-messageException e = messageShow e
-  <> "exception_type" .= show (typeOf e)
+messageException e = messageString (displayException e)
+  <> "exception_type" .= show exceptionType
+  where
+    exceptionType = case cast e of
+      Just (SomeException e') -> typeOf e'
+      _ -> typeOf e
 
 object :: Object -> Payload
 object obj = mempty { payloadObject = obj }