{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.ReplicationValue
  ( ReplicationValue(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.DestroyedReplication
import Rattletrap.Type.SpawnedReplication
import Rattletrap.Type.UpdatedReplication

data ReplicationValue
  = ReplicationValueSpawned SpawnedReplication
  -- ^ Creates a new actor.
  | ReplicationValueUpdated UpdatedReplication
  -- ^ Updates an existing actor.
  | ReplicationValueDestroyed DestroyedReplication
  -- ^ Destroys an existing actor.
  deriving (ReplicationValue -> ReplicationValue -> Bool
(ReplicationValue -> ReplicationValue -> Bool)
-> (ReplicationValue -> ReplicationValue -> Bool)
-> Eq ReplicationValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplicationValue -> ReplicationValue -> Bool
$c/= :: ReplicationValue -> ReplicationValue -> Bool
== :: ReplicationValue -> ReplicationValue -> Bool
$c== :: ReplicationValue -> ReplicationValue -> Bool
Eq, Eq ReplicationValue
Eq ReplicationValue
-> (ReplicationValue -> ReplicationValue -> Ordering)
-> (ReplicationValue -> ReplicationValue -> Bool)
-> (ReplicationValue -> ReplicationValue -> Bool)
-> (ReplicationValue -> ReplicationValue -> Bool)
-> (ReplicationValue -> ReplicationValue -> Bool)
-> (ReplicationValue -> ReplicationValue -> ReplicationValue)
-> (ReplicationValue -> ReplicationValue -> ReplicationValue)
-> Ord ReplicationValue
ReplicationValue -> ReplicationValue -> Bool
ReplicationValue -> ReplicationValue -> Ordering
ReplicationValue -> ReplicationValue -> ReplicationValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReplicationValue -> ReplicationValue -> ReplicationValue
$cmin :: ReplicationValue -> ReplicationValue -> ReplicationValue
max :: ReplicationValue -> ReplicationValue -> ReplicationValue
$cmax :: ReplicationValue -> ReplicationValue -> ReplicationValue
>= :: ReplicationValue -> ReplicationValue -> Bool
$c>= :: ReplicationValue -> ReplicationValue -> Bool
> :: ReplicationValue -> ReplicationValue -> Bool
$c> :: ReplicationValue -> ReplicationValue -> Bool
<= :: ReplicationValue -> ReplicationValue -> Bool
$c<= :: ReplicationValue -> ReplicationValue -> Bool
< :: ReplicationValue -> ReplicationValue -> Bool
$c< :: ReplicationValue -> ReplicationValue -> Bool
compare :: ReplicationValue -> ReplicationValue -> Ordering
$ccompare :: ReplicationValue -> ReplicationValue -> Ordering
$cp1Ord :: Eq ReplicationValue
Ord, Int -> ReplicationValue -> ShowS
[ReplicationValue] -> ShowS
ReplicationValue -> String
(Int -> ReplicationValue -> ShowS)
-> (ReplicationValue -> String)
-> ([ReplicationValue] -> ShowS)
-> Show ReplicationValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplicationValue] -> ShowS
$cshowList :: [ReplicationValue] -> ShowS
show :: ReplicationValue -> String
$cshow :: ReplicationValue -> String
showsPrec :: Int -> ReplicationValue -> ShowS
$cshowsPrec :: Int -> ReplicationValue -> ShowS
Show)

$(deriveJson ''ReplicationValue)