module Rattletrap.Type.Replication.Updated 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.Attribute as Attribute
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.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 Rattletrap.Utility.Monad as Monad

newtype Updated = Updated
  { Updated -> List Attribute
attributes :: List.List Attribute.Attribute
  }
  deriving (Updated -> Updated -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Updated -> Updated -> Bool
$c/= :: Updated -> Updated -> Bool
== :: Updated -> Updated -> Bool
$c== :: Updated -> Updated -> Bool
Eq, Int -> Updated -> ShowS
[Updated] -> ShowS
Updated -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Updated] -> ShowS
$cshowList :: [Updated] -> ShowS
show :: Updated -> String
$cshow :: Updated -> String
showsPrec :: Int -> Updated -> ShowS
$cshowsPrec :: Int -> Updated -> ShowS
Show)

instance Json.FromJSON Updated where
  parseJSON :: Value -> Parser Updated
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List Attribute -> Updated
Updated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Updated where
  toJSON :: Updated -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Updated -> List Attribute
attributes

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"replication-updated" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$
    Schema -> Schema
List.schema
      Schema
Attribute.schema

bitPut :: Updated -> BitPut.BitPut
bitPut :: Updated -> BitPut
bitPut Updated
x =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
    (\Attribute
y -> Bool -> BitPut
BitPut.bool Bool
True forall a. Semigroup a => a -> a -> a
<> Attribute -> BitPut
Attribute.bitPut Attribute
y)
    (forall a. List a -> [a]
List.toList forall a b. (a -> b) -> a -> b
$ Updated -> List Attribute
attributes Updated
x)
    forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool Bool
False

bitGet ::
  Version.Version ->
  Maybe Str.Str ->
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  CompressedWord.CompressedWord ->
  BitGet.BitGet Updated
bitGet :: Version
-> Maybe Str
-> ClassAttributeMap
-> Map CompressedWord U32
-> CompressedWord
-> BitGet Updated
bitGet Version
version Maybe Str
buildVersion ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Updated" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List Attribute -> Updated
Updated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (Maybe a) -> m (List a)
List.untilM forall a b. (a -> b) -> a -> b
$ do
    Bool
p <- BitGet Bool
BitGet.bool
    forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe Bool
p forall a b. (a -> b) -> a -> b
$
      Version
-> Maybe Str
-> ClassAttributeMap
-> Map CompressedWord U32
-> CompressedWord
-> BitGet Attribute
Attribute.bitGet Version
version Maybe Str
buildVersion ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor