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