{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= SystemInfo

The SystemInfo domain defines methods and events for querying low-level system information.
-}


module CDP.Domains.SystemInfo (module CDP.Domains.SystemInfo) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils




-- | Type 'SystemInfo.GPUDevice'.
--   Describes a single graphics processor (GPU).
data SystemInfoGPUDevice = SystemInfoGPUDevice
  {
    -- | PCI ID of the GPU vendor, if available; 0 otherwise.
    SystemInfoGPUDevice -> Double
systemInfoGPUDeviceVendorId :: Double,
    -- | PCI ID of the GPU device, if available; 0 otherwise.
    SystemInfoGPUDevice -> Double
systemInfoGPUDeviceDeviceId :: Double,
    -- | Sub sys ID of the GPU, only available on Windows.
    SystemInfoGPUDevice -> Maybe Double
systemInfoGPUDeviceSubSysId :: Maybe Double,
    -- | Revision of the GPU, only available on Windows.
    SystemInfoGPUDevice -> Maybe Double
systemInfoGPUDeviceRevision :: Maybe Double,
    -- | String description of the GPU vendor, if the PCI ID is not available.
    SystemInfoGPUDevice -> Text
systemInfoGPUDeviceVendorString :: T.Text,
    -- | String description of the GPU device, if the PCI ID is not available.
    SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDeviceString :: T.Text,
    -- | String description of the GPU driver vendor.
    SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDriverVendor :: T.Text,
    -- | String description of the GPU driver version.
    SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDriverVersion :: T.Text
  }
  deriving (SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool
(SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool)
-> (SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool)
-> Eq SystemInfoGPUDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool
$c/= :: SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool
== :: SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool
$c== :: SystemInfoGPUDevice -> SystemInfoGPUDevice -> Bool
Eq, Int -> SystemInfoGPUDevice -> ShowS
[SystemInfoGPUDevice] -> ShowS
SystemInfoGPUDevice -> String
(Int -> SystemInfoGPUDevice -> ShowS)
-> (SystemInfoGPUDevice -> String)
-> ([SystemInfoGPUDevice] -> ShowS)
-> Show SystemInfoGPUDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoGPUDevice] -> ShowS
$cshowList :: [SystemInfoGPUDevice] -> ShowS
show :: SystemInfoGPUDevice -> String
$cshow :: SystemInfoGPUDevice -> String
showsPrec :: Int -> SystemInfoGPUDevice -> ShowS
$cshowsPrec :: Int -> SystemInfoGPUDevice -> ShowS
Show)
instance FromJSON SystemInfoGPUDevice where
  parseJSON :: Value -> Parser SystemInfoGPUDevice
parseJSON = String
-> (Object -> Parser SystemInfoGPUDevice)
-> Value
-> Parser SystemInfoGPUDevice
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoGPUDevice" ((Object -> Parser SystemInfoGPUDevice)
 -> Value -> Parser SystemInfoGPUDevice)
-> (Object -> Parser SystemInfoGPUDevice)
-> Value
-> Parser SystemInfoGPUDevice
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double
-> Double
-> Maybe Double
-> Maybe Double
-> Text
-> Text
-> Text
-> Text
-> SystemInfoGPUDevice
SystemInfoGPUDevice
    (Double
 -> Double
 -> Maybe Double
 -> Maybe Double
 -> Text
 -> Text
 -> Text
 -> Text
 -> SystemInfoGPUDevice)
