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
    Bool
unknown <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unknown"
    Str
name <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"name"
    FlaggedInt
target <- Object -> String -> Parser FlaggedInt
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"target"
    U32
value <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"value"
    RepStatTitle -> Parser RepStatTitle
forall a. a -> Parser a
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
      [ 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
  Bool
unknown <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"unknown" BitGet Bool
BitGet.bool
  Str
name <- String -> BitGet Str -> BitGet Str
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"name" BitGet Str
Str.bitGet
  FlaggedInt
target <- String -> BitGet FlaggedInt -> BitGet FlaggedInt
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"target" BitGet FlaggedInt
FlaggedInt.bitGet
  U32
value <- String -> BitGet U32 -> BitGet U32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet U32
U32.bitGet
  RepStatTitle -> BitGet RepStatTitle
forall a. a -> Get BitString Identity a
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}