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

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

instance Json.ToJSON RepStatTitle where
  toJSON :: RepStatTitle -> Value
toJSON RepStatTitle
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
"unknown" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RepStatTitle -> Bool
unknown RepStatTitle
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RepStatTitle -> Str
name RepStatTitle
x,
        String -> FlaggedInt -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"target" (FlaggedInt -> (Key, Value)) -> FlaggedInt -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RepStatTitle -> FlaggedInt
target RepStatTitle
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"value" (U32 -> (Key, Value)) -> U32 -> (Key, 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" (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
"unknown" (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
"name" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"target" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
FlaggedInt.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"value" (Value -> (Key, Value)) -> Value -> (Key, 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)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Str -> BitPut
Str.bitPut (RepStatTitle -> Str
name RepStatTitle
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> FlaggedInt -> BitPut
FlaggedInt.bitPut (RepStatTitle -> FlaggedInt
target RepStatTitle
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (RepStatTitle -> U32
value RepStatTitle
x)

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