-> Parser Double
-> Parser
     (Double
      -> Maybe Double
      -> Maybe Double
      -> Text
      -> Text
      -> Text
      -> Text
      -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"vendorId"
    Parser
  (Double
   -> Maybe Double
   -> Maybe Double
   -> Text
   -> Text
   -> Text
   -> Text
   -> SystemInfoGPUDevice)
-> Parser Double
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Text
      -> Text
      -> Text
      -> Text
      -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"deviceId"
    Parser
  (Maybe Double
   -> Maybe Double
   -> Text
   -> Text
   -> Text
   -> Text
   -> SystemInfoGPUDevice)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Text -> Text -> Text -> Text -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"subSysId"
    Parser
  (Maybe Double
   -> Text -> Text -> Text -> Text -> SystemInfoGPUDevice)
-> Parser (Maybe Double)
-> Parser (Text -> Text -> Text -> Text -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"revision"
    Parser (Text -> Text -> Text -> Text -> SystemInfoGPUDevice)
-> Parser Text
-> Parser (Text -> Text -> Text -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"vendorString"
    Parser (Text -> Text -> Text -> SystemInfoGPUDevice)
-> Parser Text -> Parser (Text -> Text -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"deviceString"
    Parser (Text -> Text -> SystemInfoGPUDevice)
-> Parser Text -> Parser (Text -> SystemInfoGPUDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"driverVendor"
    Parser (Text -> SystemInfoGPUDevice)
-> Parser Text -> Parser SystemInfoGPUDevice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"driverVersion"
instance ToJSON SystemInfoGPUDevice where
  toJSON :: SystemInfoGPUDevice -> Value
toJSON SystemInfoGPUDevice
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"vendorId" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (SystemInfoGPUDevice -> Double
systemInfoGPUDeviceVendorId SystemInfoGPUDevice
p),
    (Text
"deviceId" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (SystemInfoGPUDevice -> Double
systemInfoGPUDeviceDeviceId SystemInfoGPUDevice
p),
    (Text
"subSysId" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SystemInfoGPUDevice -> Maybe Double
systemInfoGPUDeviceSubSysId SystemInfoGPUDevice
p),
    (Text
"revision" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SystemInfoGPUDevice -> Maybe Double
systemInfoGPUDeviceRevision SystemInfoGPUDevice
p),
    (Text
"vendorString" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoGPUDevice -> Text
systemInfoGPUDeviceVendorString SystemInfoGPUDevice
p),
    (Text
"deviceString" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDeviceString SystemInfoGPUDevice
p),
    (Text
"driverVendor" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDriverVendor SystemInfoGPUDevice
p),
    (Text
"driverVersion" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDriverVersion SystemInfoGPUDevice
p)
    ]

-- | Type 'SystemInfo.Size'.
--   Describes the width and height dimensions of an entity.
data SystemInfoSize = SystemInfoSize
  {
    -- | Width in pixels.
    SystemInfoSize -> Int
systemInfoSizeWidth :: Int,
    -- | Height in pixels.
    SystemInfoSize -> Int
systemInfoSizeHeight :: Int
  }
  deriving (SystemInfoSize -> SystemInfoSize -> Bool
(SystemInfoSize -> SystemInfoSize -> Bool)
-> (SystemInfoSize -> SystemInfoSize -> Bool) -> Eq SystemInfoSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoSize -> SystemInfoSize -> Bool
$c/= :: SystemInfoSize -> SystemInfoSize -> Bool
== :: SystemInfoSize -> SystemInfoSize -> Bool
$c== :: SystemInfoSize -> SystemInfoSize -> Bool
Eq, Int -> SystemInfoSize -> ShowS
[SystemInfoSize] -> ShowS
SystemInfoSize -> String
(Int -> SystemInfoSize -> ShowS)
-> (SystemInfoSize -> String)
-> ([SystemInfoSize] -> ShowS)
-> Show SystemInfoSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoSize] -> ShowS
$cshowList :: [SystemInfoSize] -> ShowS
show :: SystemInfoSize -> String
$cshow :: SystemInfoSize -> String
showsPrec :: Int -> SystemInfoSize -> ShowS
$cshowsPrec :: Int -> SystemInfoSize -> ShowS
Show)
instance FromJSON SystemInfoSize where
  parseJSON :: Value -> Parser SystemInfoSize
parseJSON = String
-> (Object -> Parser SystemInfoSize)
-> Value
-> Parser SystemInfoSize
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoSize" ((Object -> Parser SystemInfoSize)
 -> Value -> Parser SystemInfoSize)
-> (Object -> Parser SystemInfoSize)
-> Value
-> Parser SystemInfoSize
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> SystemInfoSize
SystemInfoSize
    (Int -> Int -> SystemInfoSize)
-> Parser Int -> Parser (Int -> SystemInfoSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"width"
    Parser (Int -> SystemInfoSize)
-> Parser Int -> Parser SystemInfoSize
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"height"
instance ToJSON SystemInfoSize where
  toJSON :: SystemInfoSize -> Value
toJSON SystemInfoSize
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"width" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (SystemInfoSize -> Int
systemInfoSizeWidth SystemInfoSize
p),
    (Text
"height" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (SystemInfoSize -> Int
systemInfoSizeHeight SystemInfoSize
p)
    ]

-- | Type 'SystemInfo.VideoDecodeAcceleratorCapability'.
--   Describes a supported video decoding profile with its associated minimum and
--   maximum resolutions.
data SystemInfoVideoDecodeAcceleratorCapability = SystemInfoVideoDecodeAcceleratorCapability
  {
    -- | Video codec profile that is supported, e.g. VP9 Profile 2.
    SystemInfoVideoDecodeAcceleratorCapability -> Text
systemInfoVideoDecodeAcceleratorCapabilityProfile :: T.Text,
    -- | Maximum video dimensions in pixels supported for this |profile|.
    SystemInfoVideoDecodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoDecodeAcceleratorCapabilityMaxResolution :: SystemInfoSize,
    -- | Minimum video dimensions in pixels supported for this |profile|.
    SystemInfoVideoDecodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoDecodeAcceleratorCapabilityMinResolution :: SystemInfoSize
  }
  deriving (SystemInfoVideoDecodeAcceleratorCapability
-> SystemInfoVideoDecodeAcceleratorCapability -> Bool
(SystemInfoVideoDecodeAcceleratorCapability
 -> SystemInfoVideoDecodeAcceleratorCapability -> Bool)
-> (SystemInfoVideoDecodeAcceleratorCapability
    -> SystemInfoVideoDecodeAcceleratorCapability -> Bool)
-> Eq SystemInfoVideoDecodeAcceleratorCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoVideoDecodeAcceleratorCapability
-> SystemInfoVideoDecodeAcceleratorCapability -> Bool
$c/= :: SystemInfoVideoDecodeAcceleratorCapability
-> SystemInfoVideoDecodeAcceleratorCapability -> Bool
== :: SystemInfoVideoDecodeAcceleratorCapability
-> SystemInfoVideoDecodeAcceleratorCapability -> Bool
$c== :: SystemInfoVideoDecodeAcceleratorCapability
-> SystemInfoVideoDecodeAcceleratorCapability -> Bool
Eq, Int -> SystemInfoVideoDecodeAcceleratorCapability -> ShowS
[SystemInfoVideoDecodeAcceleratorCapability] -> ShowS
SystemInfoVideoDecodeAcceleratorCapability -> String
(Int -> SystemInfoVideoDecodeAcceleratorCapability -> ShowS)
-> (SystemInfoVideoDecodeAcceleratorCapability -> String)
-> ([SystemInfoVideoDecodeAcceleratorCapability] -> ShowS)
-> Show SystemInfoVideoDecodeAcceleratorCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoVideoDecodeAcceleratorCapability] -> ShowS
$cshowList :: [SystemInfoVideoDecodeAcceleratorCapability] -> ShowS
show :: SystemInfoVideoDecodeAcceleratorCapability -> String
$cshow :: SystemInfoVideoDecodeAcceleratorCapability -> String
showsPrec :: Int -> SystemInfoVideoDecodeAcceleratorCapability -> ShowS
$cshowsPrec :: Int -> SystemInfoVideoDecodeAcceleratorCapability -> ShowS
Show)
instance FromJSON SystemInfoVideoDecodeAcceleratorCapability where
  parseJSON :: Value -> Parser SystemInfoVideoDecodeAcceleratorCapability
parseJSON = String
-> (Object -> Parser SystemInfoVideoDecodeAcceleratorCapability)
-> Value
-> Parser SystemInfoVideoDecodeAcceleratorCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoVideoDecodeAcceleratorCapability" ((Object -> Parser SystemInfoVideoDecodeAcceleratorCapability)
 -> Value -> Parser SystemInfoVideoDecodeAcceleratorCapability)
-> (Object -> Parser SystemInfoVideoDecodeAcceleratorCapability)
-> Value
-> Parser SystemInfoVideoDecodeAcceleratorCapability
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> SystemInfoSize
-> SystemInfoSize
-> SystemInfoVideoDecodeAcceleratorCapability
SystemInfoVideoDecodeAcceleratorCapability
    (Text
 -> SystemInfoSize
 -> SystemInfoSize
 -> SystemInfoVideoDecodeAcceleratorCapability)
-> Parser Text
-> Parser
     (SystemInfoSize
      -> SystemInfoSize -> SystemInfoVideoDecodeAcceleratorCapability)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"profile"
    Parser
  (SystemInfoSize
   -> SystemInfoSize -> SystemInfoVideoDecodeAcceleratorCapability)
-> Parser SystemInfoSize
-> Parser
     (SystemInfoSize -> SystemInfoVideoDecodeAcceleratorCapability)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SystemInfoSize
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"maxResolution"
    Parser
  (SystemInfoSize -> SystemInfoVideoDecodeAcceleratorCapability)
-> Parser SystemInfoSize
-> Parser SystemInfoVideoDecodeAcceleratorCapability
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SystemInfoSize
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"minResolution"
instance ToJSON SystemInfoVideoDecodeAcceleratorCapability where
  toJSON :: SystemInfoVideoDecodeAcceleratorCapability -> Value
toJSON SystemInfoVideoDecodeAcceleratorCapability
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"profile" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoVideoDecodeAcceleratorCapability -> Text
systemInfoVideoDecodeAcceleratorCapabilityProfile SystemInfoVideoDecodeAcceleratorCapability
p),
    (Text
"maxResolution" Text -> SystemInfoSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (SystemInfoSize -> Pair) -> Maybe SystemInfoSize -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemInfoSize -> Maybe SystemInfoSize
forall a. a -> Maybe a
Just (SystemInfoVideoDecodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoDecodeAcceleratorCapabilityMaxResolution SystemInfoVideoDecodeAcceleratorCapability
p),
    (Text
"minResolution" Text -> SystemInfoSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (SystemInfoSize -> Pair) -> Maybe SystemInfoSize -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemInfoSize -> Maybe SystemInfoSize
forall a. a -> Maybe a
Just (SystemInfoVideoDecodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoDecodeAcceleratorCapabilityMinResolution SystemInfoVideoDecodeAcceleratorCapability
p)
    ]

-- | Type 'SystemInfo.VideoEncodeAcceleratorCapability'.
--   Describes a supported video encoding profile with its associated maximum
--   resolution and maximum framerate.
data SystemInfoVideoEncodeAcceleratorCapability = SystemInfoVideoEncodeAcceleratorCapability
  {
    -- | Video codec profile that is supported, e.g H264 Main.
    SystemInfoVideoEncodeAcceleratorCapability -> Text
systemInfoVideoEncodeAcceleratorCapabilityProfile :: T.Text,
    -- | Maximum video dimensions in pixels supported for this |profile|.
    SystemInfoVideoEncodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoEncodeAcceleratorCapabilityMaxResolution :: SystemInfoSize,
    -- | Maximum encoding framerate in frames per second supported for this
    --   |profile|, as fraction's numerator and denominator, e.g. 24/1 fps,
    --   24000/1001 fps, etc.
    SystemInfoVideoEncodeAcceleratorCapability -> Int
systemInfoVideoEncodeAcceleratorCapabilityMaxFramerateNumerator :: Int,
    SystemInfoVideoEncodeAcceleratorCapability -> Int
systemInfoVideoEncodeAcceleratorCapabilityMaxFramerateDenominator :: Int
  }
  deriving (SystemInfoVideoEncodeAcceleratorCapability
-> SystemInfoVideoEncodeAcceleratorCapability -> Bool
(SystemInfoVideoEncodeAcceleratorCapability
 -> SystemInfoVideoEncodeAcceleratorCapability -> Bool)
-> (SystemInfoVideoEncodeAcceleratorCapability
    -> SystemInfoVideoEncodeAcceleratorCapability -> Bool)
-> Eq SystemInfoVideoEncodeAcceleratorCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoVideoEncodeAcceleratorCapability
-> SystemInfoVideoEncodeAcceleratorCapability -> Bool
$c/= :: SystemInfoVideoEncodeAcceleratorCapability
-> SystemInfoVideoEncodeAcceleratorCapability -> Bool
== :: SystemInfoVideoEncodeAcceleratorCapability
-> SystemInfoVideoEncodeAcceleratorCapability -> Bool
$c== :: SystemInfoVideoEncodeAcceleratorCapability
-> SystemInfoVideoEncodeAcceleratorCapability -> Bool
Eq, Int -> SystemInfoVideoEncodeAcceleratorCapability -> ShowS
[SystemInfoVideoEncodeAcceleratorCapability] -> ShowS
SystemInfoVideoEncodeAcceleratorCapability -> String
(Int -> SystemInfoVideoEncodeAcceleratorCapability -> ShowS)
-> (SystemInfoVideoEncodeAcceleratorCapability -> String)
-> ([SystemInfoVideoEncodeAcceleratorCapability] -> ShowS)
-> Show SystemInfoVideoEncodeAcceleratorCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoVideoEncodeAcceleratorCapability] -> ShowS
$cshowList :: [SystemInfoVideoEncodeAcceleratorCapability] -> ShowS
show :: SystemInfoVideoEncodeAcceleratorCapability -> String
$cshow :: SystemInfoVideoEncodeAcceleratorCapability -> String
showsPrec :: Int -> SystemInfoVideoEncodeAcceleratorCapability -> ShowS
$cshowsPrec :: Int -> SystemInfoVideoEncodeAcceleratorCapability -> ShowS
Show)
instance FromJSON SystemInfoVideoEncodeAcceleratorCapability where
  parseJSON :: Value -> Parser SystemInfoVideoEncodeAcceleratorCapability
parseJSON = String
-> (Object -> Parser SystemInfoVideoEncodeAcceleratorCapability)
-> Value
-> Parser SystemInfoVideoEncodeAcceleratorCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoVideoEncodeAcceleratorCapability" ((Object -> Parser SystemInfoVideoEncodeAcceleratorCapability)
 -> Value -> Parser SystemInfoVideoEncodeAcceleratorCapability)
