module Rattletrap.Type.Attribute.CustomDemolish where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.Demolish as Demolish
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data CustomDemolish = CustomDemolish
  { CustomDemolish -> Bool
flag :: Bool,
    CustomDemolish -> I32
id :: I32.I32,
    CustomDemolish -> Demolish
demolish :: Demolish.Demolish
  }
  deriving (CustomDemolish -> CustomDemolish -> Bool
(CustomDemolish -> CustomDemolish -> Bool)
-> (CustomDemolish -> CustomDemolish -> Bool) -> Eq CustomDemolish
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomDemolish -> CustomDemolish -> Bool
== :: CustomDemolish -> CustomDemolish -> Bool
$c/= :: CustomDemolish -> CustomDemolish -> Bool
/= :: CustomDemolish -> CustomDemolish -> Bool
Eq, Int -> CustomDemolish -> ShowS
[CustomDemolish] -> ShowS
CustomDemolish -> String
(Int -> CustomDemolish -> ShowS)
-> (CustomDemolish -> String)
-> ([CustomDemolish] -> ShowS)
-> Show CustomDemolish
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomDemolish -> ShowS
showsPrec :: Int -> CustomDemolish -> ShowS
$cshow :: CustomDemolish -> String
show :: CustomDemolish -> String
$cshowList :: [CustomDemolish] -> ShowS
showList :: [CustomDemolish] -> ShowS
Show)

instance Json.FromJSON CustomDemolish where
  parseJSON :: Value -> Parser CustomDemolish
parseJSON = String
-> (Object -> Parser CustomDemolish)
-> Value
-> Parser CustomDemolish
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"CustomDemolish" ((Object -> Parser CustomDemolish)
 -> Value -> Parser CustomDemolish)
-> (Object -> Parser CustomDemolish)
-> Value
-> Parser CustomDemolish
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
flag <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flag"
    I32
id_ <- Object -> String -> Parser I32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"id"
    Demolish
demolish <- Object -> String -> Parser Demolish
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"demolish"
    CustomDemolish -> Parser CustomDemolish
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CustomDemolish {Bool
flag :: Bool
flag :: Bool
flag, id :: I32
Rattletrap.Type.Attribute.CustomDemolish.id = I32
id_, Demolish
demolish :: Demolish
demolish :: Demolish
demolish}

instance Json.ToJSON CustomDemolish where
  toJSON :: CustomDemolish -> Value
toJSON CustomDemolish
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"flag" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ CustomDemolish -> Bool
flag CustomDemolish
x,
        String -> I32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"id" (I32 -> (Key, Value)) -> I32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ CustomDemolish -> I32
Rattletrap.Type.Attribute.CustomDemolish.id CustomDemolish
x,
        String -> Demolish -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"demolish" (Demolish -> (Key, Value)) -> Demolish -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ CustomDemolish -> Demolish
demolish CustomDemolish
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-custom-demolish" (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
"flag" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
I32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"demolish" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Demolish.schema, Bool
True)
      ]

bitPut :: CustomDemolish -> BitPut.BitPut
bitPut :: CustomDemolish -> BitPut
bitPut CustomDemolish
x =
  Bool -> BitPut
BitPut.bool (CustomDemolish -> Bool
flag CustomDemolish
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> I32 -> BitPut
I32.bitPut (CustomDemolish -> I32
Rattletrap.Type.Attribute.CustomDemolish.id CustomDemolish
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Demolish -> BitPut
Demolish.bitPut (CustomDemolish -> Demolish
demolish CustomDemolish
x)

bitGet :: Version.Version -> BitGet.BitGet CustomDemolish
bitGet :: Version -> BitGet CustomDemolish
bitGet Version
version = String -> BitGet CustomDemolish -> BitGet CustomDemolish
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"CustomDemolish" (BitGet CustomDemolish -> BitGet CustomDemolish)
-> BitGet CustomDemolish -> BitGet CustomDemolish
forall a b. (a -> b) -> a -> b
$ do
  Bool
flag <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"flag" BitGet Bool
BitGet.bool
  I32
id_ <- String -> BitGet I32 -> BitGet I32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"id" BitGet I32
I32.bitGet
  Demolish
demolish <- String -> BitGet Demolish -> BitGet Demolish
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"demolish" (BitGet Demolish -> BitGet Demolish)
-> BitGet Demolish -> BitGet Demolish
forall a b. (a -> b) -> a -> b
$ Version -> BitGet Demolish
Demolish.bitGet Version
version
  CustomDemolish -> BitGet CustomDemolish
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    CustomDemolish
      { Bool
flag :: Bool
flag :: Bool
flag,
        id :: I32
Rattletrap.Type.Attribute.CustomDemolish.id = I32
id_,
        Demolish
demolish :: Demolish
demolish :: Demolish
demolish
      }