module Patrol.Type.LogEntry where

import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Patrol.Extra.Aeson as Aeson

-- | <https://develop.sentry.dev/sdk/event-payloads/types/#logentry>
data LogEntry = LogEntry
  { LogEntry -> Text
formatted :: Text.Text,
    LogEntry -> Text
message :: Text.Text,
    LogEntry -> Value
params :: Aeson.Value
  }
  deriving (LogEntry -> LogEntry -> Bool
(LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool) -> Eq LogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogEntry -> LogEntry -> Bool
== :: LogEntry -> LogEntry -> Bool
$c/= :: LogEntry -> LogEntry -> Bool
/= :: LogEntry -> LogEntry -> Bool
Eq, Int -> LogEntry -> ShowS
[LogEntry] -> ShowS
LogEntry -> String
(Int -> LogEntry -> ShowS)
-> (LogEntry -> String) -> ([LogEntry] -> ShowS) -> Show LogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogEntry -> ShowS
showsPrec :: Int -> LogEntry -> ShowS
$cshow :: LogEntry -> String
show :: LogEntry -> String
$cshowList :: [LogEntry] -> ShowS
showList :: [LogEntry] -> ShowS
Show)

instance Aeson.ToJSON LogEntry where
  toJSON :: LogEntry -> Value
toJSON LogEntry
logEntry =
    [Pair] -> Value
Aeson.intoObject
      [ String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"formatted" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ LogEntry -> Text
formatted LogEntry
logEntry,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"message" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ LogEntry -> Text
message LogEntry
logEntry,
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"params" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ LogEntry -> Value
params LogEntry
logEntry
      ]

empty :: LogEntry
empty :: LogEntry
empty =
  LogEntry
    { formatted :: Text
formatted = Text
Text.empty,
      message :: Text
message = Text
Text.empty,
      params :: Value
params = Value
Aeson.Null
    }