module Rattletrap.Type.Replication.Spawned where

import qualified Data.Map as Map
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Exception.MissingClassName as MissingClassName
import qualified Rattletrap.Exception.MissingObjectName as MissingObjectName
import qualified Rattletrap.Exception.UnknownName as UnknownName
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Type.Initialization as Initialization
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

data Spawned = Spawned
  { -- | Unclear what this is.
    Spawned -> Bool
flag :: Bool,
    Spawned -> Maybe U32
nameIndex :: Maybe U32.U32,
    -- | Read-only! Changing a replication's name requires editing the
    -- 'nameIndex' and maybe the class attribute map.
    Spawned -> Maybe Str
name :: Maybe Str.Str,
    Spawned -> U32
objectId :: U32.U32,
    -- | Read-only! Changing a replication's object requires editing the class
    -- attribute map.
    Spawned -> Str
objectName :: Str.Str,
    -- | Read-only! Changing a replication's class requires editing the class
    -- attribute map.
    Spawned -> Str
className :: Str.Str,
    Spawned -> Initialization
initialization :: Initialization.Initialization
  }
  deriving (Spawned -> Spawned -> Bool
(Spawned -> Spawned -> Bool)
-> (Spawned -> Spawned -> Bool) -> Eq Spawned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Spawned -> Spawned -> Bool
== :: Spawned -> Spawned -> Bool
$c/= :: Spawned -> Spawned -> Bool
/= :: Spawned -> Spawned -> Bool
Eq, Int -> Spawned -> ShowS
[Spawned] -> ShowS
Spawned -> String
(Int -> Spawned -> ShowS)
-> (Spawned -> String) -> ([Spawned] -> ShowS) -> Show Spawned
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Spawned -> ShowS
showsPrec :: Int -> Spawned -> ShowS
$cshow :: Spawned -> String
show :: Spawned -> String
$cshowList :: [Spawned] -> ShowS
showList :: [Spawned] -> ShowS
Show)

instance Json.FromJSON Spawned where
  parseJSON :: Value -> Parser Spawned
parseJSON = String -> (Object -> Parser Spawned) -> Value -> Parser Spawned
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Spawned" ((Object -> Parser Spawned) -> Value -> Parser Spawned)
-> (Object -> Parser Spawned) -> Value -> Parser Spawned
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
flag <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flag"
    Maybe U32
nameIndex <- Object -> String -> Parser (Maybe U32)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name_index"
    Maybe Str
name <- Object -> String -> Parser (Maybe Str)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name"
    U32
objectId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_id"
    Str
objectName <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_name"
    Str
className <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_name"
    Initialization
initialization <- Object -> String -> Parser Initialization
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"initialization"
    Spawned -> Parser Spawned
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Spawned
        { Bool
flag :: Bool
flag :: Bool
flag,
          Maybe U32
nameIndex :: Maybe U32
nameIndex :: Maybe U32
nameIndex,
          Maybe Str
name :: Maybe Str
name :: Maybe Str
name,
          U32
objectId :: U32
objectId :: U32
objectId,
          Str
objectName :: Str
objectName :: Str
objectName,
          Str
className :: Str
className :: Str
className,
          Initialization
initialization :: Initialization
initialization :: Initialization
initialization
        }

instance Json.ToJSON Spawned where
  toJSON :: Spawned -> Value
toJSON Spawned
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"flag" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> Bool
flag Spawned
x,
        String -> Maybe U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name_index" (Maybe U32 -> (Key, Value)) -> Maybe U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> Maybe U32
nameIndex Spawned
x,
        String -> Maybe Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name" (Maybe Str -> (Key, Value)) -> Maybe Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> Maybe Str
name Spawned
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"object_id" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> U32
objectId Spawned
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"object_name" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> Str
objectName Spawned
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"class_name" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> Str
className Spawned
x,
        String -> Initialization -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"initialization" (Initialization -> (Key, Value)) -> Initialization -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Spawned -> Initialization
initialization Spawned
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"replication-spawned" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"flag" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name_index" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
U32.schema, Bool
False),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Str.schema, Bool
False),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"object_id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"object_name" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"class_name" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"initialization" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Initialization.schema, Bool
True)
      ]