-> (Object -> Parser SystemInfoVideoEncodeAcceleratorCapability)
-> Value
-> Parser SystemInfoVideoEncodeAcceleratorCapability
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> SystemInfoSize
-> Int
-> Int
-> SystemInfoVideoEncodeAcceleratorCapability
SystemInfoVideoEncodeAcceleratorCapability
    (Text
 -> SystemInfoSize
 -> Int
 -> Int
 -> SystemInfoVideoEncodeAcceleratorCapability)
-> Parser Text
-> Parser
     (SystemInfoSize
      -> Int -> Int -> SystemInfoVideoEncodeAcceleratorCapability)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"profile"
    Parser
  (SystemInfoSize
   -> Int -> Int -> SystemInfoVideoEncodeAcceleratorCapability)
-> Parser SystemInfoSize
-> Parser
     (Int -> Int -> SystemInfoVideoEncodeAcceleratorCapability)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SystemInfoSize
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"maxResolution"
    Parser (Int -> Int -> SystemInfoVideoEncodeAcceleratorCapability)
-> Parser Int
-> Parser (Int -> SystemInfoVideoEncodeAcceleratorCapability)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"maxFramerateNumerator"
    Parser (Int -> SystemInfoVideoEncodeAcceleratorCapability)
-> Parser Int -> Parser SystemInfoVideoEncodeAcceleratorCapability
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"maxFramerateDenominator"
instance ToJSON SystemInfoVideoEncodeAcceleratorCapability where
  toJSON :: SystemInfoVideoEncodeAcceleratorCapability -> Value
toJSON SystemInfoVideoEncodeAcceleratorCapability
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"profile" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoVideoEncodeAcceleratorCapability -> Text
systemInfoVideoEncodeAcceleratorCapabilityProfile SystemInfoVideoEncodeAcceleratorCapability
p),
    (Text
"maxResolution" Text -> SystemInfoSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (SystemInfoSize -> Pair) -> Maybe SystemInfoSize -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemInfoSize -> Maybe SystemInfoSize
forall a. a -> Maybe a
Just (SystemInfoVideoEncodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoEncodeAcceleratorCapabilityMaxResolution SystemInfoVideoEncodeAcceleratorCapability
p),
    (Text
"maxFramerateNumerator" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (SystemInfoVideoEncodeAcceleratorCapability -> Int
systemInfoVideoEncodeAcceleratorCapabilityMaxFramerateNumerator SystemInfoVideoEncodeAcceleratorCapability
p),
    (Text
"maxFramerateDenominator" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (SystemInfoVideoEncodeAcceleratorCapability -> Int
systemInfoVideoEncodeAcceleratorCapabilityMaxFramerateDenominator SystemInfoVideoEncodeAcceleratorCapability
p)
    ]

-- | Type 'SystemInfo.SubsamplingFormat'.
--   YUV subsampling type of the pixels of a given image.
data SystemInfoSubsamplingFormat = SystemInfoSubsamplingFormatYuv420 | SystemInfoSubsamplingFormatYuv422 | SystemInfoSubsamplingFormatYuv444
  deriving (Eq SystemInfoSubsamplingFormat
Eq SystemInfoSubsamplingFormat
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> Ordering)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> Bool)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> Bool)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> Bool)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> Bool)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat)
-> Ord SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> Ordering
SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat
$cmin :: SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat
max :: SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat
$cmax :: SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat
>= :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
$c>= :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
> :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
$c> :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
<= :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
$c<= :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
< :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
$c< :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
compare :: SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> Ordering
$ccompare :: SystemInfoSubsamplingFormat
-> SystemInfoSubsamplingFormat -> Ordering
$cp1Ord :: Eq SystemInfoSubsamplingFormat
Ord, SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
(SystemInfoSubsamplingFormat
 -> SystemInfoSubsamplingFormat -> Bool)
-> (SystemInfoSubsamplingFormat
    -> SystemInfoSubsamplingFormat -> Bool)
-> Eq SystemInfoSubsamplingFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
$c/= :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
== :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
$c== :: SystemInfoSubsamplingFormat -> SystemInfoSubsamplingFormat -> Bool
Eq, Int -> SystemInfoSubsamplingFormat -> ShowS
[SystemInfoSubsamplingFormat] -> ShowS
SystemInfoSubsamplingFormat -> String
(Int -> SystemInfoSubsamplingFormat -> ShowS)
-> (SystemInfoSubsamplingFormat -> String)
-> ([SystemInfoSubsamplingFormat] -> ShowS)
-> Show SystemInfoSubsamplingFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoSubsamplingFormat] -> ShowS
$cshowList :: [SystemInfoSubsamplingFormat] -> ShowS
show :: SystemInfoSubsamplingFormat -> String
$cshow :: SystemInfoSubsamplingFormat -> String
showsPrec :: Int -> SystemInfoSubsamplingFormat -> ShowS
$cshowsPrec :: Int -> SystemInfoSubsamplingFormat -> ShowS
Show, ReadPrec [SystemInfoSubsamplingFormat]
ReadPrec SystemInfoSubsamplingFormat
Int -> ReadS SystemInfoSubsamplingFormat
ReadS [SystemInfoSubsamplingFormat]
(Int -> ReadS SystemInfoSubsamplingFormat)
-> ReadS [SystemInfoSubsamplingFormat]
-> ReadPrec SystemInfoSubsamplingFormat
-> ReadPrec [SystemInfoSubsamplingFormat]
-> Read SystemInfoSubsamplingFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SystemInfoSubsamplingFormat]
$creadListPrec :: ReadPrec [SystemInfoSubsamplingFormat]
readPrec :: ReadPrec SystemInfoSubsamplingFormat
$creadPrec :: ReadPrec SystemInfoSubsamplingFormat
readList :: ReadS [SystemInfoSubsamplingFormat]
$creadList :: ReadS [SystemInfoSubsamplingFormat]
readsPrec :: Int -> ReadS SystemInfoSubsamplingFormat
$creadsPrec :: Int -> ReadS SystemInfoSubsamplingFormat
Read)
instance FromJSON SystemInfoSubsamplingFormat where
  parseJSON :: Value -> Parser SystemInfoSubsamplingFormat
