module Rattletrap.Type.Attribute.ExtendedExplosion where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.Explosion as Explosion
import qualified Rattletrap.Type.Attribute.FlaggedInt as FlaggedInt
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data ExtendedExplosion = ExtendedExplosion
  { ExtendedExplosion -> Explosion
explosion :: Explosion.Explosion,
    ExtendedExplosion -> FlaggedInt
unknown :: FlaggedInt.FlaggedInt
  }
  deriving (ExtendedExplosion -> ExtendedExplosion -> Bool
(ExtendedExplosion -> ExtendedExplosion -> Bool)
-> (ExtendedExplosion -> ExtendedExplosion -> Bool)
-> Eq ExtendedExplosion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtendedExplosion -> ExtendedExplosion -> Bool
== :: ExtendedExplosion -> ExtendedExplosion -> Bool
$c/= :: ExtendedExplosion -> ExtendedExplosion -> Bool
/= :: ExtendedExplosion -> ExtendedExplosion -> Bool
Eq, Int -> ExtendedExplosion -> ShowS
[ExtendedExplosion] -> ShowS
ExtendedExplosion -> String
(Int -> ExtendedExplosion -> ShowS)
-> (ExtendedExplosion -> String)
-> ([ExtendedExplosion] -> ShowS)
-> Show ExtendedExplosion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtendedExplosion -> ShowS
showsPrec :: Int -> ExtendedExplosion -> ShowS
$cshow :: ExtendedExplosion -> String
show :: ExtendedExplosion -> String
$cshowList :: [ExtendedExplosion] -> ShowS
showList :: [ExtendedExplosion] -> ShowS
Show)

instance Json.FromJSON ExtendedExplosion where
  parseJSON :: Value -> Parser ExtendedExplosion
parseJSON = String
-> (Object -> Parser ExtendedExplosion)
-> Value
-> Parser ExtendedExplosion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"ExtendedExplosion" ((Object -> Parser ExtendedExplosion)
 -> Value -> Parser ExtendedExplosion)
-> (Object -> Parser ExtendedExplosion)
-> Value
-> Parser ExtendedExplosion
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Explosion
explosion <- Object -> String -> Parser Explosion
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"explosion"
    FlaggedInt
unknown <- Object -> String -> Parser FlaggedInt
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unknown"
    ExtendedExplosion -> Parser ExtendedExplosion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtendedExplosion {Explosion
explosion :: Explosion
explosion :: Explosion
explosion, FlaggedInt
unknown :: FlaggedInt
unknown :: FlaggedInt
unknown}

instance Json.ToJSON ExtendedExplosion where
  toJSON :: ExtendedExplosion -> Value
toJSON ExtendedExplosion
x =
    [(Key, Value)] -> Value
Json.object
      [String -> Explosion -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"explosion" (Explosion -> (Key, Value)) -> Explosion -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ExtendedExplosion -> Explosion
explosion ExtendedExplosion
x, String -> FlaggedInt -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown" (FlaggedInt -> (Key, Value)) -> FlaggedInt -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ExtendedExplosion -> FlaggedInt
unknown ExtendedExplosion
x]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-extended-explosion" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"explosion" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Explosion.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
FlaggedInt.schema, Bool
True)
      ]

bitPut :: ExtendedExplosion -> BitPut.BitPut
bitPut :: ExtendedExplosion -> BitPut
bitPut ExtendedExplosion
x = Explosion -> BitPut
Explosion.bitPut (ExtendedExplosion -> Explosion
explosion ExtendedExplosion
x) BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> FlaggedInt -> BitPut
FlaggedInt.bitPut (ExtendedExplosion -> FlaggedInt
unknown ExtendedExplosion
x)

bitGet :: Version.Version -> BitGet.BitGet ExtendedExplosion
bitGet :: Version -> BitGet ExtendedExplosion
bitGet Version
version = String -> BitGet ExtendedExplosion -> BitGet ExtendedExplosion
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"ExtendedExplosion" (BitGet ExtendedExplosion -> BitGet ExtendedExplosion)
-> BitGet ExtendedExplosion -> BitGet ExtendedExplosion
forall a b. (a -> b) -> a -> b
$ do
  Explosion
explosion <- String -> BitGet Explosion -> BitGet Explosion
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"explosion" (BitGet Explosion -> BitGet Explosion)
-> BitGet Explosion -> BitGet Explosion
forall a b. (a -> b) -> a -> b
$ Version -> BitGet Explosion
Explosion.bitGet Version
version
  FlaggedInt
unknown <- String -> BitGet FlaggedInt -> BitGet FlaggedInt
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"unknown" BitGet FlaggedInt
FlaggedInt.bitGet
  ExtendedExplosion -> BitGet ExtendedExplosion
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtendedExplosion {Explosion
explosion :: Explosion
explosion :: Explosion
explosion, FlaggedInt
unknown :: FlaggedInt
unknown :: FlaggedInt
unknown}