module Patrol.Type.DebugMeta where

import qualified Data.Aeson as Aeson
import qualified Patrol.Extra.Aeson as Aeson
import qualified Patrol.Type.DebugImage as DebugImage
import qualified Patrol.Type.SystemSdkInfo as SystemSdkInfo

-- | <https://develop.sentry.dev/sdk/event-payloads/types/#debugmeta>
data DebugMeta = DebugMeta
  { DebugMeta -> [DebugImage]
images :: [DebugImage.DebugImage],
    DebugMeta -> Maybe SystemSdkInfo
sdkInfo :: Maybe SystemSdkInfo.SystemSdkInfo
  }
  deriving (DebugMeta -> DebugMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugMeta -> DebugMeta -> Bool
$c/= :: DebugMeta -> DebugMeta -> Bool
== :: DebugMeta -> DebugMeta -> Bool
$c== :: DebugMeta -> DebugMeta -> Bool
Eq, Int -> DebugMeta -> ShowS
[DebugMeta] -> ShowS
DebugMeta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugMeta] -> ShowS
$cshowList :: [DebugMeta] -> ShowS
show :: DebugMeta -> String
$cshow :: DebugMeta -> String
showsPrec :: Int -> DebugMeta -> ShowS
$cshowsPrec :: Int -> DebugMeta -> ShowS
Show)

instance Aeson.ToJSON DebugMeta where
  toJSON :: DebugMeta -> Value
toJSON DebugMeta
debugMeta =
    [Pair] -> Value
Aeson.intoObject
      [ forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"images" forall a b. (a -> b) -> a -> b
$ DebugMeta -> [DebugImage]
images DebugMeta
debugMeta,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"sdk_info" forall a b. (a -> b) -> a -> b
$ DebugMeta -> Maybe SystemSdkInfo
sdkInfo DebugMeta
debugMeta
      ]

empty :: DebugMeta
empty :: DebugMeta
empty =
  DebugMeta
    { images :: [DebugImage]
images = [],
      sdkInfo :: Maybe SystemSdkInfo
sdkInfo = forall a. Maybe a
Nothing
    }