module Patrol.Type.AppleDebugImage 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/#appledebugimage>
data AppleDebugImage = AppleDebugImage
  { AppleDebugImage -> Text
arch :: Text.Text,
    AppleDebugImage -> Maybe Int
cpuSubtype :: Maybe Int,
    AppleDebugImage -> Maybe Int
cpuType :: Maybe Int,
    AppleDebugImage -> Text
imageAddr :: Text.Text,
    AppleDebugImage -> Maybe Int
imageSize :: Maybe Int,
    AppleDebugImage -> Text
imageVmaddr :: Text.Text,
    AppleDebugImage -> Text
name :: Text.Text,
    AppleDebugImage -> Text
uuid :: Text.Text
  }
  deriving (AppleDebugImage -> AppleDebugImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppleDebugImage -> AppleDebugImage -> Bool
$c/= :: AppleDebugImage -> AppleDebugImage -> Bool
== :: AppleDebugImage -> AppleDebugImage -> Bool
$c== :: AppleDebugImage -> AppleDebugImage -> Bool
Eq, Int -> AppleDebugImage -> ShowS
[AppleDebugImage] -> ShowS
AppleDebugImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppleDebugImage] -> ShowS
$cshowList :: [AppleDebugImage] -> ShowS
show :: AppleDebugImage -> String
$cshow :: AppleDebugImage -> String
showsPrec :: Int -> AppleDebugImage -> ShowS
$cshowsPrec :: Int -> AppleDebugImage -> ShowS
Show)

instance Aeson.ToJSON AppleDebugImage where
  toJSON :: AppleDebugImage -> Value
toJSON AppleDebugImage
appleDebugImage =
    [Pair] -> Value
Aeson.intoObject
      [ forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"arch" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Text
arch AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"cpu_subtype" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Maybe Int
cpuSubtype AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"cpu_type" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Maybe Int
cpuType AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"image_addr" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Text
imageAddr AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"image_size" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Maybe Int
imageSize AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"image_vmaddr" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Text
imageVmaddr AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"name" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Text
name AppleDebugImage
appleDebugImage,
        forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"uuid" forall a b. (a -> b) -> a -> b
$ AppleDebugImage -> Text
uuid AppleDebugImage
appleDebugImage
      ]

empty :: AppleDebugImage
empty :: AppleDebugImage
empty =
  AppleDebugImage
    { arch :: Text
arch = Text
Text.empty,
      cpuSubtype :: Maybe Int
cpuSubtype = forall a. Maybe a
Nothing,
      cpuType :: Maybe Int
cpuType = forall a. Maybe a
Nothing,
      imageAddr :: Text
imageAddr = Text
Text.empty,
      imageSize :: Maybe Int
imageSize = forall a. Maybe a
Nothing,
      imageVmaddr :: Text
imageVmaddr = Text
Text.empty,
      name :: Text
name = Text
Text.empty,
      uuid :: Text
uuid = Text
Text.empty
    }