parseJSON = String
-> (Text -> Parser SystemInfoSubsamplingFormat)
-> Value
-> Parser SystemInfoSubsamplingFormat
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"SystemInfoSubsamplingFormat" ((Text -> Parser SystemInfoSubsamplingFormat)
 -> Value -> Parser SystemInfoSubsamplingFormat)
-> (Text -> Parser SystemInfoSubsamplingFormat)
-> Value
-> Parser SystemInfoSubsamplingFormat
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"yuv420" -> SystemInfoSubsamplingFormat -> Parser SystemInfoSubsamplingFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormatYuv420
    Text
"yuv422" -> SystemInfoSubsamplingFormat -> Parser SystemInfoSubsamplingFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormatYuv422
    Text
"yuv444" -> SystemInfoSubsamplingFormat -> Parser SystemInfoSubsamplingFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormatYuv444
    Text
"_" -> String -> Parser SystemInfoSubsamplingFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse SystemInfoSubsamplingFormat"
instance ToJSON SystemInfoSubsamplingFormat where
  toJSON :: SystemInfoSubsamplingFormat -> Value
toJSON SystemInfoSubsamplingFormat
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case SystemInfoSubsamplingFormat
v of
    SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormatYuv420 -> Text
"yuv420"
    SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormatYuv422 -> Text
"yuv422"
    SystemInfoSubsamplingFormat
SystemInfoSubsamplingFormatYuv444 -> Text
"yuv444"

-- | Type 'SystemInfo.ImageType'.
--   Image format of a given image.
data SystemInfoImageType = SystemInfoImageTypeJpeg | SystemInfoImageTypeWebp | SystemInfoImageTypeUnknown
  deriving (Eq SystemInfoImageType
Eq SystemInfoImageType
-> (SystemInfoImageType -> SystemInfoImageType -> Ordering)
-> (SystemInfoImageType -> SystemInfoImageType -> Bool)
-> (SystemInfoImageType -> SystemInfoImageType -> Bool)
-> (SystemInfoImageType -> SystemInfoImageType -> Bool)
-> (SystemInfoImageType -> SystemInfoImageType -> Bool)
-> (SystemInfoImageType
    -> SystemInfoImageType -> SystemInfoImageType)
-> (SystemInfoImageType
    -> SystemInfoImageType -> SystemInfoImageType)
-> Ord SystemInfoImageType
SystemInfoImageType -> SystemInfoImageType -> Bool
SystemInfoImageType -> SystemInfoImageType -> Ordering
SystemInfoImageType -> SystemInfoImageType -> SystemInfoImageType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SystemInfoImageType -> SystemInfoImageType -> SystemInfoImageType
$cmin :: SystemInfoImageType -> SystemInfoImageType -> SystemInfoImageType
max :: SystemInfoImageType -> SystemInfoImageType -> SystemInfoImageType
$cmax :: SystemInfoImageType -> SystemInfoImageType -> SystemInfoImageType
>= :: SystemInfoImageType -> SystemInfoImageType -> Bool
$c>= :: SystemInfoImageType -> SystemInfoImageType -> Bool
> :: SystemInfoImageType -> SystemInfoImageType -> Bool
$c> :: SystemInfoImageType -> SystemInfoImageType -> Bool
<= :: SystemInfoImageType -> SystemInfoImageType -> Bool
$c<= :: SystemInfoImageType -> SystemInfoImageType -> Bool
< :: SystemInfoImageType -> SystemInfoImageType -> Bool
$c< :: SystemInfoImageType -> SystemInfoImageType -> Bool
compare :: SystemInfoImageType -> SystemInfoImageType -> Ordering
$ccompare :: SystemInfoImageType -> SystemInfoImageType -> Ordering
$cp1Ord :: Eq SystemInfoImageType
Ord, SystemInfoImageType -> SystemInfoImageType -> Bool
(SystemInfoImageType -> SystemInfoImageType -> Bool)
-> (SystemInfoImageType -> SystemInfoImageType -> Bool)
-> Eq SystemInfoImageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoImageType -> SystemInfoImageType -> Bool
$c/= :: SystemInfoImageType -> SystemInfoImageType -> Bool
== :: SystemInfoImageType -> SystemInfoImageType -> Bool
$c== :: SystemInfoImageType -> SystemInfoImageType -> Bool
Eq, Int -> SystemInfoImageType -> ShowS
[SystemInfoImageType] -> ShowS
SystemInfoImageType -> String
(Int -> SystemInfoImageType -> ShowS)
-> (SystemInfoImageType -> String)
-> ([SystemInfoImageType] -> ShowS)
-> Show SystemInfoImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoImageType] -> ShowS
$cshowList :: [SystemInfoImageType] -> ShowS
show :: SystemInfoImageType -> String
$cshow :: SystemInfoImageType -> String
showsPrec :: Int -> SystemInfoImageType -> ShowS
$cshowsPrec :: Int -> SystemInfoImageType -> ShowS
Show, ReadPrec [SystemInfoImageType]
ReadPrec SystemInfoImageType
Int -> ReadS SystemInfoImageType
ReadS [SystemInfoImageType]
(Int -> ReadS SystemInfoImageType)
-> ReadS [SystemInfoImageType]
-> ReadPrec SystemInfoImageType
-> ReadPrec [SystemInfoImageType]
-> Read SystemInfoImageType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SystemInfoImageType]
$creadListPrec :: ReadPrec [SystemInfoImageType]
readPrec :: ReadPrec SystemInfoImageType
$creadPrec :: ReadPrec SystemInfoImageType
readList :: ReadS [SystemInfoImageType]
$creadList :: ReadS [SystemInfoImageType]
readsPrec :: Int -> ReadS SystemInfoImageType
$creadsPrec :: Int -> ReadS SystemInfoImageType
Read)
instance FromJSON SystemInfoImageType where
  parseJSON :: Value -> Parser SystemInfoImageType
parseJSON = String
-> (Text -> Parser SystemInfoImageType)
-> Value
-> Parser SystemInfoImageType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"SystemInfoImageType" ((Text -> Parser SystemInfoImageType)
 -> Value -> Parser SystemInfoImageType)
-> (Text -> Parser SystemInfoImageType)
-> Value
-> Parser SystemInfoImageType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"jpeg" -> SystemInfoImageType -> Parser SystemInfoImageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemInfoImageType
SystemInfoImageTypeJpeg
    Text
"webp" -> SystemInfoImageType -> Parser SystemInfoImageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemInfoImageType
SystemInfoImageTypeWebp
    Text
"unknown" -> SystemInfoImageType -> Parser SystemInfoImageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemInfoImageType
SystemInfoImageTypeUnknown
    Text
"_" -> String -> Parser SystemInfoImageType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse SystemInfoImageType"
instance ToJSON SystemInfoImageType where
  toJSON :: SystemInfoImageType -> Value
toJSON SystemInfoImageType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case SystemInfoImageType
v of
    SystemInfoImageType
SystemInfoImageTypeJpeg -> Text
"jpeg"
    SystemInfoImageType
SystemInfoImageTypeWebp -> Text
"webp"
    SystemInfoImageType
SystemInfoImageTypeUnknown -> Text
"unknown"

