module Rattletrap.Type.AttributeValue where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Data as Data
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.AppliedDamage as AppliedDamage
import qualified Rattletrap.Type.Attribute.Boolean as Boolean
import qualified Rattletrap.Type.Attribute.Byte as Byte
import qualified Rattletrap.Type.Attribute.CamSettings as CamSettings
import qualified Rattletrap.Type.Attribute.ClubColors as ClubColors
import qualified Rattletrap.Type.Attribute.CustomDemolish as CustomDemolish
import qualified Rattletrap.Type.Attribute.DamageState as DamageState
import qualified Rattletrap.Type.Attribute.Demolish as Demolish
import qualified Rattletrap.Type.Attribute.Enum as Enum
import qualified Rattletrap.Type.Attribute.Explosion as Explosion
import qualified Rattletrap.Type.Attribute.ExtendedExplosion as ExtendedExplosion
import qualified Rattletrap.Type.Attribute.FlaggedByte as FlaggedByte
import qualified Rattletrap.Type.Attribute.FlaggedInt as FlaggedInt
import qualified Rattletrap.Type.Attribute.Float as Float
import qualified Rattletrap.Type.Attribute.GameMode as GameMode
import qualified Rattletrap.Type.Attribute.Int as Int
import qualified Rattletrap.Type.Attribute.Int64 as Int64
import qualified Rattletrap.Type.Attribute.Loadout as Loadout
import qualified Rattletrap.Type.Attribute.LoadoutOnline as LoadoutOnline
import qualified Rattletrap.Type.Attribute.Loadouts as Loadouts
import qualified Rattletrap.Type.Attribute.LoadoutsOnline as LoadoutsOnline
import qualified Rattletrap.Type.Attribute.Location as Location
import qualified Rattletrap.Type.Attribute.MusicStinger as MusicStinger
import qualified Rattletrap.Type.Attribute.PartyLeader as PartyLeader
import qualified Rattletrap.Type.Attribute.Pickup as Pickup
import qualified Rattletrap.Type.Attribute.PickupNew as PickupNew
import qualified Rattletrap.Type.Attribute.PlayerHistoryKey as PlayerHistoryKey
import qualified Rattletrap.Type.Attribute.PrivateMatchSettings as PrivateMatchSettings
import qualified Rattletrap.Type.Attribute.QWord as QWord
import qualified Rattletrap.Type.Attribute.Reservation as Reservation
import qualified Rattletrap.Type.Attribute.RigidBodyState as RigidBodyState
import qualified Rattletrap.Type.Attribute.StatEvent as StatEvent
import qualified Rattletrap.Type.Attribute.String as String
import qualified Rattletrap.Type.Attribute.TeamPaint as TeamPaint
import qualified Rattletrap.Type.Attribute.Title as Title
import qualified Rattletrap.Type.Attribute.UniqueId as UniqueId
import qualified Rattletrap.Type.Attribute.WeldedInfo as WeldedInfo
import qualified Rattletrap.Type.AttributeType as AttributeType
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

import qualified Data.Foldable as Foldable
import qualified Data.Map as Map

