Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Payloadを構築する関数をいくつか追加 #32

Merged
merged 3 commits into from
Dec 27, 2022
Merged

Payloadを構築する関数をいくつか追加 #32

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
f52020f
add a few more payload constructors
fumieval Dec 26, 2022
bb5c23e
add a warning to `object`
fumieval Dec 26, 2022
d0f6b9d
unwrap SomeException automatically
fumieval Dec 27, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions src/Herp/Logger.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,8 @@ module Herp.Logger
, P.level
, P.message
, P.object
, P.messageString
, P.messageShow
-- * monad-logger
, runLoggingT
, toLoggerIO
Expand Down
32 changes: 32 additions & 0 deletions src/Herp/Logger/Payload.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -38,8 +50,28 @@ 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)

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

SomeExceptionの場合の関数もあると嬉しいかなとおもったんですがどうでしょうか？(なんとなく思っただけであまり使う場面が思い浮かばないですが)

messageSomeException :: SomeException -> Payload
messageSomeException (SomeException e) = messageShow e
  <> "exception_type" .= show (typeOf e)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

SomeExceptionもExceptionのインスタンスであり、違いはtypeOfの結果が変わることくらいですが、SomeExceptionが来た場合は自動で内部のExceptionの型を表示するようにしました

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

関数を増やすよりこちらのほうがいいですね、ありがとうございます

object :: Object -> Payload
object obj = mempty { payloadObject = obj }
{-# WARNING object "This might confuse Datadog!" #-}

instance IsString Payload where
fromString = message . fromString
Expand Down