-- | Type 'SystemInfo.ImageDecodeAcceleratorCapability'.
--   Describes a supported image decoding profile with its associated minimum and
--   maximum resolutions and subsampling.
data SystemInfoImageDecodeAcceleratorCapability = SystemInfoImageDecodeAcceleratorCapability
  {
    -- | Image coded, e.g. Jpeg.
    SystemInfoImageDecodeAcceleratorCapability -> SystemInfoImageType
systemInfoImageDecodeAcceleratorCapabilityImageType :: SystemInfoImageType,
    -- | Maximum supported dimensions of the image in pixels.
    SystemInfoImageDecodeAcceleratorCapability -> SystemInfoSize
systemInfoImageDecodeAcceleratorCapabilityMaxDimensions :: SystemInfoSize,
    -- | Minimum supported dimensions of the image in pixels.
    SystemInfoImageDecodeAcceleratorCapability -> SystemInfoSize
systemInfoImageDecodeAcceleratorCapabilityMinDimensions :: SystemInfoSize,
    -- | Optional array of supported subsampling formats, e.g. 4:2:0, if known.
    SystemInfoImageDecodeAcceleratorCapability
-> [SystemInfoSubsamplingFormat]
systemInfoImageDecodeAcceleratorCapabilitySubsamplings :: [SystemInfoSubsamplingFormat]
  }
  deriving (SystemInfoImageDecodeAcceleratorCapability
-> SystemInfoImageDecodeAcceleratorCapability -> Bool
(SystemInfoImageDecodeAcceleratorCapability
 -> SystemInfoImageDecodeAcceleratorCapability -> Bool)
-> (SystemInfoImageDecodeAcceleratorCapability
    -> SystemInfoImageDecodeAcceleratorCapability -> Bool)
-> Eq SystemInfoImageDecodeAcceleratorCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoImageDecodeAcceleratorCapability
-> SystemInfoImageDecodeAcceleratorCapability -> Bool
$c/= :: SystemInfoImageDecodeAcceleratorCapability
-> SystemInfoImageDecodeAcceleratorCapability -> Bool
== :: SystemInfoImageDecodeAcceleratorCapability
-> SystemInfoImageDecodeAcceleratorCapability -> Bool
$c== :: SystemInfoImageDecodeAcceleratorCapability
-> SystemInfoImageDecodeAcceleratorCapability -> Bool
Eq, Int -> SystemInfoImageDecodeAcceleratorCapability -> ShowS
[SystemInfoImageDecodeAcceleratorCapability] -> ShowS
SystemInfoImageDecodeAcceleratorCapability -> String
(Int -> SystemInfoImageDecodeAcceleratorCapability -> ShowS)
-> (SystemInfoImageDecodeAcceleratorCapability -> String)
-> ([SystemInfoImageDecodeAcceleratorCapability] -> ShowS)
-> Show SystemInfoImageDecodeAcceleratorCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoImageDecodeAcceleratorCapability] -> ShowS
$cshowList :: [SystemInfoImageDecodeAcceleratorCapability] -> ShowS
show :: SystemInfoImageDecodeAcceleratorCapability -> String
$cshow :: SystemInfoImageDecodeAcceleratorCapability -> String
showsPrec :: Int -> SystemInfoImageDecodeAcceleratorCapability -> ShowS
$cshowsPrec :: Int -> SystemInfoImageDecodeAcceleratorCapability -> ShowS
Show)
instance FromJSON SystemInfoImageDecodeAcceleratorCapability where
  parseJSON :: Value -> Parser SystemInfoImageDecodeAcceleratorCapability
parseJSON = String
-> (Object -> Parser SystemInfoImageDecodeAcceleratorCapability)
-> Value
-> Parser SystemInfoImageDecodeAcceleratorCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoImageDecodeAcceleratorCapability" ((Object -> Parser SystemInfoImageDecodeAcceleratorCapability)
 -> Value -> Parser SystemInfoImageDecodeAcceleratorCapability)
-> (Object -> Parser SystemInfoImageDecodeAcceleratorCapability)
-> Value
-> Parser SystemInfoImageDecodeAcceleratorCapability
forall a b. (a -> b) -> a -> b
$ \Object
o -> SystemInfoImageType
-> SystemInfoSize
-> SystemInfoSize
-> [SystemInfoSubsamplingFormat]
-> SystemInfoImageDecodeAcceleratorCapability
SystemInfoImageDecodeAcceleratorCapability
    (SystemInfoImageType
 -> SystemInfoSize
 -> SystemInfoSize
 -> [SystemInfoSubsamplingFormat]
 -> SystemInfoImageDecodeAcceleratorCapability)
-> Parser SystemInfoImageType
-> Parser
     (SystemInfoSize
      -> SystemInfoSize
      -> [SystemInfoSubsamplingFormat]
      -> SystemInfoImageDecodeAcceleratorCapability)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SystemInfoImageType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"imageType"
    Parser
  (SystemInfoSize
   -> SystemInfoSize
   -> [SystemInfoSubsamplingFormat]
   -> SystemInfoImageDecodeAcceleratorCapability)
-> Parser SystemInfoSize
-> Parser
     (SystemInfoSize
      -> [SystemInfoSubsamplingFormat]
      -> SystemInfoImageDecodeAcceleratorCapability)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SystemInfoSize
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"maxDimensions"
    Parser
  (SystemInfoSize
   -> [SystemInfoSubsamplingFormat]
   -> SystemInfoImageDecodeAcceleratorCapability)
-> Parser SystemInfoSize
-> Parser
     ([SystemInfoSubsamplingFormat]
      -> SystemInfoImageDecodeAcceleratorCapability)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SystemInfoSize
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"minDimensions"
    Parser
  ([SystemInfoSubsamplingFormat]
   -> SystemInfoImageDecodeAcceleratorCapability)
-> Parser [SystemInfoSubsamplingFormat]
-> Parser SystemInfoImageDecodeAcceleratorCapability
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [SystemInfoSubsamplingFormat]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"subsamplings"
instance ToJSON SystemInfoImageDecodeAcceleratorCapability where
  toJSON :: SystemInfoImageDecodeAcceleratorCapability -> Value
