module Rattletrap.Type.Replication where

import qualified Data.Map as Map
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.List as List
import qualified Rattletrap.Type.ReplicationValue as ReplicationValue
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

data Replication = Replication
  { Replication -> CompressedWord
actorId :: CompressedWord.CompressedWord,
    Replication -> ReplicationValue
value :: ReplicationValue.ReplicationValue
  }
  deriving (Replication -> Replication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replication -> Replication -> Bool
$c/= :: Replication -> Replication -> Bool
== :: Replication -> Replication -> Bool
$c== :: Replication -> Replication -> Bool
Eq, Int -> Replication -> ShowS
[Replication] -> ShowS
Replication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Replication] -> ShowS
$cshowList :: [Replication] -> ShowS
show :: Replication -> String
$cshow :: Replication -> String
showsPrec :: Int -> Replication -> ShowS
$cshowsPrec :: Int -> Replication -> ShowS
Show)

instance Json.FromJSON Replication where
  parseJSON :: Value -> Parser Replication
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Replication" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    CompressedWord
actorId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"actor_id"
    ReplicationValue
value <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"value"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Replication {CompressedWord
actorId :: CompressedWord
actorId :: CompressedWord
actorId, ReplicationValue
value :: ReplicationValue
value :: ReplicationValue
value}

instance Json.ToJSON Replication where
  toJSON :: Replication -> Value
toJSON Replication
x =
    [(Key, Value)] -> Value
Json.object [forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"actor_id" forall a b. (a -> b) -> a -> b
$ Replication -> CompressedWord
actorId Replication
x, forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"value" forall a b. (a -> b) -> a -> b
$ Replication -> ReplicationValue
value Replication
x]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"replication" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"actor_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True),
        (forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"value" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
ReplicationValue.schema, Bool
True)
      ]

putReplications :: List.List Replication -> BitPut.BitPut
putReplications :: List Replication -> BitPut
putReplications List Replication
xs =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Replication
x -> Bool -> BitPut
BitPut.bool Bool
True forall a. Semigroup a => a -> a -> a
<> Replication -> BitPut
bitPut Replication
x) (forall a. List a -> [a]
List.toList List Replication
xs)
    forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool Bool
False

bitPut :: Replication -> BitPut.BitPut
bitPut :: Replication -> BitPut
bitPut Replication
replication =
  CompressedWord -> BitPut
CompressedWord.bitPut (Replication -> CompressedWord
actorId Replication
replication)
    forall a. Semigroup a => a -> a -> a
<> ReplicationValue -> BitPut
ReplicationValue.bitPut (Replication -> ReplicationValue
value Replication
replication)

decodeReplicationsBits ::
  Maybe Str.Str ->
  Version.Version ->
  Maybe Str.Str ->
  Word ->
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  BitGet.BitGet
    ( Map.Map CompressedWord.CompressedWord U32.U32,
      List.List Replication
    )
decodeReplicationsBits :: Maybe Str
-> Version
-> Maybe Str
-> Word
-> ClassAttributeMap
-> Map CompressedWord U32
-> BitGet (Map CompressedWord U32, List Replication)
decodeReplicationsBits Maybe Str
matchType Version
version Maybe Str
buildVersion Word
limit ClassAttributeMap
classes Map CompressedWord U32
actorMap =
  Maybe Str
-> Version
-> Maybe Str
-> Word
-> ClassAttributeMap
-> Map CompressedWord U32
-> Int
-> [Replication]
-> BitGet (Map CompressedWord U32, List Replication)
decodeReplicationsBitsWith
    Maybe Str
matchType
    Version
version
    Maybe Str
buildVersion
    Word
limit
    ClassAttributeMap
classes
    Map CompressedWord U32
actorMap
    Int
0
    []

decodeReplicationsBitsWith ::
  Maybe Str.Str ->
  Version.Version ->
  Maybe Str.Str ->
  Word ->
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  Int ->
  [Replication] ->
  BitGet.BitGet
    ( Map.Map CompressedWord.CompressedWord U32.U32,
      List.List Replication
    )
decodeReplicationsBitsWith :: Maybe Str
-> Version
-> Maybe Str
-> Word
-> ClassAttributeMap
-> Map CompressedWord U32
-> Int
-> [Replication]
-> BitGet (Map CompressedWord U32, List Replication)
decodeReplicationsBitsWith Maybe Str
matchType Version
version Maybe Str
buildVersion Word
limit ClassAttributeMap
classes Map CompressedWord U32
actorMap Int
index [Replication]
replications =
  do
    Bool
hasReplication <- BitGet Bool
BitGet.bool
    if Bool
hasReplication
      then do
        (Map CompressedWord U32
newActorMap, Replication
replication) <-
          forall a. String -> BitGet a -> BitGet a
BitGet.label (String
"element (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
index forall a. Semigroup a => a -> a -> a
<> String
")") forall a b. (a -> b) -> a -> b
$
            Maybe Str
-> Version
-> Maybe Str
-> Word
-> ClassAttributeMap
-> Map CompressedWord U32
-> BitGet (Map CompressedWord U32, Replication)
bitGet Maybe Str
matchType Version
version Maybe Str
buildVersion Word
limit ClassAttributeMap
classes Map CompressedWord U32
actorMap
        Maybe Str
-> Version
-> Maybe Str
-> Word
-> ClassAttributeMap
-> Map CompressedWord U32
-> Int
-> [Replication]
-> BitGet (Map CompressedWord U32, List Replication)
decodeReplicationsBitsWith
          Maybe Str
matchType
          Version
version
          Maybe Str
buildVersion
          Word
limit
          ClassAttributeMap
classes
          Map CompressedWord U32
newActorMap
          (Int
index forall a. Num a => a -> a -> a
+ Int
1)
          forall a b. (a -> b) -> a -> b
$ Replication
replication
            forall a. a -> [a] -> [a]
: [Replication]
replications
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map CompressedWord U32
actorMap, forall a. [a] -> List a
List.fromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Replication]
replications)

bitGet ::
  Maybe Str.Str ->
  Version.Version ->
  Maybe Str.Str ->
  Word ->
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  BitGet.BitGet
    ( Map.Map CompressedWord.CompressedWord U32.U32,
      Replication
    )
bitGet :: Maybe Str
-> Version
-> Maybe Str
-> Word
-> ClassAttributeMap
-> Map CompressedWord U32
-> BitGet (Map CompressedWord U32, Replication)
bitGet Maybe Str
matchType Version
version Maybe Str
buildVersion Word
limit ClassAttributeMap
classes Map CompressedWord U32
actorMap =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Replication" forall a b. (a -> b) -> a -> b
$ do
    CompressedWord
actorId <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"actorId" forall a b. (a -> b) -> a -> b
$ Word -> BitGet CompressedWord
CompressedWord.bitGet Word
limit
    (Map CompressedWord U32
newActorMap, ReplicationValue
value) <-
      forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" forall a b. (a -> b) -> a -> b
$
        Maybe Str
-> Version
-> Maybe Str
-> ClassAttributeMap
-> CompressedWord
-> Map CompressedWord U32
-> BitGet (Map CompressedWord U32, ReplicationValue)
ReplicationValue.bitGet
          Maybe Str
matchType
          Version
version
          Maybe Str
buildVersion
          ClassAttributeMap
classes
          CompressedWord
actorId
          Map CompressedWord U32
actorMap
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map CompressedWord U32
newActorMap, Replication {CompressedWord
actorId :: CompressedWord
actorId :: CompressedWord
actorId, ReplicationValue
value :: ReplicationValue
value :: ReplicationValue
value})