AttributeValue.hs

module Rattletrap.Type.AttributeValue where

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

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

data AttributeValue
  = AppliedDamage AppliedDamage.AppliedDamage
  | Boolean Boolean.Boolean
  | Byte Byte.Byte
  | CamSettings CamSettings.CamSettings
  | ClubColors ClubColors.ClubColors
  | CustomDemolish CustomDemolish.CustomDemolish
  | DamageState DamageState.DamageState
  | Demolish Demolish.Demolish
  | Enum Enum.Enum
  | Explosion Explosion.Explosion
  | ExtendedExplosion ExtendedExplosion.ExtendedExplosion
  | FlaggedInt FlaggedInt.FlaggedInt
  | FlaggedByte FlaggedByte.FlaggedByte
  | Float Float.Float
  | GameMode GameMode.GameMode
  | Int Int.Int
  | Int64 Int64.Int64
  | Loadout Loadout.Loadout
  | LoadoutOnline LoadoutOnline.LoadoutOnline
  | Loadouts Loadouts.Loadouts
  | LoadoutsOnline LoadoutsOnline.LoadoutsOnline
  | Location Location.Location
  | MusicStinger MusicStinger.MusicStinger
  | PartyLeader PartyLeader.PartyLeader
  | Pickup Pickup.Pickup
  | PickupNew PickupNew.PickupNew
  | PlayerHistoryKey PlayerHistoryKey.PlayerHistoryKey
  | PrivateMatchSettings PrivateMatchSettings.PrivateMatchSettings
  | QWord QWord.QWord
  | Reservation Reservation.Reservation
  | RigidBodyState RigidBodyState.RigidBodyState
  | StatEvent StatEvent.StatEvent
  | String String.String
  | TeamPaint TeamPaint.TeamPaint
  | Title Title.Title
  | UniqueId UniqueId.UniqueId
  | WeldedInfo WeldedInfo.WeldedInfo
  deriving (Eq, Show)

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

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

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

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

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