{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
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
data SystemInfoGPUDevice = SystemInfoGPUDevice
{
SystemInfoGPUDevice -> Double
systemInfoGPUDeviceVendorId :: Double,
SystemInfoGPUDevice -> Double
systemInfoGPUDeviceDeviceId :: Double,
SystemInfoGPUDevice -> Maybe Double
systemInfoGPUDeviceSubSysId :: Maybe Double,
SystemInfoGPUDevice -> Maybe Double
systemInfoGPUDeviceRevision :: Maybe Double,
SystemInfoGPUDevice -> Text
systemInfoGPUDeviceVendorString :: T.Text,
SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDeviceString :: T.Text,
SystemInfoGPUDevice -> Text
systemInfoGPUDeviceDriverVendor :: T.Text,
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)
]
data SystemInfoSize = SystemInfoSize
{
SystemInfoSize -> Int
systemInfoSizeWidth :: Int,
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)
]
data SystemInfoVideoDecodeAcceleratorCapability = SystemInfoVideoDecodeAcceleratorCapability
{
SystemInfoVideoDecodeAcceleratorCapability -> Text
systemInfoVideoDecodeAcceleratorCapabilityProfile :: T.Text,
SystemInfoVideoDecodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoDecodeAcceleratorCapabilityMaxResolution :: SystemInfoSize,
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)
]
data SystemInfoVideoEncodeAcceleratorCapability = SystemInfoVideoEncodeAcceleratorCapability
{
SystemInfoVideoEncodeAcceleratorCapability -> Text
systemInfoVideoEncodeAcceleratorCapabilityProfile :: T.Text,
SystemInfoVideoEncodeAcceleratorCapability -> SystemInfoSize
systemInfoVideoEncodeAcceleratorCapabilityMaxResolution :: SystemInfoSize,
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)
]
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"
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"
data SystemInfoImageDecodeAcceleratorCapability = SystemInfoImageDecodeAcceleratorCapability
{
SystemInfoImageDecodeAcceleratorCapability -> SystemInfoImageType
systemInfoImageDecodeAcceleratorCapabilityImageType :: SystemInfoImageType,
SystemInfoImageDecodeAcceleratorCapability -> SystemInfoSize
systemInfoImageDecodeAcceleratorCapabilityMaxDimensions :: SystemInfoSize,
SystemInfoImageDecodeAcceleratorCapability -> SystemInfoSize
systemInfoImageDecodeAcceleratorCapabilityMinDimensions :: SystemInfoSize,
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)
]
data SystemInfoGPUInfo = SystemInfoGPUInfo
{
SystemInfoGPUInfo -> [SystemInfoGPUDevice]
systemInfoGPUInfoDevices :: [SystemInfoGPUDevice],
SystemInfoGPUInfo -> Maybe [(Text, Text)]
systemInfoGPUInfoAuxAttributes :: Maybe [(T.Text, T.Text)],
SystemInfoGPUInfo -> Maybe [(Text, Text)]
systemInfoGPUInfoFeatureStatus :: Maybe [(T.Text, T.Text)],
SystemInfoGPUInfo -> [Text]
systemInfoGPUInfoDriverBugWorkarounds :: [T.Text],
SystemInfoGPUInfo -> [SystemInfoVideoDecodeAcceleratorCapability]
systemInfoGPUInfoVideoDecoding :: [SystemInfoVideoDecodeAcceleratorCapability],
SystemInfoGPUInfo -> [SystemInfoVideoEncodeAcceleratorCapability]
systemInfoGPUInfoVideoEncoding :: [SystemInfoVideoEncodeAcceleratorCapability],
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)
]
data SystemInfoProcessInfo = SystemInfoProcessInfo
{
SystemInfoProcessInfo -> Text
systemInfoProcessInfoType :: T.Text,
SystemInfoProcessInfo -> Int
systemInfoProcessInfoId :: Int,
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)
]
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
{
SystemInfoGetInfo -> SystemInfoGPUInfo
systemInfoGetInfoGpu :: SystemInfoGPUInfo,
SystemInfoGetInfo -> Text
systemInfoGetInfoModelName :: T.Text,
SystemInfoGetInfo -> Text
systemInfoGetInfoModelVersion :: T.Text,
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"
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
{
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"