module Rattletrap.Type.Attribute.ProductValue where

import qualified Data.Foldable as Foldable
import qualified Data.Word as Word
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Exception.MissingProductName as MissingProductName
import qualified Rattletrap.Exception.UnknownProduct as UnknownProduct
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.CompressedWord as CompressedWord
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 Rattletrap.Utility.Monad as Monad

data ProductValue
  = PaintedOld CompressedWord.CompressedWord
  | PaintedNew Word.Word32
  | TeamEditionOld CompressedWord.CompressedWord
  | TeamEditionNew Word.Word32
  | SpecialEdition Word.Word32
  | UserColorOld (Maybe Word.Word32)
  | UserColorNew U32.U32
  | TitleId Str.Str
  deriving (ProductValue -> ProductValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductValue -> ProductValue -> Bool
$c/= :: ProductValue -> ProductValue -> Bool
== :: ProductValue -> ProductValue -> Bool
$c== :: ProductValue -> ProductValue -> Bool
Eq, Int -> ProductValue -> ShowS
[ProductValue] -> ShowS
ProductValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductValue] -> ShowS
$cshowList :: [ProductValue] -> ShowS
show :: ProductValue -> String
$cshow :: ProductValue -> String
showsPrec :: Int -> ProductValue -> ShowS
$cshowsPrec :: Int -> ProductValue -> ShowS
Show)

instance Json.FromJSON ProductValue where
  parseJSON :: Value -> Parser ProductValue
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"ProductValue" forall a b. (a -> b) -> a -> b
$ \Object
object ->
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWord -> ProductValue
PaintedOld forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"painted_old",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ProductValue
PaintedNew forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"painted_new",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWord -> ProductValue
TeamEditionOld forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"team_edition_old",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ProductValue
TeamEditionNew forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"team_edition_new",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ProductValue
SpecialEdition forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"special_edition",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Word32 -> ProductValue
UserColorOld forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"user_color_old",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U32 -> ProductValue
UserColorNew forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"user_color_new",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> ProductValue
TitleId forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"title_id"
      ]

instance Json.ToJSON ProductValue where
  toJSON :: ProductValue -> Value
toJSON ProductValue
x = case ProductValue
x of
    PaintedOld CompressedWord
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"painted_old" CompressedWord
y]
    PaintedNew Word32
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"painted_new" Word32
y]
    TeamEditionOld CompressedWord
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"team_edition_old" CompressedWord
y]
    TeamEditionNew Word32
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"team_edition_new" Word32
y]
    SpecialEdition Word32
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"special_edition" Word32
y]
    UserColorOld Maybe Word32
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"user_color_old" Maybe Word32
y]
    UserColorNew U32
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"user_color_new" U32
y]
    TitleId Str
y -> [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"title_id" Str
y]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-product-value" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(String
k, Value
v) -> [((Key, Value), Bool)] -> Value
Schema.object [(forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
k Value
v, Bool
True)])
      [ (String
"painted_old", Schema -> Value
Schema.ref Schema
CompressedWord.schema),
        (String
"painted_new", Schema -> Value
Schema.ref Schema
Schema.integer),
        (String
"team_edition_old", Schema -> Value
Schema.ref Schema
CompressedWord.schema),
        (String
"team_edition_new", Schema -> Value
Schema.ref Schema
Schema.integer),
        (String
"special_edition", Schema -> Value
Schema.ref Schema
Schema.integer),
        (String
"user_color_old", Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Schema.integer),
        (String
"user_color_new", Schema -> Value
Schema.ref Schema
U32.schema),
        (String
"title_id", Schema -> Value
Schema.ref Schema
Str.schema)
      ]

bitPut :: ProductValue -> BitPut.BitPut
bitPut :: ProductValue -> BitPut
bitPut ProductValue
val = case ProductValue
val of
  PaintedOld CompressedWord
x -> CompressedWord -> BitPut
CompressedWord.bitPut CompressedWord
x
  PaintedNew Word32
x -> forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
31 Word32
x
  TeamEditionOld CompressedWord
x -> CompressedWord -> BitPut
CompressedWord.bitPut CompressedWord
x
  TeamEditionNew Word32
x -> forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
31 Word32
x
  SpecialEdition Word32
x -> forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
31 Word32
x
  UserColorOld Maybe Word32
x -> case Maybe Word32
x of
    Maybe Word32
Nothing -> Bool -> BitPut
BitPut.bool Bool
False
    Just Word32