data AttributeValue
  = AppliedDamage AppliedDamage.AppliedDamage
  | Boolean Boolean.Boolean
  | Byte Byte.Byte
  | CamSettings CamSettings.CamSettings
  | ClubColors ClubColors.ClubColors
  | CustomDemolish CustomDemolish.CustomDemolish
  | DamageState DamageState.DamageState
  | Demolish Demolish.Demolish
  | Enum Enum.Enum
  | Explosion Explosion.Explosion
  | ExtendedExplosion ExtendedExplosion.ExtendedExplosion
  | FlaggedInt FlaggedInt.FlaggedInt
  | FlaggedByte FlaggedByte.FlaggedByte
  | Float Float.Float
  | GameMode GameMode.GameMode
  | Int Int.Int
  | Int64 Int64.Int64
  | Loadout Loadout.Loadout
  | LoadoutOnline LoadoutOnline.LoadoutOnline
  | Loadouts Loadouts.Loadouts
  | LoadoutsOnline LoadoutsOnline.LoadoutsOnline
  | Location Location.Location
  | MusicStinger MusicStinger.MusicStinger
  | PartyLeader PartyLeader.PartyLeader
  | Pickup Pickup.Pickup
  | PickupNew PickupNew.PickupNew
  | PlayerHistoryKey PlayerHistoryKey.PlayerHistoryKey
  | PrivateMatchSettings PrivateMatchSettings.PrivateMatchSettings
  | QWord QWord.QWord
  | Reservation Reservation.Reservation
  | RigidBodyState RigidBodyState.RigidBodyState
  | StatEvent StatEvent.StatEvent
  | String String.String
  | TeamPaint TeamPaint.TeamPaint
  | Title Title.Title
  | UniqueId UniqueId.UniqueId
  | WeldedInfo WeldedInfo.WeldedInfo
  deriving (AttributeValue -> AttributeValue -> Bool
(AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> Bool) -> Eq AttributeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValue -> AttributeValue -> Bool
$c/= :: AttributeValue -> AttributeValue -> Bool
== :: AttributeValue -> AttributeValue -> Bool
$c== :: AttributeValue -> AttributeValue -> Bool
Eq, Int -> AttributeValue -> ShowS
[AttributeValue] -> ShowS
AttributeValue -> String
(Int -> AttributeValue -> ShowS)
-> (AttributeValue -> String)
-> ([AttributeValue] -> ShowS)
-> Show AttributeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValue] -> ShowS
$cshowList :: [AttributeValue] -> ShowS
show :: AttributeValue -> String
$cshow :: AttributeValue -> String
showsPrec :: Int -> AttributeValue -> ShowS
$cshowsPrec :: Int -> AttributeValue -> ShowS
Show)

instance Json.FromJSON AttributeValue where
  parseJSON :: Value -> Parser AttributeValue
parseJSON = String
-> (Object -> Parser AttributeValue)
-> Value
-> Parser AttributeValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"AttributeValue" ((Object -> Parser AttributeValue)
 -> Value -> Parser AttributeValue)
-> (Object -> Parser AttributeValue)
-> Value
-> Parser AttributeValue
forall a b. (a -> b) -> a -> b
$ \Object
object -> [Parser AttributeValue] -> Parser AttributeValue
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ AppliedDamage -> AttributeValue
AppliedDamage (AppliedDamage -> AttributeValue)
-> Parser AppliedDamage -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser AppliedDamage
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"applied_damage"
    , Boolean -> AttributeValue
Boolean (Boolean -> AttributeValue)
-> Parser Boolean -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Boolean
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"boolean"
    , Byte -> AttributeValue
Byte (Byte -> AttributeValue) -> Parser Byte -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Byte
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"byte"
    , CamSettings -> AttributeValue
CamSettings (CamSettings -> AttributeValue)
-> Parser CamSettings -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser CamSettings
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"cam_settings"
    , ClubColors -> AttributeValue
ClubColors (ClubColors -> AttributeValue)
-> Parser ClubColors -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser ClubColors
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"club_colors"
    , CustomDemolish -> AttributeValue
CustomDemolish (CustomDemolish -> AttributeValue)
-> Parser CustomDemolish -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser CustomDemolish
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"custom_demolish"
    , DamageState -> AttributeValue
DamageState (DamageState -> AttributeValue)
-> Parser DamageState -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser DamageState
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"damage_state"
    , Demolish -> AttributeValue
Demolish (Demolish -> AttributeValue)
-> Parser Demolish -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Demolish
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"demolish"
    , Enum -> AttributeValue
Enum (Enum -> AttributeValue) -> Parser Enum -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Enum
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"enum"
    , Explosion -> AttributeValue
Explosion (Explosion -> AttributeValue)
-> Parser Explosion -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Explosion
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"explosion"
    , ExtendedExplosion -> AttributeValue
ExtendedExplosion (ExtendedExplosion -> AttributeValue)
-> Parser ExtendedExplosion -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser ExtendedExplosion
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"extended_explosion"
    , FlaggedByte -> AttributeValue
FlaggedByte (FlaggedByte -> AttributeValue)
-> Parser FlaggedByte -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser FlaggedByte
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flagged_byte"
    , FlaggedInt -> AttributeValue
FlaggedInt (FlaggedInt -> AttributeValue)
-> Parser FlaggedInt -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser FlaggedInt
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flagged_int"
    , Float -> AttributeValue
