module Rattletrap.Decode.AttributeValue
  ( decodeAttributeValueBits
  )
where

import Rattletrap.Data
import Rattletrap.Decode.AppliedDamageAttribute
import Rattletrap.Decode.BooleanAttribute
import Rattletrap.Decode.ByteAttribute
import Rattletrap.Decode.CamSettingsAttribute
import Rattletrap.Decode.ClubColorsAttribute
import Rattletrap.Decode.Common
import Rattletrap.Decode.CustomDemolishAttribute
import Rattletrap.Decode.DamageStateAttribute
import Rattletrap.Decode.DemolishAttribute
import Rattletrap.Decode.EnumAttribute
import Rattletrap.Decode.ExplosionAttribute
import Rattletrap.Decode.ExtendedExplosionAttribute
import Rattletrap.Decode.FlaggedIntAttribute
import Rattletrap.Decode.FlaggedByteAttribute
import Rattletrap.Decode.FloatAttribute
import Rattletrap.Decode.GameModeAttribute
import Rattletrap.Decode.Int64Attribute
import Rattletrap.Decode.IntAttribute
import Rattletrap.Decode.LoadoutAttribute
import Rattletrap.Decode.LoadoutOnlineAttribute
import Rattletrap.Decode.LoadoutsAttribute
import Rattletrap.Decode.LoadoutsOnlineAttribute
import Rattletrap.Decode.LocationAttribute
import Rattletrap.Decode.MusicStingerAttribute
import Rattletrap.Decode.PartyLeaderAttribute
import Rattletrap.Decode.PickupAttribute
import Rattletrap.Decode.PickupAttributeNew
import Rattletrap.Decode.PlayerHistoryKeyAttribute
import Rattletrap.Decode.PrivateMatchSettingsAttribute
import Rattletrap.Decode.QWordAttribute
import Rattletrap.Decode.ReservationAttribute
import Rattletrap.Decode.RigidBodyStateAttribute
import Rattletrap.Decode.StatEventAttribute
import Rattletrap.Decode.StringAttribute
import Rattletrap.Decode.TeamPaintAttribute
import Rattletrap.Decode.TitleAttribute
import Rattletrap.Decode.UniqueIdAttribute
import Rattletrap.Decode.WeldedInfoAttribute
import Rattletrap.Type.AttributeType
import Rattletrap.Type.AttributeValue
import Rattletrap.Type.Common
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

import qualified Data.Map as Map

decodeAttributeValueBits
  :: (Int, Int, Int) -> Map Word32le Str -> Str -> DecodeBits AttributeValue
decodeAttributeValueBits :: (Int, Int, Int)
-> Map Word32le Str -> Str -> DecodeBits AttributeValue
decodeAttributeValueBits (Int, Int, Int)
version Map Word32le Str
objectMap Str
name = do
  AttributeType
constructor <- BitGet AttributeType
-> (AttributeType -> BitGet AttributeType)
-> Maybe AttributeType
-> BitGet AttributeType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> BitGet AttributeType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT04] don't know how to get attribute value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Str -> String
forall a. Show a => a -> String
show Str
name))
    AttributeType -> BitGet AttributeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Str -> Map Str AttributeType -> Maybe AttributeType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Str
name Map Str AttributeType
attributeTypes)
  case AttributeType
constructor of
    AttributeType
AttributeTypeAppliedDamage ->
      AppliedDamageAttribute -> AttributeValue
AttributeValueAppliedDamage (AppliedDamageAttribute -> AttributeValue)
-> BitGet AppliedDamageAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet AppliedDamageAttribute
decodeAppliedDamageAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeBoolean ->
      BooleanAttribute -> AttributeValue
AttributeValueBoolean (BooleanAttribute -> AttributeValue)
-> BitGet BooleanAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet BooleanAttribute
decodeBooleanAttributeBits
    AttributeType
AttributeTypeByte -> ByteAttribute -> AttributeValue
AttributeValueByte (ByteAttribute -> AttributeValue)
-> BitGet ByteAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet ByteAttribute
decodeByteAttributeBits
    AttributeType
AttributeTypeCamSettings ->
      CamSettingsAttribute -> AttributeValue
AttributeValueCamSettings (CamSettingsAttribute -> AttributeValue)
-> BitGet CamSettingsAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet CamSettingsAttribute
decodeCamSettingsAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeClubColors ->
      ClubColorsAttribute -> AttributeValue
AttributeValueClubColors (ClubColorsAttribute -> AttributeValue)
-> BitGet ClubColorsAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet ClubColorsAttribute
decodeClubColorsAttributeBits
    AttributeType
