module Rattletrap.Type.Attribute.Pickup 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.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

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

instance Json.FromJSON Pickup where
  parseJSON :: Value -> Parser Pickup
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Pickup" 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"
    Bool
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 Pickup {Maybe U32
instigatorId :: Maybe U32
instigatorId :: Maybe U32
instigatorId, Bool
pickedUp :: Bool
pickedUp :: Bool
pickedUp}

instance Json.ToJSON Pickup where
  toJSON :: Pickup -> Value
toJSON Pickup
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
$ Pickup -> Maybe U32
instigatorId Pickup
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"picked_up" forall a b. (a -> b) -> a -> b
$ Pickup -> Bool
pickedUp Pickup
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-pickup" 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
Schema.boolean, Bool
True)
      ]

bitPut :: Pickup -> BitPut.BitPut
bitPut :: Pickup -> BitPut
bitPut Pickup
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)
    (Pickup -> Maybe U32
instigatorId Pickup
x)
    forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool (Pickup -> Bool
pickedUp Pickup
x)

bitGet :: BitGet.BitGet Pickup
bitGet :: BitGet Pickup
bitGet = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Pickup" 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
  Bool
pickedUp <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"pickedUp" BitGet Bool
BitGet.bool
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Pickup {Maybe U32
instigatorId :: Maybe U32
instigatorId :: Maybe U32
instigatorId, Bool
pickedUp :: Bool
pickedUp :: Bool
pickedUp}