Float (Float -> AttributeValue) -> Parser Float -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Float
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"float"
    , GameMode -> AttributeValue
GameMode (GameMode -> AttributeValue)
-> Parser GameMode -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser GameMode
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"game_mode"
    , Int -> AttributeValue
Int (Int -> AttributeValue) -> Parser Int -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Int
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int"
    , Int64 -> AttributeValue
Int64 (Int64 -> AttributeValue) -> Parser Int64 -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Int64
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int64"
    , Loadout -> AttributeValue
Loadout (Loadout -> AttributeValue)
-> Parser Loadout -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Loadout
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadout"
    , LoadoutOnline -> AttributeValue
LoadoutOnline (LoadoutOnline -> AttributeValue)
-> Parser LoadoutOnline -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser LoadoutOnline
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadout_online"
    , Loadouts -> AttributeValue
Loadouts (Loadouts -> AttributeValue)
-> Parser Loadouts -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Loadouts
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadouts"
    , LoadoutsOnline -> AttributeValue
LoadoutsOnline (LoadoutsOnline -> AttributeValue)
-> Parser LoadoutsOnline -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser LoadoutsOnline
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadouts_online"
    , Location -> AttributeValue
Location (Location -> AttributeValue)
-> Parser Location -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Location
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"location"
    , MusicStinger -> AttributeValue
MusicStinger (MusicStinger -> AttributeValue)
-> Parser MusicStinger -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser MusicStinger
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"music_stinger"
    , PartyLeader -> AttributeValue
PartyLeader (PartyLeader -> AttributeValue)
-> Parser PartyLeader -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser PartyLeader
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"party_leader"
    , Pickup -> AttributeValue
Pickup (Pickup -> AttributeValue)
-> Parser Pickup -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Pickup
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"pickup"
    , PickupNew -> AttributeValue
PickupNew (PickupNew -> AttributeValue)
-> Parser PickupNew -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser PickupNew
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"pickup_new"
    , PlayerHistoryKey -> AttributeValue
PlayerHistoryKey (PlayerHistoryKey -> AttributeValue)
-> Parser PlayerHistoryKey -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser PlayerHistoryKey
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"player_history_key"
    , PrivateMatchSettings -> AttributeValue
PrivateMatchSettings (PrivateMatchSettings -> AttributeValue)
-> Parser PrivateMatchSettings -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser PrivateMatchSettings
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"private_match_settings"
    , QWord -> AttributeValue
QWord (QWord -> AttributeValue) -> Parser QWord -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser QWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"q_word"
    , Reservation -> AttributeValue
Reservation (Reservation -> AttributeValue)
-> Parser Reservation -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Reservation
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"reservation"
    , RigidBodyState -> AttributeValue
RigidBodyState (RigidBodyState -> AttributeValue)
-> Parser RigidBodyState -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser RigidBodyState
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rigid_body_state"
    , StatEvent -> AttributeValue
StatEvent (StatEvent -> AttributeValue)
-> Parser StatEvent -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser StatEvent
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stat_event"
    , String -> AttributeValue
String (String -> AttributeValue)
-> Parser String -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser String
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"string"
    , TeamPaint -> AttributeValue
TeamPaint (TeamPaint -> AttributeValue)
-> Parser TeamPaint -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser TeamPaint
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"team_paint"
    , Title -> AttributeValue
Title (Title -> AttributeValue) -> Parser Title -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Title
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"title"
    , UniqueId -> AttributeValue
UniqueId (UniqueId -> AttributeValue)
-> Parser UniqueId -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser UniqueId
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unique_id"
    , WeldedInfo -> AttributeValue
WeldedInfo (WeldedInfo -> AttributeValue)
-> Parser WeldedInfo -> Parser AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser WeldedInfo
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"welded_info"
    ]

instance Json.ToJSON AttributeValue where
  toJSON :: AttributeValue -> Value
toJSON AttributeValue
x = case AttributeValue
x of
    AppliedDamage AppliedDamage
y -> [Pair] -> Value
Json.object [String -> AppliedDamage -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"applied_damage" AppliedDamage
y]
    Boolean Boolean
