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.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
(Updated -> Updated -> Bool)
-> (Updated -> Updated -> Bool) -> Eq Updated
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
(Int -> Updated -> ShowS)
-> (Updated -> String) -> ([Updated] -> ShowS) -> Show Updated
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 = (List Attribute -> Updated)
-> Parser (List Attribute) -> Parser Updated
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List Attribute -> Updated
Updated (Parser (List Attribute) -> Parser Updated)
-> (Value -> Parser (List Attribute)) -> Value -> Parser Updated
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (List Attribute)
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Updated where
  toJSON :: Updated -> Value
toJSON = List Attribute -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (List Attribute -> Value)
-> (Updated -> List Attribute) -> Updated -> Value
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" (Value -> Schema) -> (Schema -> Value) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema
  Schema
Attribute.schema

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

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