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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spawned -> Spawned -> Bool
$c/= :: Spawned -> Spawned -> Bool
== :: Spawned -> Spawned -> Bool
$c== :: Spawned -> Spawned -> Bool
Eq, Int -> Spawned -> ShowS
[Spawned] -> ShowS
Spawned -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spawned] -> ShowS
$cshowList :: [Spawned] -> ShowS
show :: Spawned -> String
$cshow :: Spawned -> String
showsPrec :: Int -> Spawned -> ShowS
$cshowsPrec :: Int -> Spawned -> ShowS
Show)

instance Json.FromJSON Spawned where
  parseJSON :: Value -> Parser Spawned
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Spawned" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
flag <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flag"
    Maybe U32
nameIndex <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name_index"
    Maybe Str
name <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name"
    U32
objectId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_id"
    Str
objectName <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_name"
    Str
className <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_name"
    Initialization
initialization <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"initialization"
    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
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flag" forall a b. (a -> b) -> a -> b
$ Spawned -> Bool
flag Spawned
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name_index" forall a b. (a -> b) -> a -> b
$ Spawned -> Maybe U32
nameIndex Spawned
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" forall a b. (a -> b) -> a -> b
$ Spawned -> Maybe Str
name Spawned
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_id" forall a b. (a -> b) -> a -> b
$ Spawned -> U32
objectId Spawned
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_name" forall a b. (a -> b) -> a -> b
$ Spawned -> Str
objectName Spawned
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_name" forall a b. (a -> b) -> a -> b
$ Spawned -> Str
className Spawned
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"initialization" 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" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flag" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name_index" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
U32.schema, Bool
False),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Str.schema, Bool
False),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_name" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_name" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"initialization" 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)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap U32 -> BitPut
U32.bitPut (Spawned -> Maybe U32
nameIndex Spawned
spawnedReplication)
    forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (Spawned -> U32
objectId Spawned
spawnedReplication)
    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 =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Spawned" forall a b. (a -> b) -> a -> b
$ do
    Bool
flag <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"flag" BitGet Bool
BitGet.bool
    Maybe U32
nameIndex <-
      forall a. String -> BitGet a -> BitGet a
BitGet.label String
"nameIndex" forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Maybe Str -> Version -> Bool
hasNameIndex Maybe Str
matchType Version
version) BitGet U32
U32.bitGet
    Maybe Str
name <- ClassAttributeMap -> Maybe U32 -> BitGet (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe U32
nameIndex
    U32
objectId <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"objectId" BitGet 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 <-
      forall a. String -> BitGet a -> BitGet a
BitGet.label String
"initialization" forall a b. (a -> b) -> a -> b
$
        Version -> Bool -> Bool -> BitGet Initialization
Initialization.bitGet Version
version Bool
hasLocation Bool
hasRotation
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( 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 forall a. Eq a => a -> a -> Bool
/= 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 ->
        forall e a. Exception e => e -> BitGet a
BitGet.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> UnknownName
UnknownName.UnknownName forall a b. (a -> b) -> a -> b
$ U32 -> Word32
U32.toWord32 U32
nameIndex_
      Just Str
name_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 ->
      forall e a. Exception e => e -> BitGet a
BitGet.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> MissingObjectName
MissingObjectName.MissingObjectName forall a b. (a -> b) -> a -> b
$
        U32 -> Word32
U32.toWord32
          U32
objectId_
    Just Str
objectName_ -> 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 ->
      forall e a. Exception e => e -> BitGet a
BitGet.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MissingClassName
MissingClassName.MissingClassName forall a b. (a -> b) -> a -> b
$
        Str -> String
Str.toString
          Str
objectName_
    Just Str
className_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Str
className_