module Rattletrap.Type.Attribute.PickupNew where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

data PickupNew = PickupNew
  { PickupNew -> Maybe U32
instigatorId :: Maybe U32.U32
  , PickupNew -> U8
pickedUp :: U8.U8
  }
  deriving (PickupNew -> PickupNew -> Bool
(PickupNew -> PickupNew -> Bool)
-> (PickupNew -> PickupNew -> Bool) -> Eq PickupNew
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PickupNew -> PickupNew -> Bool
$c/= :: PickupNew -> PickupNew -> Bool
== :: PickupNew -> PickupNew -> Bool
$c== :: PickupNew -> PickupNew -> Bool
Eq, Int -> PickupNew -> ShowS
[PickupNew] -> ShowS
PickupNew -> String
(Int -> PickupNew -> ShowS)
-> (PickupNew -> String)
-> ([PickupNew] -> ShowS)
-> Show PickupNew
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PickupNew] -> ShowS
$cshowList :: [PickupNew] -> ShowS
show :: PickupNew -> String
$cshow :: PickupNew -> String
showsPrec :: Int -> PickupNew -> ShowS
$cshowsPrec :: Int -> PickupNew -> ShowS
Show)

instance Json.FromJSON PickupNew where
  parseJSON :: Value -> Parser PickupNew
parseJSON = String -> (Object -> Parser PickupNew) -> Value -> Parser PickupNew
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PickupNew" ((Object -> Parser PickupNew) -> Value -> Parser PickupNew)
-> (Object -> Parser PickupNew) -> Value -> Parser PickupNew
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Maybe U32
instigatorId <- Object -> String -> Parser (Maybe U32)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"instigator_id"
    U8
pickedUp <- Object -> String -> Parser U8
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"picked_up"
    PickupNew -> Parser PickupNew
forall (f :: * -> *) a. Applicative f => a -> f a
pure PickupNew :: Maybe U32 -> U8 -> PickupNew
PickupNew { Maybe U32
instigatorId :: Maybe U32
instigatorId :: Maybe U32
instigatorId, U8
pickedUp :: U8
pickedUp :: U8
pickedUp }

instance Json.ToJSON PickupNew where
  toJSON :: PickupNew -> Value
toJSON PickupNew
x = [Pair] -> Value
Json.object
    [ String -> Maybe U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"instigator_id" (Maybe U32 -> Pair) -> Maybe U32 -> Pair
forall a b. (a -> b) -> a -> b
$ PickupNew -> Maybe U32
instigatorId PickupNew
x
    , String -> U8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"picked_up" (U8 -> Pair) -> U8 -> Pair
forall a b. (a -> b) -> a -> b
$ PickupNew -> U8
pickedUp PickupNew
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-pickup-new" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"instigator_id" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
U32.schema, Bool
False)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"picked_up" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True)
  ]

bitPut :: PickupNew -> BitPut.BitPut
bitPut :: PickupNew -> BitPut
bitPut PickupNew
x =
  BitPut -> (U32 -> BitPut) -> Maybe U32 -> BitPut
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Bool -> BitPut
BitPut.bool Bool
False)
      (\U32
y -> Bool -> BitPut
BitPut.bool Bool
True BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut U32
y)
      (PickupNew -> Maybe U32
instigatorId PickupNew
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U8 -> BitPut
U8.bitPut (PickupNew -> U8
pickedUp PickupNew
x)

bitGet :: BitGet.BitGet PickupNew
bitGet :: BitGet PickupNew
bitGet = String -> BitGet PickupNew -> BitGet PickupNew
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"PickupNew" (BitGet PickupNew -> BitGet PickupNew)
-> BitGet PickupNew -> BitGet PickupNew
forall a b. (a -> b) -> a -> b
$ do
  Bool
instigator <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"instigator" BitGet Bool
BitGet.bool
  Maybe U32
instigatorId <- String -> BitGet (Maybe U32) -> BitGet (Maybe U32)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"instigatorId"
    (BitGet (Maybe U32) -> BitGet (Maybe U32))
-> BitGet (Maybe U32) -> BitGet (Maybe U32)
forall a b. (a -> b) -> a -> b
$ Bool -> Get BitString Identity U32 -> BitGet (Maybe U32)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe Bool
instigator Get BitString Identity U32
U32.bitGet
  U8
pickedUp <- String -> BitGet U8 -> BitGet U8
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"pickedUp" BitGet U8
U8.bitGet
  PickupNew -> BitGet PickupNew
forall (f :: * -> *) a. Applicative f => a -> f a
pure PickupNew :: Maybe U32 -> U8 -> PickupNew
PickupNew { Maybe U32
instigatorId :: Maybe U32
instigatorId :: Maybe U32
instigatorId, U8
pickedUp :: U8
pickedUp :: U8
pickedUp }