y -> [Pair] -> Value
Json.object [String -> Boolean -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"boolean" Boolean
y]
    Byte Byte
y -> [Pair] -> Value
Json.object [String -> Byte -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"byte" Byte
y]
    CamSettings CamSettings
y -> [Pair] -> Value
Json.object [String -> CamSettings -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"cam_settings" CamSettings
y]
    ClubColors ClubColors
y -> [Pair] -> Value
Json.object [String -> ClubColors -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"club_colors" ClubColors
y]
    CustomDemolish CustomDemolish
y -> [Pair] -> Value
Json.object [String -> CustomDemolish -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"custom_demolish" CustomDemolish
y]
    DamageState DamageState
y -> [Pair] -> Value
Json.object [String -> DamageState -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"damage_state" DamageState
y]
    Demolish Demolish
y -> [Pair] -> Value
Json.object [String -> Demolish -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"demolish" Demolish
y]
    Enum Enum
y -> [Pair] -> Value
Json.object [String -> Enum -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"enum" Enum
y]
    Explosion Explosion
y -> [Pair] -> Value
Json.object [String -> Explosion -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"explosion" Explosion
y]
    ExtendedExplosion ExtendedExplosion
y -> [Pair] -> Value
Json.object [String -> ExtendedExplosion -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"extended_explosion" ExtendedExplosion
y]
    FlaggedByte FlaggedByte
y -> [Pair] -> Value
Json.object [String -> FlaggedByte -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flagged_byte" FlaggedByte
y]
    FlaggedInt FlaggedInt
y -> [Pair] -> Value
Json.object [String -> FlaggedInt -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flagged_int" FlaggedInt
y]
    Float Float
y -> [Pair] -> Value
Json.object [String -> Float -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"float" Float
y]
    GameMode GameMode
y -> [Pair] -> Value
Json.object [String -> GameMode -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"game_mode" GameMode
y]
    Int Int
y -> [Pair] -> Value
Json.object [String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int" Int
y]
    Int64 Int64
y -> [Pair] -> Value
Json.object [String -> Int64 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int64" Int64
y]
    Loadout Loadout
y -> [Pair] -> Value
Json.object [String -> Loadout -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadout" Loadout
y]
    LoadoutOnline LoadoutOnline
y -> [Pair] -> Value
Json.object [String -> LoadoutOnline -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadout_online" LoadoutOnline
y]
    Loadouts Loadouts
y -> [Pair] -> Value
Json.object [String -> Loadouts -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadouts" Loadouts
y]
    LoadoutsOnline LoadoutsOnline
y -> [Pair] -> Value
Json.object [String -> LoadoutsOnline -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadouts_online" LoadoutsOnline
y]
    Location Location
y -> [Pair] -> Value
Json.object [String -> Location -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"location" Location
y]
    MusicStinger MusicStinger
y -> [Pair] -> Value
Json.object [String -> MusicStinger -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"music_stinger" MusicStinger
y]
    PartyLeader PartyLeader
y -> [Pair] -> Value
Json.object [String -> PartyLeader -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"party_leader" PartyLeader
y]
    Pickup Pickup
y -> [Pair] -> Value
Json.object [String -> Pickup -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"pickup" Pickup
y]
    PickupNew PickupNew
y -> [Pair] -> Value
Json.object [String -> PickupNew -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"pickup_new" PickupNew
y]
    PlayerHistoryKey PlayerHistoryKey
y -> [Pair] -> Value
Json.object [String -> PlayerHistoryKey -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"player_history_key" PlayerHistoryKey
y]
    PrivateMatchSettings PrivateMatchSettings
y ->
      [Pair] -> Value
Json.object [String -> PrivateMatchSettings -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"private_match_settings" PrivateMatchSettings
y]
    QWord QWord
y -> [Pair] -> Value
Json.object [String -> QWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"q_word" QWord
y]
    Reservation Reservation
y -> [Pair] -> Value
Json.object [String -> Reservation -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"reservation" Reservation
y]
    RigidBodyState RigidBodyState
y -> [Pair] -> Value
Json.object [String -> RigidBodyState -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rigid_body_state" RigidBodyState
y]
    StatEvent StatEvent
