module Rattletrap.Type.Replication.Destroyed where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Utility.Json as Json

-- | Destroyed replications don't actually contain any extra information. All
-- you need to know is the actor's ID, which is given by the
-- 'Rattletrap.Replication.Replication'.
data Destroyed = Destroyed
  deriving (Destroyed -> Destroyed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Destroyed -> Destroyed -> Bool
$c/= :: Destroyed -> Destroyed -> Bool
== :: Destroyed -> Destroyed -> Bool
$c== :: Destroyed -> Destroyed -> Bool
Eq, Int -> Destroyed -> ShowS
[Destroyed] -> ShowS
Destroyed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Destroyed] -> ShowS
$cshowList :: [Destroyed] -> ShowS
show :: Destroyed -> String
$cshow :: Destroyed -> String
showsPrec :: Int -> Destroyed -> ShowS
$cshowsPrec :: Int -> Destroyed -> ShowS
Show)

instance Json.FromJSON Destroyed where
  parseJSON :: Value -> Parser Destroyed
parseJSON Value
json = do
    () <- forall a. FromJSON a => Value -> Parser a
Json.parseJSON Value
json
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Destroyed
Destroyed

instance Json.ToJSON Destroyed where
  toJSON :: Destroyed -> Value
toJSON = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
Json.toJSON ()

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"replication-destroyed" forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"array"]

bitPut :: Destroyed -> BitPut.BitPut
bitPut :: Destroyed -> BitPut
bitPut Destroyed
_ = forall a. Monoid a => a
mempty

bitGet :: BitGet.BitGet Destroyed
bitGet :: BitGet Destroyed
bitGet = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Destroyed" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Destroyed
Destroyed