module Rattletrap.Type.Attribute.PlayerHistoryKey where

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.Utility.Json as Json

newtype PlayerHistoryKey = PlayerHistoryKey
  { PlayerHistoryKey -> Word16
unknown :: Word.Word16
  } deriving (PlayerHistoryKey -> PlayerHistoryKey -> Bool
(PlayerHistoryKey -> PlayerHistoryKey -> Bool)
-> (PlayerHistoryKey -> PlayerHistoryKey -> Bool)
-> Eq PlayerHistoryKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlayerHistoryKey -> PlayerHistoryKey -> Bool
$c/= :: PlayerHistoryKey -> PlayerHistoryKey -> Bool
== :: PlayerHistoryKey -> PlayerHistoryKey -> Bool
$c== :: PlayerHistoryKey -> PlayerHistoryKey -> Bool
Eq, Int -> PlayerHistoryKey -> ShowS
[PlayerHistoryKey] -> ShowS
PlayerHistoryKey -> String
(Int -> PlayerHistoryKey -> ShowS)
-> (PlayerHistoryKey -> String)
-> ([PlayerHistoryKey] -> ShowS)
-> Show PlayerHistoryKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlayerHistoryKey] -> ShowS
$cshowList :: [PlayerHistoryKey] -> ShowS
show :: PlayerHistoryKey -> String
$cshow :: PlayerHistoryKey -> String
showsPrec :: Int -> PlayerHistoryKey -> ShowS
$cshowsPrec :: Int -> PlayerHistoryKey -> ShowS
Show)

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

instance Json.ToJSON PlayerHistoryKey where
  toJSON :: PlayerHistoryKey -> Value
toJSON = Word16 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Word16 -> Value)
-> (PlayerHistoryKey -> Word16) -> PlayerHistoryKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlayerHistoryKey -> Word16
unknown

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-player-history-key" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.number

bitPut :: PlayerHistoryKey -> BitPut.BitPut
bitPut :: PlayerHistoryKey -> BitPut
bitPut = Int -> Word16 -> BitPut
forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
14 (Word16 -> BitPut)
-> (PlayerHistoryKey -> Word16) -> PlayerHistoryKey -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlayerHistoryKey -> Word16
unknown

bitGet :: BitGet.BitGet PlayerHistoryKey
bitGet :: BitGet PlayerHistoryKey
bitGet = Word16 -> PlayerHistoryKey
PlayerHistoryKey (Word16 -> PlayerHistoryKey)
-> BitGet Word16 -> BitGet PlayerHistoryKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word16
forall a. Bits a => Int -> BitGet a
BitGet.bits Int
14