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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomDemolish -> CustomDemolish -> Bool
$c/= :: CustomDemolish -> CustomDemolish -> Bool
== :: CustomDemolish -> CustomDemolish -> Bool
$c== :: CustomDemolish -> CustomDemolish -> Bool
Eq, Int -> CustomDemolish -> ShowS
[CustomDemolish] -> ShowS
CustomDemolish -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomDemolish] -> ShowS
$cshowList :: [CustomDemolish] -> ShowS
show :: CustomDemolish -> String
$cshow :: CustomDemolish -> String
showsPrec :: Int -> CustomDemolish -> ShowS
$cshowsPrec :: Int -> CustomDemolish -> ShowS
Show)

instance Json.FromJSON CustomDemolish where
  parseJSON :: Value -> Parser CustomDemolish
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"CustomDemolish" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
flag <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flag"
    I32
id_ <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"id"
    Demolish
demolish <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"demolish"
    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
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flag" forall a b. (a -> b) -> a -> b
$ CustomDemolish -> Bool
flag CustomDemolish
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" forall a b. (a -> b) -> a -> b
$ CustomDemolish -> I32
Rattletrap.Type.Attribute.CustomDemolish.id CustomDemolish
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"demolish" 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" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flag" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
I32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"demolish" 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)
    forall a. Semigroup a => a -> a -> a
<> I32 -> BitPut
I32.bitPut (CustomDemolish -> I32
Rattletrap.Type.Attribute.CustomDemolish.id CustomDemolish
x)
    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 = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"CustomDemolish" forall a b. (a -> b) -> a -> b
$ do
  Bool
flag <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"flag" BitGet Bool
BitGet.bool
  I32
id_ <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"id" BitGet I32
I32.bitGet
  Demolish
demolish <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"demolish" forall a b. (a -> b) -> a -> b
$ Version -> BitGet Demolish
Demolish.bitGet Version
version
  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
      }