module Rattletrap.Type.Attribute.LoadoutOnline where

import qualified Data.Map as Map
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.Product as Product
import qualified Rattletrap.Type.List as List
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

newtype LoadoutOnline = LoadoutOnline
  { LoadoutOnline -> List (List Product)
value :: List.List (List.List Product.Product)
  } deriving (LoadoutOnline -> LoadoutOnline -> Bool
(LoadoutOnline -> LoadoutOnline -> Bool)
-> (LoadoutOnline -> LoadoutOnline -> Bool) -> Eq LoadoutOnline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadoutOnline -> LoadoutOnline -> Bool
$c/= :: LoadoutOnline -> LoadoutOnline -> Bool
== :: LoadoutOnline -> LoadoutOnline -> Bool
$c== :: LoadoutOnline -> LoadoutOnline -> Bool
Eq, Int -> LoadoutOnline -> ShowS
[LoadoutOnline] -> ShowS
LoadoutOnline -> String
(Int -> LoadoutOnline -> ShowS)
-> (LoadoutOnline -> String)
-> ([LoadoutOnline] -> ShowS)
-> Show LoadoutOnline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadoutOnline] -> ShowS
$cshowList :: [LoadoutOnline] -> ShowS
show :: LoadoutOnline -> String
$cshow :: LoadoutOnline -> String
showsPrec :: Int -> LoadoutOnline -> ShowS
$cshowsPrec :: Int -> LoadoutOnline -> ShowS
Show)

instance Json.FromJSON LoadoutOnline where
  parseJSON :: Value -> Parser LoadoutOnline
parseJSON = (List (List Product) -> LoadoutOnline)
-> Parser (List (List Product)) -> Parser LoadoutOnline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List (List Product) -> LoadoutOnline
LoadoutOnline (Parser (List (List Product)) -> Parser LoadoutOnline)
-> (Value -> Parser (List (List Product)))
-> Value
-> Parser LoadoutOnline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (List (List Product))
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON LoadoutOnline where
  toJSON :: LoadoutOnline -> Value
toJSON = List (List Product) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (List (List Product) -> Value)
-> (LoadoutOnline -> List (List Product)) -> LoadoutOnline -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadoutOnline -> List (List Product)
value

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-loadout-online"
    (Value -> Schema) -> (Schema -> Value) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json
    (Schema -> Value) -> (Schema -> Schema) -> Schema -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Schema
List.schema
    (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Product.schema

bitPut :: LoadoutOnline -> BitPut.BitPut
bitPut :: LoadoutOnline -> BitPut
bitPut LoadoutOnline
loadoutAttribute =
  let attributes :: [List Product]
attributes = List (List Product) -> [List Product]
forall a. List a -> [a]
List.toList (List (List Product) -> [List Product])
-> List (List Product) -> [List Product]
forall a b. (a -> b) -> a -> b
$ LoadoutOnline -> List (List Product)
value LoadoutOnline
loadoutAttribute
  in
    (U8 -> BitPut
U8.bitPut (U8 -> BitPut) -> (Int -> U8) -> Int -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> U8
U8.fromWord8 (Word8 -> U8) -> (Int -> Word8) -> Int -> U8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BitPut) -> Int -> BitPut
forall a b. (a -> b) -> a -> b
$ [List Product] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [List Product]
attributes)
      BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (List Product -> BitPut) -> [List Product] -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap List Product -> BitPut
Product.putProductAttributes [List Product]
attributes

bitGet
  :: Version.Version -> Map.Map U32.U32 Str.Str -> BitGet.BitGet LoadoutOnline
bitGet :: Version -> Map U32 Str -> BitGet LoadoutOnline
bitGet Version
version Map U32 Str
objectMap = String -> BitGet LoadoutOnline -> BitGet LoadoutOnline
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"LoadoutOnline" (BitGet LoadoutOnline -> BitGet LoadoutOnline)
-> BitGet LoadoutOnline -> BitGet LoadoutOnline
forall a b. (a -> b) -> a -> b
$ do
  U8
size <- String -> BitGet U8 -> BitGet U8
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"size" BitGet U8
U8.bitGet
  List (List Product)
value <-
    String
-> BitGet (List (List Product)) -> BitGet (List (List Product))
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value"
    (BitGet (List (List Product)) -> BitGet (List (List Product)))
-> (Get BitString Identity (List Product)
    -> BitGet (List (List Product)))
-> Get BitString Identity (List Product)
-> BitGet (List (List Product))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Get BitString Identity (List Product)
-> BitGet (List (List Product))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (List a)
List.replicateM (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ U8 -> Word8
U8.toWord8 U8
size)
    (Get BitString Identity (List Product)
 -> BitGet (List (List Product)))
-> Get BitString Identity (List Product)
-> BitGet (List (List Product))
forall a b. (a -> b) -> a -> b
$ Version -> Map U32 Str -> Get BitString Identity (List Product)
Product.decodeProductAttributesBits Version
version Map U32 Str
objectMap
  LoadoutOnline -> BitGet LoadoutOnline
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadoutOnline :: List (List Product) -> LoadoutOnline
LoadoutOnline { List (List Product)
value :: List (List Product)
value :: List (List Product)
value }