module Patrol.Type.DebugImage where

import qualified Data.Aeson as Aeson
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Patrol.Type.AppleDebugImage as AppleDebugImage
import qualified Patrol.Type.NativeDebugImage as NativeDebugImage
import qualified Patrol.Type.ProguardDebugImage as ProguardDebugImage

data DebugImage
  = Apple AppleDebugImage.AppleDebugImage
  | Native NativeDebugImage.NativeDebugImage
  | Proguard ProguardDebugImage.ProguardDebugImage
  | Other (Map.Map Text.Text Aeson.Value)
  deriving (DebugImage -> DebugImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugImage -> DebugImage -> Bool
$c/= :: DebugImage -> DebugImage -> Bool
== :: DebugImage -> DebugImage -> Bool
$c== :: DebugImage -> DebugImage -> Bool
Eq, Int -> DebugImage -> ShowS
[DebugImage] -> ShowS
DebugImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugImage] -> ShowS
$cshowList :: [DebugImage] -> ShowS
show :: DebugImage -> String
$cshow :: DebugImage -> String
showsPrec :: Int -> DebugImage -> ShowS
$cshowsPrec :: Int -> DebugImage -> ShowS
Show)

instance Aeson.ToJSON DebugImage where
  toJSON :: DebugImage -> Value
toJSON DebugImage
debugImage = case DebugImage
debugImage of
    Apple AppleDebugImage
appleDebugImage -> forall a. ToJSON a => a -> Value
Aeson.toJSON AppleDebugImage
appleDebugImage
    Native NativeDebugImage
nativeDebugImage -> forall a. ToJSON a => a -> Value
Aeson.toJSON NativeDebugImage
nativeDebugImage
    Proguard ProguardDebugImage
proguardDebugImage -> forall a. ToJSON a => a -> Value
Aeson.toJSON ProguardDebugImage
proguardDebugImage
    Other Map Text Value
other -> forall a. ToJSON a => a -> Value
Aeson.toJSON Map Text Value
other