module Patrol.Type.GpuContext 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/#gpucontext>
data GpuContext = GpuContext
  { GpuContext -> Text
apiType :: Text.Text,
    GpuContext -> Text
graphicsShaderLevel :: Text.Text,
    GpuContext -> Value
id :: Aeson.Value,
    GpuContext -> Maybe Int
maxTextureSize :: Maybe Int,
    GpuContext -> Maybe Double
memorySize :: Maybe Double,
    GpuContext -> Maybe Bool
multiThreadedRendering :: Maybe Bool,
    GpuContext -> Text
name :: Text.Text,
    GpuContext -> Text
npotSupport :: Text.Text,
    GpuContext -> Maybe Bool
supportsComputeShaders :: Maybe Bool,
    GpuContext -> Maybe Bool
supportsGeometryShaders :: Maybe Bool,
    GpuContext -> Maybe Bool
supportsRayTracing :: Maybe Bool,
    GpuContext -> Text
vendorId :: Text.Text,
    GpuContext -> Text
vendorName :: Text.Text,
    GpuContext -> Text
version :: Text.Text
  }
  deriving (GpuContext -> GpuContext -> Bool
(GpuContext -> GpuContext -> Bool)
-> (GpuContext -> GpuContext -> Bool) -> Eq GpuContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GpuContext -> GpuContext -> Bool
== :: GpuContext -> GpuContext -> Bool
$c/= :: GpuContext -> GpuContext -> Bool
/= :: GpuContext -> GpuContext -> Bool
Eq, Int -> GpuContext -> ShowS
[GpuContext] -> ShowS
GpuContext -> String
(Int -> GpuContext -> ShowS)
-> (GpuContext -> String)
-> ([GpuContext] -> ShowS)
-> Show GpuContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GpuContext -> ShowS
showsPrec :: Int -> GpuContext -> ShowS
$cshow :: GpuContext -> String
show :: GpuContext -> String
$cshowList :: [GpuContext] -> ShowS
showList :: [GpuContext] -> ShowS
Show)

instance Aeson.ToJSON GpuContext where
  toJSON :: GpuContext -> Value
toJSON GpuContext
gpuContext =
    [Pair] -> Value
Aeson.intoObject
      [ String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"api_type" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
apiType GpuContext
gpuContext,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"graphics_shader_level" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
graphicsShaderLevel GpuContext
gpuContext,
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Value
Patrol.Type.GpuContext.id GpuContext
gpuContext,
        String -> Maybe Int -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"max_texture_size" (Maybe Int -> Pair) -> Maybe Int -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Maybe Int
maxTextureSize GpuContext
gpuContext,
        String -> Maybe Double -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"memory_size" (Maybe Double -> Pair) -> Maybe Double -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Maybe Double
memorySize GpuContext
gpuContext,
        String -> Maybe Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"multi_threaded_rendering" (Maybe Bool -> Pair) -> Maybe Bool -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Maybe Bool
multiThreadedRendering GpuContext
gpuContext,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"name" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
name GpuContext
gpuContext,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"npot_support" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
npotSupport GpuContext
gpuContext,
        String -> Maybe Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"supports_compute_shaders" (Maybe Bool -> Pair) -> Maybe Bool -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Maybe Bool
supportsComputeShaders GpuContext
gpuContext,
        String -> Maybe Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"supports_geometry_shaders" (Maybe Bool -> Pair) -> Maybe Bool -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Maybe Bool
supportsGeometryShaders GpuContext
gpuContext,
        String -> Maybe Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"supports_ray_tracing" (Maybe Bool -> Pair) -> Maybe Bool -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Maybe Bool
supportsRayTracing GpuContext
gpuContext,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"vendor_id" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
vendorId GpuContext
gpuContext,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"vendor_name" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
vendorName GpuContext
gpuContext,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"version" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ GpuContext -> Text
version GpuContext
gpuContext
      ]

empty :: GpuContext
empty :: GpuContext
empty =
  GpuContext
    { apiType :: Text
apiType = Text
Text.empty,
      graphicsShaderLevel :: Text
graphicsShaderLevel = Text
Text.empty,
      id :: Value
Patrol.Type.GpuContext.id = Value
Aeson.Null,
      maxTextureSize :: Maybe Int
maxTextureSize = Maybe Int
forall a. Maybe a
Nothing,
      memorySize :: Maybe Double
memorySize = Maybe Double
forall a. Maybe a
Nothing,
      multiThreadedRendering :: Maybe Bool
multiThreadedRendering = Maybe Bool
forall a. Maybe a
Nothing,
      name :: Text
name = Text
Text.empty,
      npotSupport :: Text
npotSupport = Text
Text.empty,
      supportsComputeShaders :: Maybe Bool
supportsComputeShaders = Maybe Bool
forall a. Maybe a
Nothing,
      supportsGeometryShaders :: Maybe Bool
supportsGeometryShaders = Maybe Bool
forall a. Maybe a
Nothing,
      supportsRayTracing :: Maybe Bool
supportsRayTracing = Maybe Bool
forall a. Maybe a
Nothing,
      vendorId :: Text
vendorId = Text
Text.empty,
      vendorName :: Text
vendorName = Text
Text.empty,
      version :: Text
version = Text
Text.empty
    }