module Rattletrap.Type.AttributeValue where

import qualified Data.Foldable as Foldable
import qualified Data.Map as Map
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Data as Data
import qualified Rattletrap.Exception.UnknownAttribute as UnknownAttribute
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.GameServer as GameServer
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.PickupInfo as PickupInfo
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.RepStatTitle as RepStatTitle
import qualified Rattletrap.Type.Attribute.Reservation as Reservation
import qualified Rattletrap.Type.Attribute.RigidBodyState as RigidBodyState
import qualified Rattletrap.Type.Attribute.Rotation as Rotation
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

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
  | GameServer GameServer.GameServer
  | 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
  | PickupInfo PickupInfo.PickupInfo
  | PickupNew PickupNew.PickupNew
  | PlayerHistoryKey PlayerHistoryKey.PlayerHistoryKey
  | PrivateMatchSettings PrivateMatchSettings.PrivateMatchSettings
  | QWord QWord.QWord
  | RepStatTitle RepStatTitle.RepStatTitle
  | Reservation Reservation.Reservation
  | RigidBodyState RigidBodyState.RigidBodyState
  | Rotation Rotation.Rotation
  | StatEvent StatEvent.StatEvent
  | String String.String
  | TeamPaint TeamPaint.TeamPaint
  | Title Title.Title
  | UniqueId UniqueId.UniqueId
  | WeldedInfo WeldedInfo.WeldedInfo
  deriving (AttributeValue -> AttributeValue -> Bool
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"AttributeValue" forall a b. (a -> b) -> a -> b
$ \Object
object ->
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AppliedDamage -> AttributeValue
AppliedDamage forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"applied_damage",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Boolean -> AttributeValue
Boolean forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"boolean",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Byte -> AttributeValue
Byte forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"byte",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CamSettings -> AttributeValue
CamSettings forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"cam_settings",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClubColors -> AttributeValue
ClubColors forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"club_colors",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CustomDemolish -> AttributeValue
CustomDemolish forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"custom_demolish",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DamageState -> AttributeValue
DamageState forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"damage_state",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Demolish -> AttributeValue
Demolish forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"demolish",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Enum -> AttributeValue
Enum forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"enum",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Explosion -> AttributeValue
Explosion forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"explosion",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExtendedExplosion -> AttributeValue
ExtendedExplosion forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"extended_explosion",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlaggedByte -> AttributeValue
FlaggedByte forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flagged_byte",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlaggedInt -> AttributeValue
FlaggedInt forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flagged_int",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> AttributeValue
Float forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"float",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GameMode -> AttributeValue
GameMode forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"game_mode",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GameServer -> AttributeValue
GameServer forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"game_server",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> AttributeValue
Int forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> AttributeValue
Int64 forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int64",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loadout -> AttributeValue
Loadout forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadout",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LoadoutOnline -> AttributeValue
LoadoutOnline forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadout_online",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loadouts -> AttributeValue
Loadouts forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadouts",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LoadoutsOnline -> AttributeValue
LoadoutsOnline forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"loadouts_online",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> AttributeValue
Location forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"location",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MusicStinger -> AttributeValue
MusicStinger forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"music_stinger",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartyLeader -> AttributeValue
PartyLeader forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"party_leader",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pickup -> AttributeValue
Pickup forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"pickup",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PickupInfo -> AttributeValue
PickupInfo forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"pickup_info",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PickupNew -> AttributeValue
PickupNew forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"pickup_new",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlayerHistoryKey -> AttributeValue
PlayerHistoryKey forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"player_history_key",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivateMatchSettings -> AttributeValue
PrivateMatchSettings forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"private_match_settings",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QWord -> AttributeValue
QWord forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"q_word",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RepStatTitle -> AttributeValue
RepStatTitle forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rep_stat_title",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reservation -> AttributeValue
Reservation forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"reservation",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RigidBodyState -> AttributeValue
RigidBodyState forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rigid_body_state",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rotation -> AttributeValue
Rotation forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rotation",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StatEvent -> AttributeValue
StatEvent forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stat_event",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AttributeValue
String forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"string",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeamPaint -> AttributeValue
TeamPaint forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"team_paint",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Title -> AttributeValue
Title forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"title",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UniqueId -> AttributeValue
UniqueId forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unique_id",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WeldedInfo -> AttributeValue
WeldedInfo forall a b. (a -> b) -> a -> b
$ 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 -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"applied_damage" AppliedDamage
y]
    Boolean Boolean
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"boolean" Boolean
y]
    Byte Byte
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"byte" Byte
y]
    CamSettings CamSettings
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"cam_settings" CamSettings
y]
    ClubColors ClubColors
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"club_colors" ClubColors
y]
    CustomDemolish CustomDemolish
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"custom_demolish" CustomDemolish
y]
    DamageState DamageState
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"damage_state" DamageState
y]
    Demolish Demolish
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"demolish" Demolish
y]
    Enum Enum
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"enum" Enum
y]
    Explosion Explosion
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"explosion" Explosion
y]
    ExtendedExplosion ExtendedExplosion
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"extended_explosion" ExtendedExplosion
y]
    FlaggedByte FlaggedByte
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flagged_byte" FlaggedByte
y]
    FlaggedInt FlaggedInt
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flagged_int" FlaggedInt
y]
    Float Float
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"float" Float
y]
    GameMode GameMode
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"game_mode" GameMode
y]
    GameServer GameServer
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"game_server" GameServer
y]
    Int Int
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int" Int
y]
    Int64 Int64
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int64" Int64
y]
    Loadout Loadout
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadout" Loadout
y]
    LoadoutOnline LoadoutOnline
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadout_online" LoadoutOnline
y]
    Loadouts Loadouts
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadouts" Loadouts
y]
    LoadoutsOnline LoadoutsOnline
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"loadouts_online" LoadoutsOnline
y]
    Location Location
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"location" Location
y]
    MusicStinger MusicStinger
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"music_stinger" MusicStinger
y]
    PartyLeader PartyLeader
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"party_leader" PartyLeader
y]
    Pickup Pickup
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"pickup" Pickup
y]
    PickupInfo PickupInfo
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"pickup_info" PickupInfo
y]
    PickupNew PickupNew
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"pickup_new" PickupNew
y]
    PlayerHistoryKey PlayerHistoryKey
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"player_history_key" PlayerHistoryKey
y]
    PrivateMatchSettings PrivateMatchSettings
