module Rattletrap.Type.Attribute.RepStatTitle where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.FlaggedInt as FlaggedInt
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Json as Json

data RepStatTitle = RepStatTitle
  { RepStatTitle -> Bool
unknown :: Bool,
    RepStatTitle -> Str
name :: Str.Str,
    RepStatTitle -> FlaggedInt
target :: FlaggedInt.FlaggedInt,
    RepStatTitle -> U32
value :: U32.U32
  }
  deriving (RepStatTitle -> RepStatTitle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepStatTitle -> RepStatTitle -> Bool
$c/= :: RepStatTitle -> RepStatTitle -> Bool
== :: RepStatTitle -> RepStatTitle -> Bool
$c== :: RepStatTitle -> RepStatTitle -> Bool
Eq, Int -> RepStatTitle -> ShowS
[RepStatTitle] -> ShowS
RepStatTitle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepStatTitle] -> ShowS
$cshowList :: [RepStatTitle] -> ShowS
show :: RepStatTitle -> String
$cshow :: RepStatTitle -> String
showsPrec :: Int -> RepStatTitle -> ShowS
$cshowsPrec :: Int -> RepStatTitle -> ShowS
Show)

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

instance Json.ToJSON RepStatTitle where
  toJSON :: RepStatTitle -> Value
toJSON RepStatTitle
x =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown" forall a b. (a -> b) -> a -> b
$ RepStatTitle -> Bool
unknown RepStatTitle
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" forall a b. (a -> b) -> a -> b
$ RepStatTitle -> Str
name RepStatTitle
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"target" forall a b. (a -> b) -> a -> b
$ RepStatTitle -> FlaggedInt
target RepStatTitle
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" forall a b. (a -> b) -> a -> b
$ RepStatTitle -> U32
value RepStatTitle
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-rep-stat-title" 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
"unknown" 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
"name" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"target" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
FlaggedInt.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
      ]

bitPut :: RepStatTitle -> BitPut.BitPut
bitPut :: RepStatTitle -> BitPut
bitPut RepStatTitle
x =
  Bool -> BitPut
BitPut.bool (RepStatTitle -> Bool
unknown RepStatTitle
x)
    forall a. Semigroup a => a -> a -> a
<> Str -> BitPut
Str.bitPut (RepStatTitle -> Str
name RepStatTitle
x)
    forall a. Semigroup a => a -> a -> a
<> FlaggedInt -> BitPut
FlaggedInt.bitPut (RepStatTitle -> FlaggedInt
target RepStatTitle
x)
    forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (RepStatTitle -> U32
value RepStatTitle
x)

bitGet :: BitGet.BitGet RepStatTitle
bitGet :: BitGet RepStatTitle
bitGet = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"RepStatTitle" forall a b. (a -> b) -> a -> b
$ do
  Bool
unknown <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"unknown" BitGet Bool
BitGet.bool
  Str
name <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"name" BitGet Str
Str.bitGet
  FlaggedInt
target <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"target" BitGet FlaggedInt
FlaggedInt.bitGet
  U32
value <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet U32
U32.bitGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure RepStatTitle {Bool
unknown :: Bool
unknown :: Bool
unknown, Str
name :: Str
name :: Str
name, FlaggedInt
target :: FlaggedInt
target :: FlaggedInt
target, U32
value :: U32
value :: U32
value}