y -> [Pair] -> Value
Json.object [String -> StatEvent -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stat_event" StatEvent
y]
    String String
y -> [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"string" String
y]
    TeamPaint TeamPaint
y -> [Pair] -> Value
Json.object [String -> TeamPaint -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"team_paint" TeamPaint
y]
    Title Title
y -> [Pair] -> Value
Json.object [String -> Title -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"title" Title
y]
    UniqueId UniqueId
y -> [Pair] -> Value
Json.object [String -> UniqueId -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unique_id" UniqueId
y]
    WeldedInfo WeldedInfo
y -> [Pair] -> Value
Json.object [String -> WeldedInfo -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"welded_info" WeldedInfo
y]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-value" (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$ ((String, Schema) -> Value) -> [(String, Schema)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\(String
k, Schema
v) -> [(Pair, Bool)] -> Value
Schema.object [(String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
v, Bool
True)])
  [ (String
"applied_damage", Schema
AppliedDamage.schema)
  , (String
"boolean", Schema
Boolean.schema)
  , (String
"byte", Schema
Byte.schema)
  , (String
"cam_settings", Schema
CamSettings.schema)
  , (String
"club_colors", Schema
ClubColors.schema)
  , (String
"custom_demolish", Schema
CustomDemolish.schema)
  , (String
"damage_state", Schema
DamageState.schema)
  , (String
"demolish", Schema
Demolish.schema)
  , (String
"enum", Schema
Enum.schema)
  , (String
"explosion", Schema
Explosion.schema)
  , (String
"extended_explosion", Schema
ExtendedExplosion.schema)
  , (String
"flagged_byte", Schema
FlaggedByte.schema)
  , (String
"flagged_int", Schema
FlaggedInt.schema)
  , (String
"float", Schema
Float.schema)
  , (String
"game_mode", Schema
GameMode.schema)
  , (String
"int", Schema
Int.schema)
  , (String
"int64", Schema
Int64.schema)
  , (String
"loadout_online", Schema
LoadoutOnline.schema)
  , (String
"loadout", Schema
Loadout.schema)
  , (String
"loadouts_online", Schema
LoadoutsOnline.schema)
  , (String
"loadouts", Schema
Loadouts.schema)
  , (String
"location", Schema
Location.schema)
  , (String
"music_stinger", Schema
MusicStinger.schema)
  , (String
"party_leader", Schema
PartyLeader.schema)
  , (String
"pickup_new", Schema
PickupNew.schema)
  , (String
"pickup", Schema
Pickup.schema)
  , (String
"player_history_key", Schema
PlayerHistoryKey.schema)
  , (String
"private_match_settings", Schema
PrivateMatchSettings.schema)
  , (String
"q_word", Schema
QWord.schema)
  , (String
"reservation", Schema
Reservation.schema)
  , (String
"rigid_body_state", Schema
RigidBodyState.schema)
  , (String
"stat_event", Schema
StatEvent.schema)
  , (String
"string", Schema
String.schema)
  , (String
"team_paint", Schema
TeamPaint.schema)
  , (String
"title", Schema
Title.schema)
  , (String
"unique_id", Schema
UniqueId.schema)
  , (String
"welded_info", Schema
WeldedInfo.schema)
  ]

bitPut :: AttributeValue -> BitPut.BitPut
bitPut :: AttributeValue -> BitPut
bitPut AttributeValue
value = case AttributeValue
value of
  AppliedDamage AppliedDamage
x -> AppliedDamage -> BitPut
AppliedDamage.bitPut AppliedDamage
x
  Boolean Boolean
x -> Boolean -> BitPut
Boolean.bitPut Boolean
x
  Byte Byte
x -> Byte -> BitPut
Byte.bitPut Byte
x
  CamSettings CamSettings
x -> CamSettings -> BitPut
CamSettings.bitPut CamSettings
x
  ClubColors ClubColors
x -> ClubColors -> BitPut
ClubColors.bitPut ClubColors
x
  CustomDemolish CustomDemolish
x -> CustomDemolish -> BitPut
CustomDemolish.bitPut CustomDemolish
x
  DamageState DamageState
x -> DamageState -> BitPut
DamageState.bitPut DamageState
x
  Demolish Demolish
