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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PickupNew" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Maybe U32
instigatorId <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"instigator_id"
    U8
pickedUp <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"picked_up"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"instigator_id" forall a b. (a -> b) -> a -> b
$ PickupNew -> Maybe U32
instigatorId PickupNew
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"picked_up" 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" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"instigator_id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
U32.schema, Bool
False),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"picked_up" 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 =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Bool -> BitPut
BitPut.bool Bool
False)
    (\U32
y -> Bool -> BitPut
BitPut.bool Bool
True forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut U32
y)
    (PickupNew -> Maybe U32
instigatorId PickupNew
x)
    forall a. Semigroup a => a -> a -> a
<> U8 -> BitPut
U8.bitPut (PickupNew -> U8
pickedUp PickupNew
x)

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