AttributeTypeCustomDemolish ->
      CustomDemolishAttribute -> AttributeValue
AttributeValueCustomDemolish (CustomDemolishAttribute -> AttributeValue)
-> BitGet CustomDemolishAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet CustomDemolishAttribute
decodeCustomDemolishAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeDamageState ->
      DamageStateAttribute -> AttributeValue
AttributeValueDamageState (DamageStateAttribute -> AttributeValue)
-> BitGet DamageStateAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet DamageStateAttribute
decodeDamageStateAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeDemolish ->
      DemolishAttribute -> AttributeValue
AttributeValueDemolish (DemolishAttribute -> AttributeValue)
-> BitGet DemolishAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet DemolishAttribute
decodeDemolishAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeEnum -> EnumAttribute -> AttributeValue
AttributeValueEnum (EnumAttribute -> AttributeValue)
-> BitGet EnumAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet EnumAttribute
decodeEnumAttributeBits
    AttributeType
AttributeTypeExplosion ->
      ExplosionAttribute -> AttributeValue
AttributeValueExplosion (ExplosionAttribute -> AttributeValue)
-> BitGet ExplosionAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet ExplosionAttribute
decodeExplosionAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeExtendedExplosion -> ExtendedExplosionAttribute -> AttributeValue
AttributeValueExtendedExplosion
      (ExtendedExplosionAttribute -> AttributeValue)
-> BitGet ExtendedExplosionAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet ExtendedExplosionAttribute
decodeExtendedExplosionAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeFlaggedInt ->
      FlaggedIntAttribute -> AttributeValue
AttributeValueFlaggedInt (FlaggedIntAttribute -> AttributeValue)
-> BitGet FlaggedIntAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet FlaggedIntAttribute
decodeFlaggedIntAttributeBits
    AttributeType
AttributeTypeFlaggedByte ->
      FlaggedByteAttribute -> AttributeValue
AttributeValueFlaggedByte (FlaggedByteAttribute -> AttributeValue)
-> BitGet FlaggedByteAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet FlaggedByteAttribute
decodeFlaggedByteAttributeBits
    AttributeType
AttributeTypeFloat -> FloatAttribute -> AttributeValue
AttributeValueFloat (FloatAttribute -> AttributeValue)
-> BitGet FloatAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet FloatAttribute
decodeFloatAttributeBits
    AttributeType
AttributeTypeGameMode ->
      GameModeAttribute -> AttributeValue
AttributeValueGameMode (GameModeAttribute -> AttributeValue)
-> BitGet GameModeAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet GameModeAttribute
decodeGameModeAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeInt -> IntAttribute -> AttributeValue
AttributeValueInt (IntAttribute -> AttributeValue)
-> BitGet IntAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet IntAttribute
decodeIntAttributeBits
    AttributeType
AttributeTypeInt64 -> Int64Attribute -> AttributeValue
AttributeValueInt64 (Int64Attribute -> AttributeValue)
-> BitGet Int64Attribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Int64Attribute
decodeInt64AttributeBits
    AttributeType
AttributeTypeLoadout ->
      LoadoutAttribute -> AttributeValue
AttributeValueLoadout (LoadoutAttribute -> AttributeValue)
-> BitGet LoadoutAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet LoadoutAttribute
decodeLoadoutAttributeBits
    AttributeType
AttributeTypeLoadoutOnline ->
      LoadoutOnlineAttribute -> AttributeValue
AttributeValueLoadoutOnline
        (LoadoutOnlineAttribute -> AttributeValue)
-> BitGet LoadoutOnlineAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int)
-> Map Word32le Str -> BitGet LoadoutOnlineAttribute
decodeLoadoutOnlineAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap
    AttributeType
AttributeTypeLoadouts ->
      LoadoutsAttribute -> AttributeValue
AttributeValueLoadouts (LoadoutsAttribute -> AttributeValue)
-> BitGet LoadoutsAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet LoadoutsAttribute
decodeLoadoutsAttributeBits
    AttributeType
AttributeTypeLoadoutsOnline ->
      LoadoutsOnlineAttribute -> AttributeValue
AttributeValueLoadoutsOnline
        (LoadoutsOnlineAttribute -> AttributeValue)
-> BitGet LoadoutsOnlineAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int)
-> Map Word32le Str -> BitGet LoadoutsOnlineAttribute
decodeLoadoutsOnlineAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap
    AttributeType
AttributeTypeLocation ->
      LocationAttribute -> AttributeValue
AttributeValueLocation (LocationAttribute -> AttributeValue)
-> BitGet LocationAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet LocationAttribute
decodeLocationAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeMusicStinger ->
      MusicStingerAttribute -> AttributeValue