x -> Demolish -> BitPut
Demolish.bitPut Demolish
x
  Enum Enum
x -> Enum -> BitPut
Enum.bitPut Enum
x
  Explosion Explosion
x -> Explosion -> BitPut
Explosion.bitPut Explosion
x
  ExtendedExplosion ExtendedExplosion
x -> ExtendedExplosion -> BitPut
ExtendedExplosion.bitPut ExtendedExplosion
x
  FlaggedInt FlaggedInt
x -> FlaggedInt -> BitPut
FlaggedInt.bitPut FlaggedInt
x
  FlaggedByte FlaggedByte
x -> FlaggedByte -> BitPut
FlaggedByte.bitPut FlaggedByte
x
  Float Float
x -> Float -> BitPut
Float.bitPut Float
x
  GameMode GameMode
x -> GameMode -> BitPut
GameMode.bitPut GameMode
x
  Int Int
x -> Int -> BitPut
Int.bitPut Int
x
  Int64 Int64
x -> Int64 -> BitPut
Int64.putInt64Attribute Int64
x
  Loadout Loadout
x -> Loadout -> BitPut
Loadout.bitPut Loadout
x
  LoadoutOnline LoadoutOnline
x -> LoadoutOnline -> BitPut
LoadoutOnline.bitPut LoadoutOnline
x
  Loadouts Loadouts
x -> Loadouts -> BitPut
Loadouts.bitPut Loadouts
x
  LoadoutsOnline LoadoutsOnline
x -> LoadoutsOnline -> BitPut
LoadoutsOnline.bitPut LoadoutsOnline
x
  Location Location
x -> Location -> BitPut
Location.bitPut Location
x
  MusicStinger MusicStinger
x -> MusicStinger -> BitPut
MusicStinger.bitPut MusicStinger
x
  PartyLeader PartyLeader
x -> PartyLeader -> BitPut
PartyLeader.bitPut PartyLeader
x
  Pickup Pickup
x -> Pickup -> BitPut
Pickup.bitPut Pickup
x
  PickupNew PickupNew
x -> PickupNew -> BitPut
PickupNew.bitPut PickupNew
x
  PlayerHistoryKey PlayerHistoryKey
x -> PlayerHistoryKey -> BitPut
PlayerHistoryKey.bitPut PlayerHistoryKey
x
  PrivateMatchSettings PrivateMatchSettings
x -> PrivateMatchSettings -> BitPut
PrivateMatchSettings.bitPut PrivateMatchSettings
x
  QWord QWord
x -> QWord -> BitPut
QWord.bitPut QWord
x
  Reservation Reservation
x -> Reservation -> BitPut
Reservation.bitPut Reservation
x
  RigidBodyState RigidBodyState
x -> RigidBodyState -> BitPut
RigidBodyState.bitPut RigidBodyState
x
  StatEvent StatEvent
x -> StatEvent -> BitPut
StatEvent.bitPut StatEvent
x
  String String
x -> String -> BitPut
String.bitPut String
x
  TeamPaint TeamPaint
x -> TeamPaint -> BitPut
TeamPaint.bitPut TeamPaint
x
  Title Title
x -> Title -> BitPut
Title.bitPut Title
x
  UniqueId UniqueId
x -> UniqueId -> BitPut
UniqueId.bitPut UniqueId
x
  WeldedInfo WeldedInfo
x -> WeldedInfo -> BitPut
WeldedInfo.bitPut WeldedInfo
x

bitGet
  :: Version.Version
  -> Map.Map U32.U32 Str.Str
  -> Str.Str
  -> BitGet.BitGet AttributeValue
bitGet :: Version -> Map U32 Str -> Str -> BitGet AttributeValue
bitGet Version
version Map U32 Str
objectMap Str
name = do
  AttributeType
constructor <- BitGet AttributeType
-> (AttributeType -> BitGet AttributeType)
-> Maybe AttributeType
-> BitGet AttributeType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> BitGet AttributeType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT04] don't know how to get attribute value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Str -> String
forall a. Show a => a -> String
show Str
name))
    AttributeType -> BitGet AttributeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Text -> Map Text AttributeType -> Maybe AttributeType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Str -> Text
Str.toText Str
name) Map Text AttributeType
Data.attributeTypes)
  case AttributeType
