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
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
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List (List Product) -> LoadoutOnline
LoadoutOnline forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON LoadoutOnline where
  toJSON :: LoadoutOnline -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Schema
List.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 = forall a. List a -> [a]
List.toList forall a b. (a -> b) -> a -> b
$ LoadoutOnline -> List (List Product)
value LoadoutOnline
loadoutAttribute
   in (U8 -> BitPut
U8.bitPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> U8
U8.fromWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [List Product]
attributes)
        forall a. Semigroup a => a -> a -> a
<> 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 = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"LoadoutOnline" forall a b. (a -> b) -> a -> b
$ do
  U8
size <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"size" BitGet U8
U8.bitGet
  List (List Product)
value <-
    forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value"
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Int -> m a -> m (List a)
List.replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ U8 -> Word8
U8.toWord8 U8
size)
      forall a b. (a -> b) -> a -> b
$ Version -> Map U32 Str -> BitGet (List Product)
Product.decodeProductAttributesBits Version
version Map U32 Str
objectMap
  forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadoutOnline {List (List Product)
value :: List (List Product)
value :: List (List Product)
value}