bitPut :: Spawned -> BitPut.BitPut
bitPut :: Spawned -> BitPut
bitPut Spawned
spawnedReplication =
  Bool -> BitPut
BitPut.bool (Spawned -> Bool
flag Spawned
spawnedReplication)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (U32 -> BitPut) -> Maybe U32 -> BitPut
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap U32 -> BitPut
U32.bitPut (Spawned -> Maybe U32
nameIndex Spawned
spawnedReplication)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (Spawned -> U32
objectId Spawned
spawnedReplication)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Initialization -> BitPut
Initialization.bitPut (Spawned -> Initialization
initialization Spawned
spawnedReplication)

bitGet ::
  Maybe Str.Str ->
  Version.Version ->
  ClassAttributeMap.ClassAttributeMap ->
  CompressedWord.CompressedWord ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  BitGet.BitGet
    (Map.Map CompressedWord.CompressedWord U32.U32, Spawned)
bitGet :: Maybe Str
-> Version
-> ClassAttributeMap
-> CompressedWord
-> Map CompressedWord U32
-> BitGet (Map CompressedWord U32, Spawned)
bitGet Maybe Str
matchType Version
version ClassAttributeMap
classAttributeMap CompressedWord
actorId Map CompressedWord U32
actorMap =
  String
-> BitGet (Map CompressedWord U32, Spawned)
-> BitGet (Map CompressedWord U32, Spawned)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Spawned" (BitGet (Map CompressedWord U32, Spawned)
 -> BitGet (Map CompressedWord U32, Spawned))
-> BitGet (Map CompressedWord U32, Spawned)
-> BitGet (Map CompressedWord U32, Spawned)
forall a b. (a -> b) -> a -> b
$ do
    Bool
flag <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"flag" BitGet Bool
BitGet.bool
    Maybe U32
nameIndex <-
      String -> BitGet (Maybe U32) -> BitGet (Maybe U32)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"nameIndex" (BitGet (Maybe U32) -> BitGet (Maybe U32))
-> BitGet (Maybe U32) -> BitGet (Maybe U32)
forall a b. (a -> b) -> a -> b
$
        Bool -> Get BitString Identity U32 -> BitGet (Maybe U32)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Maybe Str -> Version -> Bool
hasNameIndex Maybe Str
matchType Version
version) Get BitString Identity U32
U32.bitGet
    Maybe Str