constructor of
    AttributeType
AttributeType.AppliedDamage ->
      AppliedDamage -> AttributeValue
AppliedDamage (AppliedDamage -> AttributeValue)
-> BitGet AppliedDamage -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet AppliedDamage
AppliedDamage.bitGet Version
version
    AttributeType
AttributeType.Boolean -> Boolean -> AttributeValue
Boolean (Boolean -> AttributeValue)
-> BitGet Boolean -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Boolean
Boolean.bitGet
    AttributeType
AttributeType.Byte -> Byte -> AttributeValue
Byte (Byte -> AttributeValue) -> BitGet Byte -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Byte
Byte.bitGet
    AttributeType
AttributeType.CamSettings -> CamSettings -> AttributeValue
CamSettings (CamSettings -> AttributeValue)
-> BitGet CamSettings -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet CamSettings
CamSettings.bitGet Version
version
    AttributeType
AttributeType.ClubColors -> ClubColors -> AttributeValue
ClubColors (ClubColors -> AttributeValue)
-> BitGet ClubColors -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet ClubColors
ClubColors.bitGet
    AttributeType
AttributeType.CustomDemolish ->
      CustomDemolish -> AttributeValue
CustomDemolish (CustomDemolish -> AttributeValue)
-> BitGet CustomDemolish -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet CustomDemolish
CustomDemolish.bitGet Version
version
    AttributeType
AttributeType.DamageState -> DamageState -> AttributeValue
DamageState (DamageState -> AttributeValue)
-> BitGet DamageState -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet DamageState
DamageState.bitGet Version
version
    AttributeType
AttributeType.Demolish -> Demolish -> AttributeValue
Demolish (Demolish -> AttributeValue)
-> BitGet Demolish -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet Demolish
Demolish.bitGet Version
version
    AttributeType
AttributeType.Enum -> Enum -> AttributeValue
Enum (Enum -> AttributeValue) -> BitGet Enum -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Enum
Enum.bitGet
    AttributeType
AttributeType.Explosion -> Explosion -> AttributeValue
Explosion (Explosion -> AttributeValue)
-> BitGet Explosion -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet Explosion
Explosion.bitGet Version
version
    AttributeType
AttributeType.ExtendedExplosion ->
      ExtendedExplosion -> AttributeValue
ExtendedExplosion (ExtendedExplosion -> AttributeValue)
-> BitGet ExtendedExplosion -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet ExtendedExplosion
ExtendedExplosion.bitGet Version
version
    AttributeType
AttributeType.FlaggedInt -> FlaggedInt -> AttributeValue
FlaggedInt (FlaggedInt -> AttributeValue)
-> BitGet FlaggedInt -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet FlaggedInt
FlaggedInt.bitGet
    AttributeType
AttributeType.FlaggedByte -> FlaggedByte -> AttributeValue
FlaggedByte (FlaggedByte -> AttributeValue)
-> BitGet FlaggedByte -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet FlaggedByte
FlaggedByte.bitGet
    AttributeType
AttributeType.Float -> Float -> AttributeValue
Float (Float -> AttributeValue) -> BitGet Float -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Float
Float.bitGet
    AttributeType
AttributeType.GameMode -> GameMode -> AttributeValue
GameMode (GameMode -> AttributeValue)
-> BitGet GameMode -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet GameMode
GameMode.bitGet Version
version
    AttributeType
AttributeType.Int -> Int -> AttributeValue
Int (Int -> AttributeValue) -> BitGet Int -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Int
Int.bitGet
    AttributeType
AttributeType.Int64 -> Int64 -> AttributeValue
Int64 (Int64 -> AttributeValue) -> BitGet Int64 -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Int64
Int64.bitGet
    AttributeType
AttributeType.Loadout -> Loadout -> AttributeValue
Loadout (Loadout -> AttributeValue)
-> BitGet Loadout -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Loadout
Loadout.bitGet
    AttributeType
AttributeType.LoadoutOnline ->
      LoadoutOnline -> AttributeValue
LoadoutOnline (LoadoutOnline -> AttributeValue)
-> BitGet LoadoutOnline -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Map U32 Str -> BitGet LoadoutOnline
LoadoutOnline.bitGet Version
version Map U32 Str
objectMap
    AttributeType