y ->
      [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"private_match_settings" PrivateMatchSettings
y]
    QWord QWord
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"q_word" QWord
y]
    RepStatTitle RepStatTitle
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rep_stat_title" RepStatTitle
y]
    Reservation Reservation
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"reservation" Reservation
y]
    RigidBodyState RigidBodyState
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rigid_body_state" RigidBodyState
y]
    Rotation Rotation
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" Rotation
y]
    StatEvent StatEvent
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stat_event" StatEvent
y]
    String String
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"string" String
y]
    TeamPaint TeamPaint
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"team_paint" TeamPaint
y]
    Title Title
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"title" Title
y]
    UniqueId UniqueId
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unique_id" UniqueId
y]
    WeldedInfo WeldedInfo
y -> [(Key, Value)] -> Value
Json.object [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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(String
k, Schema
v) -> [((Key, Value), Bool)] -> Value
Schema.object [(forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k 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
"game_server", Schema
GameServer.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_info", Schema
PickupInfo.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
"rep_stat_title", Schema
RepStatTitle.schema),
        (String
"reservation", Schema
Reservation.schema),
        (String
"rigid_body_state", Schema
RigidBodyState.schema),
        (String
"rotation", Schema
Rotation.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
  GameServer GameServer
x -> GameServer -> BitPut
GameServer.bitPut GameServer
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
  PickupInfo PickupInfo
x -> PickupInfo -> BitPut
PickupInfo.bitPut PickupInfo
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
  RepStatTitle RepStatTitle
x -> RepStatTitle -> BitPut
RepStatTitle.bitPut RepStatTitle
x
  Reservation Reservation
x -> Reservation -> BitPut
Reservation.bitPut Reservation
x
  RigidBodyState RigidBodyState
x -> RigidBodyState -> BitPut
RigidBodyState.bitPut RigidBodyState
x
  Rotation Rotation
x -> Rotation -> BitPut
Rotation.bitPut Rotation
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 ->
  Maybe Str.Str ->
  Map.Map U32.U32 Str.Str ->
  Str.Str ->
  BitGet.BitGet AttributeValue
bitGet :: Version -> Maybe Str -> Map U32 Str -> Str -> BitGet AttributeValue
bitGet Version
version Maybe Str
buildVersion Map U32 Str
objectMap Str
name =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"AttributeValue" forall a b. (a -> b) -> a -> b
$ do
    AttributeType
constructor <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Str -> Text
Str.toText Str
name) Map Text AttributeType
Data.attributeTypes of
      Maybe AttributeType
Nothing ->
        forall e a. Exception e => e -> BitGet a
BitGet.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnknownAttribute
UnknownAttribute.UnknownAttribute forall a b. (a -> b) -> a -> b
$ Str -> String
Str.toString Str
name
      Just AttributeType
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeType
x
    case AttributeType
constructor of
      AttributeType
AttributeType.AppliedDamage ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AppliedDamage -> AttributeValue
AppliedDamage forall a b. (a -> b) -> a -> b
$ Version -> BitGet AppliedDamage
AppliedDamage.bitGet Version
version
      AttributeType
AttributeType.Boolean -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Boolean -> AttributeValue
Boolean BitGet Boolean
Boolean.bitGet
      AttributeType
AttributeType.Byte -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Byte -> AttributeValue
Byte BitGet Byte
Byte.bitGet
      AttributeType
AttributeType.CamSettings ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CamSettings -> AttributeValue
CamSettings forall a b. (a -> b) -> a -> b
$ Version -> BitGet CamSettings
CamSettings.bitGet Version
version
      AttributeType
AttributeType.ClubColors -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClubColors -> AttributeValue
ClubColors BitGet ClubColors
ClubColors.bitGet
      AttributeType
AttributeType.CustomDemolish ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CustomDemolish -> AttributeValue
CustomDemolish forall a b. (a -> b) -> a -> b
$ Version -> BitGet CustomDemolish
CustomDemolish.bitGet Version
version
      AttributeType
AttributeType.DamageState ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DamageState -> AttributeValue
DamageState forall a b. (a -> b) -> a -> b
$ Version -> BitGet DamageState
DamageState.bitGet Version
version
      AttributeType
AttributeType.Demolish -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Demolish -> AttributeValue
Demolish forall a b. (a -> b) -> a -> b
$ Version -> BitGet Demolish
Demolish.bitGet Version
version
      AttributeType
AttributeType.Enum -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Enum -> AttributeValue
Enum BitGet Enum
Enum.bitGet
      AttributeType
AttributeType.Explosion -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Explosion -> AttributeValue
Explosion forall a b. (a -> b) -> a -> b
$ Version -> BitGet Explosion
Explosion.bitGet Version
version
      AttributeType
AttributeType.ExtendedExplosion ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExtendedExplosion -> AttributeValue
ExtendedExplosion forall a b. (a -> b) -> a -> b
$ Version -> BitGet ExtendedExplosion
ExtendedExplosion.bitGet Version
version
      AttributeType
AttributeType.FlaggedInt -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlaggedInt -> AttributeValue
FlaggedInt BitGet FlaggedInt
FlaggedInt.bitGet
      AttributeType
AttributeType.FlaggedByte -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlaggedByte -> AttributeValue
FlaggedByte BitGet FlaggedByte
FlaggedByte.bitGet
      AttributeType
AttributeType.Float -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> AttributeValue
Float BitGet Float
Float.bitGet
      AttributeType
AttributeType.GameMode -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GameMode -> AttributeValue
GameMode forall a b. (a -> b) -> a -> b
$ Version -> BitGet GameMode
GameMode.bitGet Version
version
      AttributeType
AttributeType.GameServer ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GameServer -> AttributeValue
GameServer forall a b. (a -> b) -> a -> b
$ Maybe Str -> BitGet GameServer
GameServer.bitGet Maybe Str
buildVersion
      AttributeType
AttributeType.Int -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> AttributeValue
Int BitGet Int
Int.bitGet
      AttributeType
AttributeType.Int64 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> AttributeValue
Int64 BitGet Int64
Int64.bitGet
      AttributeType
AttributeType.Loadout -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loadout -> AttributeValue
Loadout BitGet Loadout
Loadout.bitGet
      AttributeType
AttributeType.LoadoutOnline ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LoadoutOnline -> AttributeValue
LoadoutOnline forall a b. (a -> b) -> a -> b
$ Version -> Map U32 Str -> BitGet LoadoutOnline
LoadoutOnline.bitGet Version
version Map U32 Str
objectMap
      AttributeType
AttributeType.Loadouts -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loadouts -> AttributeValue
Loadouts BitGet Loadouts
Loadouts.bitGet
      AttributeType
AttributeType.LoadoutsOnline ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LoadoutsOnline -> AttributeValue
LoadoutsOnline forall a b. (a -> b) -> a -> b
$ Version -> Map U32 Str -> BitGet LoadoutsOnline
LoadoutsOnline.bitGet Version
version Map U32 Str
objectMap
      AttributeType
AttributeType.Location -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> AttributeValue
Location forall a b. (a -> b) -> a -> b
$ Version -> BitGet Location
Location.bitGet Version
version
      AttributeType
AttributeType.MusicStinger -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MusicStinger -> AttributeValue
MusicStinger BitGet MusicStinger
MusicStinger.bitGet
      AttributeType
AttributeType.PartyLeader ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartyLeader -> AttributeValue
PartyLeader forall a b. (a -> b) -> a -> b
$ Version -> BitGet PartyLeader
PartyLeader.bitGet Version
version
      AttributeType
AttributeType.Pickup -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pickup -> AttributeValue
Pickup BitGet Pickup
Pickup.bitGet
      AttributeType
AttributeType.PickupInfo -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PickupInfo -> AttributeValue
PickupInfo BitGet PickupInfo
PickupInfo.bitGet
      AttributeType
AttributeType.PickupNew -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PickupNew -> AttributeValue
PickupNew BitGet PickupNew
PickupNew.bitGet
      AttributeType
AttributeType.PlayerHistoryKey ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlayerHistoryKey -> AttributeValue
PlayerHistoryKey BitGet PlayerHistoryKey
PlayerHistoryKey.bitGet
      AttributeType
AttributeType.PrivateMatchSettings ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivateMatchSettings -> AttributeValue
PrivateMatchSettings BitGet PrivateMatchSettings
PrivateMatchSettings.bitGet
      AttributeType
AttributeType.QWord -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QWord -> AttributeValue
QWord BitGet QWord
QWord.bitGet
      AttributeType
AttributeType.RepStatTitle -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RepStatTitle -> AttributeValue
RepStatTitle BitGet RepStatTitle
RepStatTitle.bitGet
      AttributeType
AttributeType.Reservation ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reservation -> AttributeValue
Reservation forall a b. (a -> b) -> a -> b
$ Version -> BitGet Reservation
Reservation.bitGet Version
version
      AttributeType
AttributeType.RigidBodyState ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RigidBodyState -> AttributeValue
RigidBodyState forall a b. (a -> b) -> a -> b
$ Version -> BitGet RigidBodyState
RigidBodyState.bitGet Version
version
      AttributeType
AttributeType.Rotation -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rotation -> AttributeValue
Rotation BitGet Rotation
Rotation.bitGet
      AttributeType
AttributeType.StatEvent -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StatEvent -> AttributeValue
StatEvent BitGet StatEvent
StatEvent.bitGet
      AttributeType
AttributeType.String -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AttributeValue
String BitGet String
String.bitGet
      AttributeType
AttributeType.TeamPaint -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeamPaint -> AttributeValue
TeamPaint BitGet TeamPaint
TeamPaint.bitGet
      AttributeType
AttributeType.Title -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Title -> AttributeValue
Title BitGet Title
Title.bitGet
      AttributeType
AttributeType.UniqueId -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UniqueId -> AttributeValue
UniqueId forall a b. (a -> b) -> a -> b
$ Version -> BitGet UniqueId
UniqueId.bitGet Version
version
      AttributeType
AttributeType.WeldedInfo -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WeldedInfo -> AttributeValue
WeldedInfo forall a b. (a -> b) -> a -> b
$ Version -> BitGet WeldedInfo
WeldedInfo.bitGet Version
version