name <- ClassAttributeMap -> Maybe U32 -> BitGet (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe U32
nameIndex
    U32
objectId <- String -> Get BitString Identity U32 -> Get BitString Identity U32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"objectId" Get BitString Identity U32
U32.bitGet
    Str
objectName <- ClassAttributeMap -> U32 -> BitGet Str
lookupObjectName ClassAttributeMap
classAttributeMap U32
objectId
    Str
className <- Str -> BitGet Str
lookupClassName Str
objectName
    let hasLocation :: Bool
hasLocation = Str -> Bool
ClassAttributeMap.classHasLocation Str
className
    let hasRotation :: Bool
hasRotation = Str -> Bool
ClassAttributeMap.classHasRotation Str
className
    Initialization
initialization <-
      String -> BitGet Initialization -> BitGet Initialization
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"initialization" (BitGet Initialization -> BitGet Initialization)
-> BitGet Initialization -> BitGet Initialization
forall a b. (a -> b) -> a -> b
$
        Version -> Bool -> Bool -> BitGet Initialization
Initialization.bitGet Version
version Bool
hasLocation Bool
hasRotation
    (Map CompressedWord U32, Spawned)
-> BitGet (Map CompressedWord U32, Spawned)
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( CompressedWord
-> U32 -> Map CompressedWord U32 -> Map CompressedWord U32
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CompressedWord
actorId U32
objectId Map CompressedWord U32
actorMap,
        Spawned
          { Bool
flag :: Bool
flag :: Bool
flag,
            Maybe U32
nameIndex :: Maybe U32
nameIndex :: Maybe U32
nameIndex,
            Maybe Str
name :: Maybe Str
name :: Maybe Str
name,
            U32
objectId :: U32
objectId :: U32
objectId,
            Str
objectName :: Str
objectName :: Str
objectName,
            Str
className :: Str
className :: Str
className,
            Initialization
initialization :: Initialization
initialization :: Initialization
initialization
          }
      )

hasNameIndex :: Maybe Str.Str -> Version.Version -> Bool
hasNameIndex :: Maybe Str -> Version -> Bool
hasNameIndex Maybe Str
matchType Version
version =
  Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
20 Int
0 Version
version
    Bool -> Bool -> Bool
|| Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
14 Int
0 Version
version
      Bool -> Bool -> Bool
&& (Maybe Str
matchType Maybe Str -> Maybe Str -> Bool
forall a. Eq a => a -> a -> Bool
/= Str -> Maybe Str
forall a. a -> Maybe a
Just (String -> Str
Str.fromString String
"Lan"))

lookupName ::
  ClassAttributeMap.ClassAttributeMap ->
  Maybe U32.U32 ->
  BitGet.BitGet (Maybe Str.Str)
lookupName :: ClassAttributeMap -> Maybe U32 -> BitGet (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe U32
maybeNameIndex = case Maybe U32
maybeNameIndex of
  Maybe U32
Nothing -> Maybe Str -> BitGet (Maybe Str)
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Str
forall a. Maybe a
Nothing
  Just U32
nameIndex_ ->
    case IntMap Str -> U32 -> Maybe Str
ClassAttributeMap.getName
      (ClassAttributeMap -> IntMap Str
ClassAttributeMap.nameMap ClassAttributeMap
classAttributeMap)
      U32
nameIndex_ of
      Maybe Str
Nothing ->
        UnknownName -> BitGet (Maybe Str)
forall e a. Exception e => e -> BitGet a
BitGet.throw (UnknownName -> BitGet (Maybe Str))
-> (Word32 -> UnknownName) -> Word32 -> BitGet (Maybe Str)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> UnknownName
UnknownName.UnknownName (Word32 -> BitGet (Maybe Str)) -> Word32 -> BitGet (Maybe Str)
forall a b. (a -> b) -> a -> b
$ U32 -> Word32
U32.toWord32 U32
nameIndex_
      Just Str
name_ -> Maybe Str -> BitGet (Maybe Str)
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Str -> Maybe Str
forall a. a -> Maybe a
Just Str
name_)

lookupObjectName ::
  ClassAttributeMap.ClassAttributeMap -> U32.U32 -> BitGet.BitGet Str.Str
lookupObjectName :: ClassAttributeMap -> U32 -> BitGet Str
lookupObjectName ClassAttributeMap
classAttributeMap U32
objectId_ =
  case Map U32 Str -> U32 -> Maybe Str
ClassAttributeMap.getObjectName
    (ClassAttributeMap -> Map U32 Str
ClassAttributeMap.objectMap ClassAttributeMap
classAttributeMap)
    U32
objectId_ of
    Maybe Str
Nothing ->
      MissingObjectName -> BitGet Str
forall e a. Exception e => e -> BitGet a
BitGet.throw (MissingObjectName -> BitGet Str)
-> (Word32 -> MissingObjectName) -> Word32 -> BitGet Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> MissingObjectName
MissingObjectName.MissingObjectName (Word32 -> BitGet Str) -> Word32 -> BitGet Str
forall a b. (a -> b) -> a -> b
$
        U32 -> Word32
U32.toWord32
          U32
objectId_
    Just Str
objectName_ -> Str -> BitGet Str
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Str
objectName_

lookupClassName :: Str.Str -> BitGet.BitGet Str.Str
lookupClassName :: Str -> BitGet Str
lookupClassName Str
objectName_ =
  case Str -> Maybe Str
ClassAttributeMap.getClassName Str
objectName_ of
    Maybe Str
Nothing ->
      MissingClassName -> BitGet Str
forall e a. Exception e => e -> BitGet a
BitGet.throw (MissingClassName -> BitGet Str)
-> (String -> MissingClassName) -> String -> BitGet Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MissingClassName
MissingClassName.MissingClassName (String -> BitGet Str) -> String -> BitGet Str
forall a b. (a -> b) -> a -> b
$
        Str -> String
Str.toString
          Str
objectName_
    Just Str
className_ -> Str -> BitGet Str
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Str
className_