AttributeType.Loadouts -> Loadouts -> AttributeValue
Loadouts (Loadouts -> AttributeValue)
-> BitGet Loadouts -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Loadouts
Loadouts.bitGet
    AttributeType
AttributeType.LoadoutsOnline ->
      LoadoutsOnline -> AttributeValue
LoadoutsOnline (LoadoutsOnline -> AttributeValue)
-> BitGet LoadoutsOnline -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Map U32 Str -> BitGet LoadoutsOnline
LoadoutsOnline.bitGet Version
version Map U32 Str
objectMap
    AttributeType
AttributeType.Location -> Location -> AttributeValue
Location (Location -> AttributeValue)
-> BitGet Location -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet Location
Location.bitGet Version
version
    AttributeType
AttributeType.MusicStinger -> MusicStinger -> AttributeValue
MusicStinger (MusicStinger -> AttributeValue)
-> BitGet MusicStinger -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet MusicStinger
MusicStinger.bitGet
    AttributeType
AttributeType.PartyLeader -> PartyLeader -> AttributeValue
PartyLeader (PartyLeader -> AttributeValue)
-> BitGet PartyLeader -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet PartyLeader
PartyLeader.bitGet Version
version
    AttributeType
AttributeType.Pickup -> Pickup -> AttributeValue
Pickup (Pickup -> AttributeValue)
-> BitGet Pickup -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Pickup
Pickup.bitGet
    AttributeType
AttributeType.PickupNew -> PickupNew -> AttributeValue
PickupNew (PickupNew -> AttributeValue)
-> BitGet PickupNew -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PickupNew
PickupNew.bitGet
    AttributeType
AttributeType.PlayerHistoryKey ->
      PlayerHistoryKey -> AttributeValue
PlayerHistoryKey (PlayerHistoryKey -> AttributeValue)
-> BitGet PlayerHistoryKey -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PlayerHistoryKey
PlayerHistoryKey.bitGet
    AttributeType
AttributeType.PrivateMatchSettings ->
      PrivateMatchSettings -> AttributeValue
PrivateMatchSettings (PrivateMatchSettings -> AttributeValue)
-> BitGet PrivateMatchSettings -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PrivateMatchSettings
PrivateMatchSettings.bitGet
    AttributeType
AttributeType.QWord -> QWord -> AttributeValue
QWord (QWord -> AttributeValue) -> BitGet QWord -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet QWord
QWord.bitGet
    AttributeType
AttributeType.Reservation -> Reservation -> AttributeValue
Reservation (Reservation -> AttributeValue)
-> BitGet Reservation -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet Reservation
Reservation.bitGet Version
version
    AttributeType
AttributeType.RigidBodyState ->
      RigidBodyState -> AttributeValue
RigidBodyState (RigidBodyState -> AttributeValue)
-> BitGet RigidBodyState -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet RigidBodyState
RigidBodyState.bitGet Version
version
    AttributeType
AttributeType.StatEvent -> StatEvent -> AttributeValue
StatEvent (StatEvent -> AttributeValue)
-> BitGet StatEvent -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet StatEvent
StatEvent.bitGet
    AttributeType
AttributeType.String -> String -> AttributeValue
String (String -> AttributeValue)
-> BitGet String -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet String
String.bitGet
    AttributeType
AttributeType.TeamPaint -> TeamPaint -> AttributeValue
TeamPaint (TeamPaint -> AttributeValue)
-> BitGet TeamPaint -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet TeamPaint
TeamPaint.bitGet
    AttributeType
AttributeType.Title -> Title -> AttributeValue
Title (Title -> AttributeValue) -> BitGet Title -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Title
Title.bitGet
    AttributeType
AttributeType.UniqueId -> UniqueId -> AttributeValue
UniqueId (UniqueId -> AttributeValue)
-> BitGet UniqueId -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet UniqueId
UniqueId.bitGet Version
version
    AttributeType
AttributeType.WeldedInfo -> WeldedInfo -> AttributeValue
WeldedInfo (WeldedInfo -> AttributeValue)
-> BitGet WeldedInfo -> BitGet AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> BitGet WeldedInfo
WeldedInfo.bitGet Version
version