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
/= :: Pickup -> Pickup -> Bool
$c/= :: Pickup -> Pickup -> Bool
== :: Pickup -> Pickup -> Bool
$c== :: 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
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 = 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 (f :: * -> *) a. Applicative f => a -> f a
pure Pickup :: Maybe U32 -> Bool -> Pickup
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 = [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
$ Pickup -> Maybe U32
instigatorId Pickup
x
    , String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"picked_up" (Bool -> Pair) -> Bool -> Pair
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
$ [(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
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 = do
  Bool
instigator <- BitGet Bool
BitGet.bool
  Maybe U32
instigatorId <- Bool
-> Get BitString Identity U32 -> Get BitString Identity (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 <- BitGet Bool
BitGet.bool
  Pickup -> BitGet Pickup
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pickup :: Maybe U32 -> Bool -> Pickup
Pickup { Maybe U32
instigatorId :: Maybe U32
instigatorId :: Maybe U32
instigatorId, Bool
pickedUp :: Bool
pickedUp :: Bool
pickedUp }