toJSON SystemInfoImageDecodeAcceleratorCapability
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"imageType" Text -> SystemInfoImageType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (SystemInfoImageType -> Pair)
-> Maybe SystemInfoImageType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemInfoImageType -> Maybe SystemInfoImageType
forall a. a -> Maybe a
Just (SystemInfoImageDecodeAcceleratorCapability -> SystemInfoImageType
systemInfoImageDecodeAcceleratorCapabilityImageType SystemInfoImageDecodeAcceleratorCapability
p),
    (Text
"maxDimensions" Text -> SystemInfoSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (SystemInfoSize -> Pair) -> Maybe SystemInfoSize -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemInfoSize -> Maybe SystemInfoSize
forall a. a -> Maybe a
Just (SystemInfoImageDecodeAcceleratorCapability -> SystemInfoSize
systemInfoImageDecodeAcceleratorCapabilityMaxDimensions SystemInfoImageDecodeAcceleratorCapability
p),
    (Text
"minDimensions" Text -> SystemInfoSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (SystemInfoSize -> Pair) -> Maybe SystemInfoSize -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemInfoSize -> Maybe SystemInfoSize
forall a. a -> Maybe a
Just (SystemInfoImageDecodeAcceleratorCapability -> SystemInfoSize
systemInfoImageDecodeAcceleratorCapabilityMinDimensions SystemInfoImageDecodeAcceleratorCapability
p),
    (Text
"subsamplings" Text -> [SystemInfoSubsamplingFormat] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([SystemInfoSubsamplingFormat] -> Pair)
-> Maybe [SystemInfoSubsamplingFormat] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SystemInfoSubsamplingFormat]
-> Maybe [SystemInfoSubsamplingFormat]
forall a. a -> Maybe a
Just (SystemInfoImageDecodeAcceleratorCapability
-> [SystemInfoSubsamplingFormat]
systemInfoImageDecodeAcceleratorCapabilitySubsamplings SystemInfoImageDecodeAcceleratorCapability
p)
    ]

-- | Type 'SystemInfo.GPUInfo'.
--   Provides information about the GPU(s) on the system.
data SystemInfoGPUInfo = SystemInfoGPUInfo
  {
    -- | The graphics devices on the system. Element 0 is the primary GPU.
    SystemInfoGPUInfo -> [SystemInfoGPUDevice]
systemInfoGPUInfoDevices :: [SystemInfoGPUDevice],
    -- | An optional dictionary of additional GPU related attributes.
    SystemInfoGPUInfo -> Maybe [(Text, Text)]
systemInfoGPUInfoAuxAttributes :: Maybe [(T.Text, T.Text)],
    -- | An optional dictionary of graphics features and their status.
    SystemInfoGPUInfo -> Maybe [(Text, Text)]
systemInfoGPUInfoFeatureStatus :: Maybe [(T.Text, T.Text)],
    -- | An optional array of GPU driver bug workarounds.
    SystemInfoGPUInfo -> [Text]
systemInfoGPUInfoDriverBugWorkarounds :: [T.Text],
    -- | Supported accelerated video decoding capabilities.
    SystemInfoGPUInfo -> [SystemInfoVideoDecodeAcceleratorCapability]
systemInfoGPUInfoVideoDecoding :: [SystemInfoVideoDecodeAcceleratorCapability],
    -- | Supported accelerated video encoding capabilities.
    SystemInfoGPUInfo -> [SystemInfoVideoEncodeAcceleratorCapability]
systemInfoGPUInfoVideoEncoding :: [SystemInfoVideoEncodeAcceleratorCapability],
    -- | Supported accelerated image decoding capabilities.
    SystemInfoGPUInfo -> [SystemInfoImageDecodeAcceleratorCapability]
systemInfoGPUInfoImageDecoding :: [SystemInfoImageDecodeAcceleratorCapability]
  }
  deriving (SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool
(SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool)
-> (SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool)
-> Eq SystemInfoGPUInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool
$c/= :: SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool
== :: SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool
$c== :: SystemInfoGPUInfo -> SystemInfoGPUInfo -> Bool
Eq, Int -> SystemInfoGPUInfo -> ShowS
[SystemInfoGPUInfo] -> ShowS
SystemInfoGPUInfo -> String
(Int -> SystemInfoGPUInfo -> ShowS)
-> (SystemInfoGPUInfo -> String)
-> ([SystemInfoGPUInfo] -> ShowS)
-> Show SystemInfoGPUInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoGPUInfo] -> ShowS
$cshowList :: [SystemInfoGPUInfo] -> ShowS
show :: SystemInfoGPUInfo -> String
$cshow :: SystemInfoGPUInfo -> String
showsPrec :: Int -> SystemInfoGPUInfo -> ShowS
$cshowsPrec :: Int -> SystemInfoGPUInfo -> ShowS
Show)
instance FromJSON SystemInfoGPUInfo where
  parseJSON :: Value -> Parser SystemInfoGPUInfo
parseJSON = String
-> (Object -> Parser SystemInfoGPUInfo)
-> Value
-> Parser SystemInfoGPUInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoGPUInfo" ((Object -> Parser SystemInfoGPUInfo)
 -> Value -> Parser SystemInfoGPUInfo)
-> (Object -> Parser SystemInfoGPUInfo)
-> Value
-> Parser SystemInfoGPUInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> [SystemInfoGPUDevice]
-> Maybe [(Text, Text)]
-> Maybe [(Text, Text)]
-> [Text]
-> [SystemInfoVideoDecodeAcceleratorCapability]
-> [SystemInfoVideoEncodeAcceleratorCapability]
-> [SystemInfoImageDecodeAcceleratorCapability]
-> SystemInfoGPUInfo
SystemInfoGPUInfo
    ([SystemInfoGPUDevice]
 -> Maybe [(Text, Text)]
 -> Maybe [(Text, Text)]
 -> [Text]
 -> [SystemInfoVideoDecodeAcceleratorCapability]
 -> [SystemInfoVideoEncodeAcceleratorCapability]
 -> [SystemInfoImageDecodeAcceleratorCapability]
 -> SystemInfoGPUInfo)