y -> Bool -> BitPut
BitPut.bool Bool
True forall a. Semigroup a => a -> a -> a
<> forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
31 Word32
y
  UserColorNew U32
x -> U32 -> BitPut
U32.bitPut U32
x
  TitleId Str
x -> Str -> BitPut
Str.bitPut Str
x

bitGet ::
  Version.Version -> U32.U32 -> Maybe Str.Str -> BitGet.BitGet ProductValue
bitGet :: Version -> U32 -> Maybe Str -> BitGet ProductValue
bitGet Version
version U32
objectId Maybe Str
maybeObjectName =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"ProductValue" forall a b. (a -> b) -> a -> b
$ case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> String
Str.toString Maybe Str
maybeObjectName of
    Just String
"TAGame.ProductAttribute_Painted_TA" -> Version -> BitGet ProductValue
decodePainted Version
version
    Just String
"TAGame.ProductAttribute_SpecialEdition_TA" -> BitGet ProductValue
decodeSpecialEdition
    Just String
"TAGame.ProductAttribute_TeamEdition_TA" -> Version -> BitGet ProductValue
decodeTeamEdition Version
version
    Just String
"TAGame.ProductAttribute_TitleID_TA" -> BitGet ProductValue
decodeTitle
    Just String
"TAGame.ProductAttribute_UserColor_TA" -> Version -> BitGet ProductValue
decodeColor Version
version
    Just String
x -> forall e a. Exception e => e -> BitGet a
BitGet.throw forall a b. (a -> b) -> a -> b
$ String -> UnknownProduct
UnknownProduct.UnknownProduct String
x
    Maybe String
Nothing ->
      forall e a. Exception e => e -> BitGet a
BitGet.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> MissingProductName
MissingProductName.MissingProductName forall a b. (a -> b) -> a -> b
$
        U32 -> Word32
U32.toWord32
          U32
objectId

decodeSpecialEdition :: BitGet.BitGet ProductValue
decodeSpecialEdition :: BitGet ProductValue
decodeSpecialEdition =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"SpecialEdition" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ProductValue
SpecialEdition forall a b. (a -> b) -> a -> b
$ forall a. Bits a => Int -> BitGet a
BitGet.bits Int
31

decodePainted :: Version.Version -> BitGet.BitGet ProductValue
decodePainted :: Version -> BitGet ProductValue
decodePainted Version
version =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Painted" forall a b. (a -> b) -> a -> b
$
    if Version -> Bool
hasNewPainted Version
version
      then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ProductValue
PaintedNew forall a b. (a -> b) -> a -> b
$ forall a. Bits a => Int -> BitGet a
BitGet.bits Int
31
      else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWord -> ProductValue
PaintedOld forall a b. (a -> b) -> a -> b
$ Word -> BitGet CompressedWord
CompressedWord.bitGet Word
13

decodeTeamEdition :: Version.Version -> BitGet.BitGet ProductValue
decodeTeamEdition :: Version -> BitGet ProductValue
decodeTeamEdition Version
version =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"TeamEdition" forall a b. (a -> b) -> a -> b
$
    if Version -> Bool
hasNewPainted Version
version
      then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ProductValue
TeamEditionNew forall a b. (a -> b) -> a -> b
$ forall a. Bits a => Int -> BitGet a
BitGet.bits Int
31
      else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWord -> ProductValue
TeamEditionOld forall a b. (a -> b) -> a -> b
$ Word -> BitGet CompressedWord
CompressedWord.bitGet Word
13

decodeColor :: Version.Version -> BitGet.BitGet ProductValue
decodeColor :: Version -> BitGet ProductValue
decodeColor Version
version =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"UserColor" forall a b. (a -> b) -> a -> b
$
    if Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
23 Int
8 Version
version
      then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U32 -> ProductValue
UserColorNew BitGet U32
U32.bitGet
      else do
        Bool
hasValue <- BitGet Bool
BitGet.bool
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Word32 -> ProductValue
UserColorOld forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe Bool
hasValue (forall a. Bits a => Int -> BitGet a
BitGet.bits Int
31)

hasNewPainted :: Version.Version -> Bool
hasNewPainted :: Version -> Bool
hasNewPainted = Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
18 Int
0

decodeTitle :: BitGet.BitGet ProductValue
decodeTitle :: BitGet ProductValue
decodeTitle = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Title" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> ProductValue
TitleId BitGet Str
Str.bitGet