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.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 Rattletrap.Utility.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
(ProductValue -> ProductValue -> Bool)
-> (ProductValue -> ProductValue -> Bool) -> Eq ProductValue
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
(Int -> ProductValue -> ShowS)
-> (ProductValue -> String)
-> ([ProductValue] -> ShowS)
-> Show ProductValue
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 = String
-> (Object -> Parser ProductValue) -> Value -> Parser ProductValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"ProductValue" ((Object -> Parser ProductValue) -> Value -> Parser ProductValue)
-> (Object -> Parser ProductValue) -> Value -> Parser ProductValue
forall a b. (a -> b) -> a -> b
$ \Object
object -> [Parser ProductValue] -> Parser ProductValue
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ CompressedWord -> ProductValue
PaintedOld (CompressedWord -> ProductValue)
-> Parser CompressedWord -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser CompressedWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"painted_old"
    , Word32 -> ProductValue
PaintedNew (Word32 -> ProductValue) -> Parser Word32 -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Word32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"painted_new"
    , CompressedWord -> ProductValue
TeamEditionOld (CompressedWord -> ProductValue)
-> Parser CompressedWord -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser CompressedWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"team_edition_old"
    , Word32 -> ProductValue
TeamEditionNew (Word32 -> ProductValue) -> Parser Word32 -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Word32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"team_edition_new"
    , Word32 -> ProductValue
SpecialEdition (Word32 -> ProductValue) -> Parser Word32 -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Word32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"special_edition"
    , Maybe Word32 -> ProductValue
UserColorOld (Maybe Word32 -> ProductValue)
-> Parser (Maybe Word32) -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser (Maybe Word32)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"user_color_old"
    , U32 -> ProductValue
UserColorNew (U32 -> ProductValue) -> Parser U32 -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"user_color_new"
    , Str -> ProductValue
TitleId (Str -> ProductValue) -> Parser Str -> Parser ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Str
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 -> [Pair] -> Value
Json.object [String -> CompressedWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"painted_old" CompressedWord
y]
    PaintedNew Word32
y -> [Pair] -> Value
Json.object [String -> Word32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"painted_new" Word32
y]
    TeamEditionOld CompressedWord
y -> [Pair] -> Value
Json.object [String -> CompressedWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"team_edition_old" CompressedWord
y]
    TeamEditionNew Word32
y -> [Pair] -> Value
Json.object [String -> Word32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"team_edition_new" Word32
y]
    SpecialEdition Word32
y -> [Pair] -> Value
Json.object [String -> Word32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"special_edition" Word32
y]
    UserColorOld Maybe Word32
y -> [Pair] -> Value
Json.object [String -> Maybe Word32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"user_color_old" Maybe Word32
y]
    UserColorNew U32
y -> [Pair] -> Value
Json.object [String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"user_color_new" U32
y]
    TitleId Str
y -> [Pair] -> Value
Json.object [String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"title_id" Str
y]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-product-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, Value) -> Value) -> [(String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\(String
k, Value
v) -> [(Pair, Bool)] -> Value
Schema.object [(String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
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 (Schema -> Value) -> Schema -> Value
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 -> Int -> Word32 -> BitPut
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 -> Int -> Word32 -> BitPut
forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
31 Word32
x
  SpecialEdition Word32
x -> Int -> Word32 -> BitPut
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 BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Int -> Word32 -> BitPut
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 =
  case Str -> String
Str.toString (Str -> String) -> Maybe Str -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
objectName -> String -> BitGet ProductValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String
"[RT05] unknown object name "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
objectName
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for ID "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> U32 -> String
forall a. Show a => a -> String
show U32
objectId
      )
    Maybe String
Nothing -> String -> BitGet ProductValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT06] missing object name for ID " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> U32 -> String
forall a. Show a => a -> String
show U32
objectId)

decodeSpecialEdition :: BitGet.BitGet ProductValue
decodeSpecialEdition :: BitGet ProductValue
decodeSpecialEdition = Word32 -> ProductValue
SpecialEdition (Word32 -> ProductValue) -> BitGet Word32 -> BitGet ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
BitGet.bits Int
31

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

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

decodeColor :: Version.Version -> BitGet.BitGet ProductValue
decodeColor :: Version -> BitGet ProductValue
decodeColor Version
version = if Version -> Bool
hasNewColor Version
version
  then U32 -> ProductValue
UserColorNew (U32 -> ProductValue) -> BitGet U32 -> BitGet ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet U32
U32.bitGet
  else do
    Bool
hasValue <- BitGet Bool
BitGet.bool
    Maybe Word32 -> ProductValue
UserColorOld (Maybe Word32 -> ProductValue)
-> BitGet (Maybe Word32) -> BitGet ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> BitGet Word32 -> BitGet (Maybe Word32)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe Bool
hasValue (Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
BitGet.bits Int
31)

hasNewPainted :: Version.Version -> Bool
hasNewPainted :: Version -> Bool
hasNewPainted Version
v =
  Version -> Int
Version.major Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
868 Bool -> Bool -> Bool
&& Version -> Int
Version.minor Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
18 Bool -> Bool -> Bool
&& Version -> Int
Version.patch Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0

hasNewColor :: Version.Version -> Bool
hasNewColor :: Version -> Bool
hasNewColor Version
v =
  Version -> Int
Version.major Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
868 Bool -> Bool -> Bool
&& Version -> Int
Version.minor Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
23 Bool -> Bool -> Bool
&& Version -> Int
Version.patch Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8

decodeTitle :: BitGet.BitGet ProductValue
decodeTitle :: BitGet ProductValue
decodeTitle = Str -> ProductValue
TitleId (Str -> ProductValue) -> BitGet Str -> BitGet ProductValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Str
Str.bitGet