module Patrol.Type.DebugMeta where
import qualified Data.Aeson as Aeson
import qualified Patrol.Extra.Aeson as Aeson
import qualified Patrol.Type.DebugImage as DebugImage
import qualified Patrol.Type.SystemSdkInfo as SystemSdkInfo
data DebugMeta = DebugMeta
{ DebugMeta -> [DebugImage]
images :: [DebugImage.DebugImage],
DebugMeta -> Maybe SystemSdkInfo
sdkInfo :: Maybe SystemSdkInfo.SystemSdkInfo
}
deriving (DebugMeta -> DebugMeta -> Bool
(DebugMeta -> DebugMeta -> Bool)
-> (DebugMeta -> DebugMeta -> Bool) -> Eq DebugMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DebugMeta -> DebugMeta -> Bool
== :: DebugMeta -> DebugMeta -> Bool
$c/= :: DebugMeta -> DebugMeta -> Bool
/= :: DebugMeta -> DebugMeta -> Bool
Eq, Int -> DebugMeta -> ShowS
[DebugMeta] -> ShowS
DebugMeta -> String
(Int -> DebugMeta -> ShowS)
-> (DebugMeta -> String)
-> ([DebugMeta] -> ShowS)
-> Show DebugMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugMeta -> ShowS
showsPrec :: Int -> DebugMeta -> ShowS
$cshow :: DebugMeta -> String
show :: DebugMeta -> String
$cshowList :: [DebugMeta] -> ShowS
showList :: [DebugMeta] -> ShowS
Show)
instance Aeson.ToJSON DebugMeta where
toJSON :: DebugMeta -> Value
toJSON DebugMeta
debugMeta =
[Pair] -> Value
Aeson.intoObject
[ String -> [DebugImage] -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"images" ([DebugImage] -> Pair) -> [DebugImage] -> Pair
forall a b. (a -> b) -> a -> b
$ DebugMeta -> [DebugImage]
images DebugMeta
debugMeta,
String -> Maybe SystemSdkInfo -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"sdk_info" (Maybe SystemSdkInfo -> Pair) -> Maybe SystemSdkInfo -> Pair
forall a b. (a -> b) -> a -> b
$ DebugMeta -> Maybe SystemSdkInfo
sdkInfo DebugMeta
debugMeta
]
empty :: DebugMeta
empty :: DebugMeta
empty =
DebugMeta
{ images :: [DebugImage]
images = [],
sdkInfo :: Maybe SystemSdkInfo
sdkInfo = Maybe SystemSdkInfo
forall a. Maybe a
Nothing
}