-> Parser [SystemInfoGPUDevice]
-> Parser
     (Maybe [(Text, Text)]
      -> Maybe [(Text, Text)]
      -> [Text]
      -> [SystemInfoVideoDecodeAcceleratorCapability]
      -> [SystemInfoVideoEncodeAcceleratorCapability]
      -> [SystemInfoImageDecodeAcceleratorCapability]
      -> SystemInfoGPUInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [SystemInfoGPUDevice]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"devices"
    Parser
  (Maybe [(Text, Text)]
   -> Maybe [(Text, Text)]
   -> [Text]
   -> [SystemInfoVideoDecodeAcceleratorCapability]
   -> [SystemInfoVideoEncodeAcceleratorCapability]
   -> [SystemInfoImageDecodeAcceleratorCapability]
   -> SystemInfoGPUInfo)
-> Parser (Maybe [(Text, Text)])
-> Parser
     (Maybe [(Text, Text)]
      -> [Text]
      -> [SystemInfoVideoDecodeAcceleratorCapability]
      -> [SystemInfoVideoEncodeAcceleratorCapability]
      -> [SystemInfoImageDecodeAcceleratorCapability]
      -> SystemInfoGPUInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"auxAttributes"
    Parser
  (Maybe [(Text, Text)]
   -> [Text]
   -> [SystemInfoVideoDecodeAcceleratorCapability]
   -> [SystemInfoVideoEncodeAcceleratorCapability]
   -> [SystemInfoImageDecodeAcceleratorCapability]
   -> SystemInfoGPUInfo)
-> Parser (Maybe [(Text, Text)])
-> Parser
     ([Text]
      -> [SystemInfoVideoDecodeAcceleratorCapability]
      -> [SystemInfoVideoEncodeAcceleratorCapability]
      -> [SystemInfoImageDecodeAcceleratorCapability]
      -> SystemInfoGPUInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"featureStatus"
    Parser
  ([Text]
   -> [SystemInfoVideoDecodeAcceleratorCapability]
   -> [SystemInfoVideoEncodeAcceleratorCapability]
   -> [SystemInfoImageDecodeAcceleratorCapability]
   -> SystemInfoGPUInfo)
-> Parser [Text]
-> Parser
     ([SystemInfoVideoDecodeAcceleratorCapability]
      -> [SystemInfoVideoEncodeAcceleratorCapability]
      -> [SystemInfoImageDecodeAcceleratorCapability]
      -> SystemInfoGPUInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"driverBugWorkarounds"
    Parser
  ([SystemInfoVideoDecodeAcceleratorCapability]
   -> [SystemInfoVideoEncodeAcceleratorCapability]
   -> [SystemInfoImageDecodeAcceleratorCapability]
   -> SystemInfoGPUInfo)
-> Parser [SystemInfoVideoDecodeAcceleratorCapability]
-> Parser
     ([SystemInfoVideoEncodeAcceleratorCapability]
      -> [SystemInfoImageDecodeAcceleratorCapability]
      -> SystemInfoGPUInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> Parser [SystemInfoVideoDecodeAcceleratorCapability]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"videoDecoding"
    Parser
  ([SystemInfoVideoEncodeAcceleratorCapability]
   -> [SystemInfoImageDecodeAcceleratorCapability]
   -> SystemInfoGPUInfo)
-> Parser [SystemInfoVideoEncodeAcceleratorCapability]
-> Parser
     ([SystemInfoImageDecodeAcceleratorCapability] -> SystemInfoGPUInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> Parser [SystemInfoVideoEncodeAcceleratorCapability]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"videoEncoding"
    Parser
  ([SystemInfoImageDecodeAcceleratorCapability] -> SystemInfoGPUInfo)
-> Parser [SystemInfoImageDecodeAcceleratorCapability]
-> Parser SystemInfoGPUInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> Parser [SystemInfoImageDecodeAcceleratorCapability]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"imageDecoding"
instance ToJSON SystemInfoGPUInfo where
  toJSON :: SystemInfoGPUInfo -> Value
toJSON SystemInfoGPUInfo
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"devices" Text -> [SystemInfoGPUDevice] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([SystemInfoGPUDevice] -> Pair)
-> Maybe [SystemInfoGPUDevice] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SystemInfoGPUDevice] -> Maybe [SystemInfoGPUDevice]
forall a. a -> Maybe a
Just (SystemInfoGPUInfo -> [SystemInfoGPUDevice]
systemInfoGPUInfoDevices SystemInfoGPUInfo
p),
    (Text
"auxAttributes" Text -> [(Text, Text)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([(Text, Text)] -> Pair) -> Maybe [(Text, Text)] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SystemInfoGPUInfo -> Maybe [(Text, Text)]
systemInfoGPUInfoAuxAttributes SystemInfoGPUInfo
p),
    (Text
"featureStatus" Text -> [(Text, Text)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([(Text, Text)] -> Pair) -> Maybe [(Text, Text)] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SystemInfoGPUInfo -> Maybe [(Text, Text)]
systemInfoGPUInfoFeatureStatus SystemInfoGPUInfo
p),
    (Text
"driverBugWorkarounds" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (SystemInfoGPUInfo -> [Text]
systemInfoGPUInfoDriverBugWorkarounds SystemInfoGPUInfo
p),
    (Text
"videoDecoding" Text -> [SystemInfoVideoDecodeAcceleratorCapability] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([SystemInfoVideoDecodeAcceleratorCapability] -> Pair)
-> Maybe [SystemInfoVideoDecodeAcceleratorCapability] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SystemInfoVideoDecodeAcceleratorCapability]
-> Maybe [SystemInfoVideoDecodeAcceleratorCapability]
forall a. a -> Maybe a
Just (SystemInfoGPUInfo -> [SystemInfoVideoDecodeAcceleratorCapability]
systemInfoGPUInfoVideoDecoding SystemInfoGPUInfo
p),
    (Text
"videoEncoding" Text -> [SystemInfoVideoEncodeAcceleratorCapability] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([SystemInfoVideoEncodeAcceleratorCapability] -> Pair)
-> Maybe [SystemInfoVideoEncodeAcceleratorCapability] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SystemInfoVideoEncodeAcceleratorCapability]
-> Maybe [SystemInfoVideoEncodeAcceleratorCapability]
forall a. a -> Maybe a
Just (SystemInfoGPUInfo -> [SystemInfoVideoEncodeAcceleratorCapability]
systemInfoGPUInfoVideoEncoding SystemInfoGPUInfo
p),
    (Text
"imageDecoding" Text -> [SystemInfoImageDecodeAcceleratorCapability] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([SystemInfoImageDecodeAcceleratorCapability] -> Pair)
-> Maybe [SystemInfoImageDecodeAcceleratorCapability] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SystemInfoImageDecodeAcceleratorCapability]
-> Maybe [SystemInfoImageDecodeAcceleratorCapability]
forall a. a -> Maybe a
Just (SystemInfoGPUInfo -> [SystemInfoImageDecodeAcceleratorCapability]
systemInfoGPUInfoImageDecoding SystemInfoGPUInfo
p)
    ]

-- | Type 'SystemInfo.ProcessInfo'.
--   Represents process info.
data SystemInfoProcessInfo = SystemInfoProcessInfo
  {
    -- | Specifies process type.
    SystemInfoProcessInfo -> Text
systemInfoProcessInfoType :: T.Text,
    -- | Specifies process id.
    SystemInfoProcessInfo -> Int
systemInfoProcessInfoId :: Int,
    -- | Specifies cumulative CPU usage in seconds across all threads of the
    --   process since the process start.
    SystemInfoProcessInfo -> Double
systemInfoProcessInfoCpuTime :: Double
  }
  deriving (SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool
(SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool)
-> (SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool)
-> Eq SystemInfoProcessInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool
$c/= :: SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool
== :: SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool
$c== :: SystemInfoProcessInfo -> SystemInfoProcessInfo -> Bool
Eq, Int -> SystemInfoProcessInfo -> ShowS
[SystemInfoProcessInfo] -> ShowS
SystemInfoProcessInfo -> String
(Int -> SystemInfoProcessInfo -> ShowS)
-> (SystemInfoProcessInfo -> String)
-> ([SystemInfoProcessInfo] -> ShowS)
-> Show SystemInfoProcessInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoProcessInfo] -> ShowS
$cshowList :: [SystemInfoProcessInfo] -> ShowS
show :: SystemInfoProcessInfo -> String
$cshow :: SystemInfoProcessInfo -> String
showsPrec :: Int -> SystemInfoProcessInfo -> ShowS
$cshowsPrec :: Int -> SystemInfoProcessInfo -> ShowS
Show)
instance FromJSON SystemInfoProcessInfo where
  parseJSON :: Value -> Parser SystemInfoProcessInfo
parseJSON = String
-> (Object -> Parser SystemInfoProcessInfo)
-> Value
-> Parser SystemInfoProcessInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoProcessInfo" ((Object -> Parser SystemInfoProcessInfo)
 -> Value -> Parser SystemInfoProcessInfo)
-> (Object -> Parser SystemInfoProcessInfo)
-> Value
-> Parser SystemInfoProcessInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Int -> Double -> SystemInfoProcessInfo
SystemInfoProcessInfo
    (Text -> Int -> Double -> SystemInfoProcessInfo)
-> Parser Text -> Parser (Int -> Double -> SystemInfoProcessInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser (Int -> Double -> SystemInfoProcessInfo)
-> Parser Int -> Parser (Double -> SystemInfoProcessInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Parser (Double -> SystemInfoProcessInfo)
-> Parser Double -> Parser SystemInfoProcessInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"cpuTime"
instance ToJSON SystemInfoProcessInfo where
  toJSON :: SystemInfoProcessInfo -> Value
toJSON SystemInfoProcessInfo
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (SystemInfoProcessInfo -> Text
systemInfoProcessInfoType SystemInfoProcessInfo
p),
    (Text
"id" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (SystemInfoProcessInfo -> Int
systemInfoProcessInfoId SystemInfoProcessInfo
p),
    (Text
"cpuTime" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (SystemInfoProcessInfo -> Double
systemInfoProcessInfoCpuTime SystemInfoProcessInfo
p)
    ]

-- | Returns information about the system.

-- | Parameters of the 'SystemInfo.getInfo' command.
data PSystemInfoGetInfo = PSystemInfoGetInfo
  deriving (PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool
(PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool)
-> (PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool)
-> Eq PSystemInfoGetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool
$c/= :: PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool
== :: PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool
$c== :: PSystemInfoGetInfo -> PSystemInfoGetInfo -> Bool
Eq, Int -> PSystemInfoGetInfo -> ShowS
[PSystemInfoGetInfo] -> ShowS
PSystemInfoGetInfo -> String
(Int -> PSystemInfoGetInfo -> ShowS)
-> (PSystemInfoGetInfo -> String)
-> ([PSystemInfoGetInfo] -> ShowS)
-> Show PSystemInfoGetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSystemInfoGetInfo] -> ShowS
$cshowList :: [PSystemInfoGetInfo] -> ShowS
show :: PSystemInfoGetInfo -> String
$cshow :: PSystemInfoGetInfo -> String
showsPrec :: Int -> PSystemInfoGetInfo -> ShowS
$cshowsPrec :: Int -> PSystemInfoGetInfo -> ShowS
Show)
pSystemInfoGetInfo
  :: PSystemInfoGetInfo
pSystemInfoGetInfo :: PSystemInfoGetInfo
pSystemInfoGetInfo
  = PSystemInfoGetInfo
PSystemInfoGetInfo
instance ToJSON PSystemInfoGetInfo where
  toJSON :: PSystemInfoGetInfo -> Value
toJSON PSystemInfoGetInfo
_ = Value
A.Null
data SystemInfoGetInfo = SystemInfoGetInfo
  {
    -- | Information about the GPUs on the system.
    SystemInfoGetInfo -> SystemInfoGPUInfo
systemInfoGetInfoGpu :: SystemInfoGPUInfo,
    -- | A platform-dependent description of the model of the machine. On Mac OS, this is, for
    --   example, 'MacBookPro'. Will be the empty string if not supported.
    SystemInfoGetInfo -> Text
systemInfoGetInfoModelName :: T.Text,
    -- | A platform-dependent description of the version of the machine. On Mac OS, this is, for
    --   example, '10.1'. Will be the empty string if not supported.
    SystemInfoGetInfo -> Text
systemInfoGetInfoModelVersion :: T.Text,
    -- | The command line string used to launch the browser. Will be the empty string if not
    --   supported.
    SystemInfoGetInfo -> Text
systemInfoGetInfoCommandLine :: T.Text
  }
  deriving (SystemInfoGetInfo -> SystemInfoGetInfo -> Bool
(SystemInfoGetInfo -> SystemInfoGetInfo -> Bool)
-> (SystemInfoGetInfo -> SystemInfoGetInfo -> Bool)
-> Eq SystemInfoGetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoGetInfo -> SystemInfoGetInfo -> Bool
$c/= :: SystemInfoGetInfo -> SystemInfoGetInfo -> Bool
== :: SystemInfoGetInfo -> SystemInfoGetInfo -> Bool
$c== :: SystemInfoGetInfo -> SystemInfoGetInfo -> Bool
Eq, Int -> SystemInfoGetInfo -> ShowS
[SystemInfoGetInfo] -> ShowS
SystemInfoGetInfo -> String
(Int -> SystemInfoGetInfo -> ShowS)
-> (SystemInfoGetInfo -> String)
-> ([SystemInfoGetInfo] -> ShowS)
-> Show SystemInfoGetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoGetInfo] -> ShowS
$cshowList :: [SystemInfoGetInfo] -> ShowS
show :: SystemInfoGetInfo -> String
$cshow :: SystemInfoGetInfo -> String
showsPrec :: Int -> SystemInfoGetInfo -> ShowS
$cshowsPrec :: Int -> SystemInfoGetInfo -> ShowS
Show)
instance FromJSON SystemInfoGetInfo where
  parseJSON :: Value -> Parser SystemInfoGetInfo
parseJSON = String
-> (Object -> Parser SystemInfoGetInfo)
-> Value
-> Parser SystemInfoGetInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoGetInfo" ((Object -> Parser SystemInfoGetInfo)
 -> Value -> Parser SystemInfoGetInfo)
-> (Object -> Parser SystemInfoGetInfo)
-> Value
-> Parser SystemInfoGetInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> SystemInfoGPUInfo -> Text -> Text -> Text -> SystemInfoGetInfo
SystemInfoGetInfo
    (SystemInfoGPUInfo -> Text -> Text -> Text -> SystemInfoGetInfo)
-> Parser SystemInfoGPUInfo
-> Parser (Text -> Text -> Text -> SystemInfoGetInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SystemInfoGPUInfo
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"gpu"
    Parser (Text -> Text -> Text -> SystemInfoGetInfo)
-> Parser Text -> Parser (Text -> Text -> SystemInfoGetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"modelName"
    Parser (Text -> Text -> SystemInfoGetInfo)
-> Parser Text -> Parser (Text -> SystemInfoGetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"modelVersion"
    Parser (Text -> SystemInfoGetInfo)
-> Parser Text -> Parser SystemInfoGetInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"commandLine"
instance Command PSystemInfoGetInfo where
  type CommandResponse PSystemInfoGetInfo = SystemInfoGetInfo
  commandName :: Proxy PSystemInfoGetInfo -> String
commandName Proxy PSystemInfoGetInfo
_ = String
"SystemInfo.getInfo"

-- | Returns information about all running processes.

-- | Parameters of the 'SystemInfo.getProcessInfo' command.
data PSystemInfoGetProcessInfo = PSystemInfoGetProcessInfo
  deriving (PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool
(PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool)
-> (PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool)
-> Eq PSystemInfoGetProcessInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool
$c/= :: PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool
== :: PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool
$c== :: PSystemInfoGetProcessInfo -> PSystemInfoGetProcessInfo -> Bool
Eq, Int -> PSystemInfoGetProcessInfo -> ShowS
[PSystemInfoGetProcessInfo] -> ShowS
PSystemInfoGetProcessInfo -> String
(Int -> PSystemInfoGetProcessInfo -> ShowS)
-> (PSystemInfoGetProcessInfo -> String)
-> ([PSystemInfoGetProcessInfo] -> ShowS)
-> Show PSystemInfoGetProcessInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSystemInfoGetProcessInfo] -> ShowS
$cshowList :: [PSystemInfoGetProcessInfo] -> ShowS
show :: PSystemInfoGetProcessInfo -> String
$cshow :: PSystemInfoGetProcessInfo -> String
showsPrec :: Int -> PSystemInfoGetProcessInfo -> ShowS
$cshowsPrec :: Int -> PSystemInfoGetProcessInfo -> ShowS
Show)
pSystemInfoGetProcessInfo
  :: PSystemInfoGetProcessInfo
pSystemInfoGetProcessInfo :: PSystemInfoGetProcessInfo
pSystemInfoGetProcessInfo
  = PSystemInfoGetProcessInfo
PSystemInfoGetProcessInfo
instance ToJSON PSystemInfoGetProcessInfo where
  toJSON :: PSystemInfoGetProcessInfo -> Value
toJSON PSystemInfoGetProcessInfo
_ = Value
A.Null
data SystemInfoGetProcessInfo = SystemInfoGetProcessInfo
  {
    -- | An array of process info blocks.
    SystemInfoGetProcessInfo -> [SystemInfoProcessInfo]
systemInfoGetProcessInfoProcessInfo :: [SystemInfoProcessInfo]
  }
  deriving (SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool
(SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool)
-> (SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool)
-> Eq SystemInfoGetProcessInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool
$c/= :: SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool
== :: SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool
$c== :: SystemInfoGetProcessInfo -> SystemInfoGetProcessInfo -> Bool
Eq, Int -> SystemInfoGetProcessInfo -> ShowS
[SystemInfoGetProcessInfo] -> ShowS
SystemInfoGetProcessInfo -> String
(Int -> SystemInfoGetProcessInfo -> ShowS)
-> (SystemInfoGetProcessInfo -> String)
-> ([SystemInfoGetProcessInfo] -> ShowS)
-> Show SystemInfoGetProcessInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfoGetProcessInfo] -> ShowS
$cshowList :: [SystemInfoGetProcessInfo] -> ShowS
show :: SystemInfoGetProcessInfo -> String
$cshow :: SystemInfoGetProcessInfo -> String
showsPrec :: Int -> SystemInfoGetProcessInfo -> ShowS
$cshowsPrec :: Int -> SystemInfoGetProcessInfo -> ShowS
Show)
instance FromJSON SystemInfoGetProcessInfo where
  parseJSON :: Value -> Parser SystemInfoGetProcessInfo
parseJSON = String
-> (Object -> Parser SystemInfoGetProcessInfo)
-> Value
-> Parser SystemInfoGetProcessInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SystemInfoGetProcessInfo" ((Object -> Parser SystemInfoGetProcessInfo)
 -> Value -> Parser SystemInfoGetProcessInfo)
-> (Object -> Parser SystemInfoGetProcessInfo)
-> Value
-> Parser SystemInfoGetProcessInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> [SystemInfoProcessInfo] -> SystemInfoGetProcessInfo
SystemInfoGetProcessInfo
    ([SystemInfoProcessInfo] -> SystemInfoGetProcessInfo)
-> Parser [SystemInfoProcessInfo]
-> Parser SystemInfoGetProcessInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [SystemInfoProcessInfo]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"processInfo"
instance Command PSystemInfoGetProcessInfo where
  type CommandResponse PSystemInfoGetProcessInfo = SystemInfoGetProcessInfo
  commandName :: Proxy PSystemInfoGetProcessInfo -> String
commandName Proxy PSystemInfoGetProcessInfo
_ = String
"SystemInfo.getProcessInfo"