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
(Pickup -> Pickup -> Bool)
-> (Pickup -> Pickup -> Bool) -> Eq Pickup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pickup -> Pickup -> Bool
== :: Pickup -> Pickup -> Bool
$c/= :: Pickup -> Pickup -> Bool
/= :: Pickup -> Pickup -> Bool
Eq, Int -> Pickup -> ShowS
[Pickup] -> ShowS
Pickup -> String
(Int -> Pickup -> ShowS)
-> (Pickup -> String) -> ([Pickup] -> ShowS) -> Show Pickup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pickup -> ShowS
showsPrec :: Int -> Pickup -> ShowS
$cshow :: Pickup -> String
show :: Pickup -> String
$cshowList :: [Pickup] -> ShowS
showList :: [Pickup] -> ShowS
Show)

instance Json.FromJSON Pickup where
  parseJSON :: Value -> Parser Pickup
parseJSON = String -> (Object -> Parser Pickup) -> Value -> Parser Pickup
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Pickup" ((Object -> Parser Pickup) -> Value -> Parser Pickup)
-> (Object -> Parser Pickup) -> Value -> Parser Pickup
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"
    Bool
pickedUp <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"picked_up"
    Pickup -> Parser Pickup
forall a. a -> Parser a
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
      [ String -> Maybe U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"instigator_id" (Maybe U32 -> (Key, Value)) -> Maybe U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Pickup -> Maybe U32
instigatorId Pickup
x,
        String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"picked_up" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
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" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"instigator_id" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
U32.schema, Bool
False),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"picked_up" (Value -> (Key, Value)) -> Value -> (Key, Value)
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 =
  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)
    (Pickup -> Maybe U32
instigatorId Pickup
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool (Pickup -> Bool
pickedUp Pickup
x)

bitGet :: BitGet.BitGet Pickup
bitGet :: BitGet Pickup
bitGet = String -> BitGet Pickup -> BitGet Pickup
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Pickup" (BitGet Pickup -> BitGet Pickup) -> BitGet Pickup -> BitGet Pickup
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
  Bool
pickedUp <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"pickedUp" BitGet Bool
BitGet.bool
  Pickup -> BitGet Pickup
forall a. a -> Get BitString Identity a
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}