module Rattletrap.Type.ReplicationValue where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Type.Replication.Destroyed as Destroyed
import qualified Rattletrap.Type.Replication.Spawned as Spawned
import qualified Rattletrap.Type.Replication.Updated as Updated
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

import qualified Control.Monad.Trans.Class as Trans
import qualified Control.Monad.Trans.State as State
import qualified Data.Foldable as Foldable
import qualified Data.Map as Map

data ReplicationValue
  = Spawned Spawned.Spawned
  -- ^ Creates a new actor.
  | Updated Updated.Updated
  -- ^ Updates an existing actor.
  | Destroyed Destroyed.Destroyed
  -- ^ 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, 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)

instance Json.FromJSON ReplicationValue where
  parseJSON :: Value -> Parser ReplicationValue
parseJSON = String
-> (Object -> Parser ReplicationValue)
-> Value
-> Parser ReplicationValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"ReplicationValue" ((Object -> Parser ReplicationValue)
 -> Value -> Parser ReplicationValue)
-> (Object -> Parser ReplicationValue)
-> Value
-> Parser ReplicationValue
forall a b. (a -> b) -> a -> b
$ \Object
object -> [Parser ReplicationValue] -> Parser ReplicationValue
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ (Spawned -> ReplicationValue)
-> Parser Spawned -> Parser ReplicationValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Spawned -> ReplicationValue
Spawned (Parser Spawned -> Parser ReplicationValue)
-> Parser Spawned -> Parser ReplicationValue
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Spawned
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"spawned"
    , (Updated -> ReplicationValue)
-> Parser Updated -> Parser ReplicationValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Updated -> ReplicationValue
Updated (Parser Updated -> Parser ReplicationValue)
-> Parser Updated -> Parser ReplicationValue
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Updated
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"updated"
    , (Destroyed -> ReplicationValue)
-> Parser Destroyed -> Parser ReplicationValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Destroyed -> ReplicationValue
Destroyed (Parser Destroyed -> Parser ReplicationValue)
-> Parser Destroyed -> Parser ReplicationValue
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Destroyed
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"destroyed"
    ]

instance Json.ToJSON ReplicationValue where
  toJSON :: ReplicationValue -> Value
toJSON ReplicationValue
x = case ReplicationValue
x of
    Spawned Spawned
y -> [Pair] -> Value
Json.object [String -> Spawned -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"spawned" Spawned
y]
    Updated Updated
y -> [Pair] -> Value
Json.object [String -> Updated -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"updated" Updated
y]
    Destroyed Destroyed
y -> [Pair] -> Value
Json.object [String -> Destroyed -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"destroyed" Destroyed
y]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"replicationValue" (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$ ((String, Schema) -> Value) -> [(String, Schema)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\(String
k, Schema
v) -> [(Pair, Bool)] -> Value
Schema.object [(String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
v, Bool
True)])
  [ (String
"spawned", Schema
Spawned.schema)
  , (String
"updated", Schema
Updated.schema)
  , (String
"destroyed", Schema
Destroyed.schema)
  ]

bitPut :: ReplicationValue -> BitPut.BitPut
bitPut :: ReplicationValue -> BitPut
bitPut ReplicationValue
value = case ReplicationValue
value of
  Spawned Spawned
x -> Bool -> BitPut
BitPut.bool Bool
True BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool Bool
True BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Spawned -> BitPut
Spawned.bitPut Spawned
x
  Updated Updated
x -> Bool -> BitPut
BitPut.bool Bool
True BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool Bool
False BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Updated -> BitPut
Updated.bitPut Updated
x
  Destroyed Destroyed
x -> Bool -> BitPut
BitPut.bool Bool
False BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Destroyed -> BitPut
Destroyed.bitPut Destroyed
x

bitGet
  :: Maybe Str.Str
  -> Version.Version
  -> ClassAttributeMap.ClassAttributeMap
  -> CompressedWord.CompressedWord
  -> State.StateT
       (Map.Map CompressedWord.CompressedWord U32.U32)
       BitGet.BitGet
       ReplicationValue
bitGet :: Maybe Str
-> Version
-> ClassAttributeMap
-> CompressedWord
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
bitGet Maybe Str
matchType Version
version ClassAttributeMap
classAttributeMap CompressedWord
actorId = do
  Map CompressedWord U32
actorMap <- StateT (Map CompressedWord U32) BitGet (Map CompressedWord U32)
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
  Bool
isOpen <- Get BitString Identity Bool
-> StateT (Map CompressedWord U32) BitGet Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Get BitString Identity Bool
BitGet.bool
  if Bool
isOpen
    then do
      Bool
isNew <- Get BitString Identity Bool
-> StateT (Map CompressedWord U32) BitGet Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Get BitString Identity Bool
BitGet.bool
      if Bool
isNew
        then (Spawned -> ReplicationValue)
-> StateT (Map CompressedWord U32) BitGet Spawned
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Spawned -> ReplicationValue
Spawned
          (StateT (Map CompressedWord U32) BitGet Spawned
 -> StateT (Map CompressedWord U32) BitGet ReplicationValue)
-> StateT (Map CompressedWord U32) BitGet Spawned
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall a b. (a -> b) -> a -> b
$ Maybe Str
-> Version
-> ClassAttributeMap
-> CompressedWord
-> StateT (Map CompressedWord U32) BitGet Spawned
Spawned.bitGet Maybe Str
matchType Version
version ClassAttributeMap
classAttributeMap CompressedWord
actorId
        else (Updated -> ReplicationValue)
-> StateT (Map CompressedWord U32) BitGet Updated
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Updated -> ReplicationValue
Updated (StateT (Map CompressedWord U32) BitGet Updated
 -> StateT (Map CompressedWord U32) BitGet ReplicationValue)
-> (Get BitString Identity Updated
    -> StateT (Map CompressedWord U32) BitGet Updated)
-> Get BitString Identity Updated
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get BitString Identity Updated
-> StateT (Map CompressedWord U32) BitGet Updated
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (Get BitString Identity Updated
 -> StateT (Map CompressedWord U32) BitGet ReplicationValue)
-> Get BitString Identity Updated
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall a b. (a -> b) -> a -> b
$ Version
-> ClassAttributeMap
-> Map CompressedWord U32
-> CompressedWord
-> Get BitString Identity Updated
Updated.bitGet
          Version
version
          ClassAttributeMap
classAttributeMap
          Map CompressedWord U32
actorMap
          CompressedWord
actorId
    else (Destroyed -> ReplicationValue)
-> StateT (Map CompressedWord U32) BitGet Destroyed
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Destroyed -> ReplicationValue
Destroyed (StateT (Map CompressedWord U32) BitGet Destroyed
 -> StateT (Map CompressedWord U32) BitGet ReplicationValue)
-> StateT (Map CompressedWord U32) BitGet Destroyed
-> StateT (Map CompressedWord U32) BitGet ReplicationValue
forall a b. (a -> b) -> a -> b
$ Get BitString Identity Destroyed
-> StateT (Map CompressedWord U32) BitGet Destroyed
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Get BitString Identity Destroyed
Destroyed.bitGet