AttributeValueMusicStinger (MusicStingerAttribute -> AttributeValue)
-> BitGet MusicStingerAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet MusicStingerAttribute
decodeMusicStingerAttributeBits
    AttributeType
AttributeTypePartyLeader ->
      PartyLeaderAttribute -> AttributeValue
AttributeValuePartyLeader (PartyLeaderAttribute -> AttributeValue)
-> BitGet PartyLeaderAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet PartyLeaderAttribute
decodePartyLeaderAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypePickup -> PickupAttribute -> AttributeValue
AttributeValuePickup (PickupAttribute -> AttributeValue)
-> BitGet PickupAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PickupAttribute
decodePickupAttributeBits
    AttributeType
AttributeTypePickupNew ->
      PickupAttributeNew -> AttributeValue
AttributeValuePickupNew (PickupAttributeNew -> AttributeValue)
-> BitGet PickupAttributeNew -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PickupAttributeNew
decodePickupAttributeNewBits
    AttributeType
AttributeTypePlayerHistoryKey ->
      PlayerHistoryKeyAttribute -> AttributeValue
AttributeValuePlayerHistoryKey (PlayerHistoryKeyAttribute -> AttributeValue)
-> BitGet PlayerHistoryKeyAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PlayerHistoryKeyAttribute
decodePlayerHistoryKeyAttributeBits
    AttributeType
AttributeTypePrivateMatchSettings ->
      PrivateMatchSettingsAttribute -> AttributeValue
AttributeValuePrivateMatchSettings
        (PrivateMatchSettingsAttribute -> AttributeValue)
-> BitGet PrivateMatchSettingsAttribute
-> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet PrivateMatchSettingsAttribute
decodePrivateMatchSettingsAttributeBits
    AttributeType
AttributeTypeQWord -> QWordAttribute -> AttributeValue
AttributeValueQWord (QWordAttribute -> AttributeValue)
-> BitGet QWordAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet QWordAttribute
decodeQWordAttributeBits
    AttributeType
AttributeTypeReservation ->
      ReservationAttribute -> AttributeValue
AttributeValueReservation (ReservationAttribute -> AttributeValue)
-> BitGet ReservationAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet ReservationAttribute
decodeReservationAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeRigidBodyState -> RigidBodyStateAttribute -> AttributeValue
AttributeValueRigidBodyState
      (RigidBodyStateAttribute -> AttributeValue)
-> BitGet RigidBodyStateAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet RigidBodyStateAttribute
decodeRigidBodyStateAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeStatEvent ->
      StatEventAttribute -> AttributeValue
AttributeValueStatEvent (StatEventAttribute -> AttributeValue)
-> BitGet StatEventAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet StatEventAttribute
decodeStatEventAttributeBits
    AttributeType
AttributeTypeString -> StringAttribute -> AttributeValue
AttributeValueString (StringAttribute -> AttributeValue)
-> BitGet StringAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet StringAttribute
decodeStringAttributeBits
    AttributeType
AttributeTypeTeamPaint ->
      TeamPaintAttribute -> AttributeValue
AttributeValueTeamPaint (TeamPaintAttribute -> AttributeValue)
-> BitGet TeamPaintAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet TeamPaintAttribute
decodeTeamPaintAttributeBits
    AttributeType
AttributeTypeTitle -> TitleAttribute -> AttributeValue
AttributeValueTitle (TitleAttribute -> AttributeValue)
-> BitGet TitleAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet TitleAttribute
decodeTitleAttributeBits
    AttributeType
AttributeTypeUniqueId ->
      UniqueIdAttribute -> AttributeValue
AttributeValueUniqueId (UniqueIdAttribute -> AttributeValue)
-> BitGet UniqueIdAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet UniqueIdAttribute
decodeUniqueIdAttributeBits (Int, Int, Int)
version
    AttributeType
AttributeTypeWeldedInfo ->
      WeldedInfoAttribute -> AttributeValue
AttributeValueWeldedInfo (WeldedInfoAttribute -> AttributeValue)
-> BitGet WeldedInfoAttribute -> DecodeBits AttributeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int) -> BitGet WeldedInfoAttribute
decodeWeldedInfoAttributeBits (Int, Int, Int)
version

attributeTypes :: Map Str AttributeType
attributeTypes :: Map Str AttributeType
attributeTypes = (String -> Str)
-> Map String AttributeType -> Map Str AttributeType
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys String -> Str
toStr ([(String, AttributeType)] -> Map String AttributeType
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, AttributeType)]
rawAttributeTypes)