module Rattletrap.Type.Attribute where

import qualified Control.Exception as Exception
import qualified Data.Map as Map
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Exception.MissingAttributeLimit as MissingAttributeLimit
import qualified Rattletrap.Exception.MissingAttributeName as MissingAttributeName
import qualified Rattletrap.Exception.UnknownActor as UnknownActor
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.AttributeValue as AttributeValue
import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap
import qualified Rattletrap.Type.CompressedWord as CompressedWord
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 Attribute = Attribute
  { Attribute -> CompressedWord
id :: CompressedWord.CompressedWord,
    -- | Read-only! Changing an attribute's name requires editing the class
    -- attribute map.
    Attribute -> Str
name :: Str.Str,
    Attribute -> AttributeValue
value :: AttributeValue.AttributeValue
  }
  deriving (Attribute -> Attribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show)

instance Json.FromJSON Attribute where
  parseJSON :: Value -> Parser Attribute
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Attribute" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    CompressedWord
id_ <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"id"
    Str
name <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"name"
    AttributeValue
value <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"value"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute {id :: CompressedWord
Rattletrap.Type.Attribute.id = CompressedWord
id_, Str
name :: Str
name :: Str
name, AttributeValue
value :: AttributeValue
value :: AttributeValue
value}

instance Json.ToJSON Attribute where
  toJSON :: Attribute -> Value
toJSON Attribute
x =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" forall a b. (a -> b) -> a -> b
$ Attribute -> CompressedWord
Rattletrap.Type.Attribute.id Attribute
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" forall a b. (a -> b) -> a -> b
$ Attribute -> Str
name Attribute
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" forall a b. (a -> b) -> a -> b
$ Attribute -> AttributeValue
value Attribute
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute" 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
"id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"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
"value" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
AttributeValue.schema, Bool
True)
      ]

bitPut :: Attribute -> BitPut.BitPut
bitPut :: Attribute -> BitPut
bitPut Attribute
attribute =
  CompressedWord -> BitPut
CompressedWord.bitPut (Attribute -> CompressedWord
Rattletrap.Type.Attribute.id Attribute
attribute)
    forall a. Semigroup a => a -> a -> a
<> AttributeValue -> BitPut
AttributeValue.bitPut (Attribute -> AttributeValue
value Attribute
attribute)

bitGet ::
  Version.Version ->
  Maybe Str.Str ->
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  CompressedWord.CompressedWord ->
  BitGet.BitGet Attribute
bitGet :: Version
-> Maybe Str
-> ClassAttributeMap
-> Map CompressedWord U32
-> CompressedWord
-> BitGet Attribute
bitGet Version
version Maybe Str
buildVersion ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor =
  forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Attribute" forall a b. (a -> b) -> a -> b
$ do
    Map U32 U32
attributes <- ClassAttributeMap
-> Map CompressedWord U32 -> CompressedWord -> BitGet (Map U32 U32)
lookupAttributeMap ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor
    Word
limit <- Map U32 U32 -> CompressedWord -> BitGet Word
lookupAttributeIdLimit Map U32 U32
attributes CompressedWord
actor
    CompressedWord
id_ <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"id" forall a b. (a -> b) -> a -> b
$ Word -> BitGet CompressedWord
CompressedWord.bitGet Word
limit
    Str
name <- ClassAttributeMap -> Map U32 U32 -> CompressedWord -> BitGet Str
lookupAttributeName ClassAttributeMap
classes Map U32 U32
attributes CompressedWord
id_
    AttributeValue
value <-
      forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" forall a b. (a -> b) -> a -> b
$
        Version -> Maybe Str -> Map U32 Str -> Str -> BitGet AttributeValue
AttributeValue.bitGet
          Version
version
          Maybe Str
buildVersion
          (ClassAttributeMap -> Map U32 Str
ClassAttributeMap.objectMap ClassAttributeMap
classes)
          Str
name
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute {id :: CompressedWord
Rattletrap.Type.Attribute.id = CompressedWord
id_, Str
name :: Str
name :: Str
name, AttributeValue
value :: AttributeValue
value :: AttributeValue
value}

lookupAttributeMap ::
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  CompressedWord.CompressedWord ->
  BitGet.BitGet (Map.Map U32.U32 U32.U32)
lookupAttributeMap :: ClassAttributeMap
-> Map CompressedWord U32 -> CompressedWord -> BitGet (Map U32 U32)
lookupAttributeMap ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor =
  forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe
    (Word -> UnknownActor
UnknownActor.UnknownActor forall a b. (a -> b) -> a -> b
$ CompressedWord -> Word
CompressedWord.value CompressedWord
actor)
    (ClassAttributeMap
-> Map CompressedWord U32 -> CompressedWord -> Maybe (Map U32 U32)
ClassAttributeMap.getAttributeMap ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor)

lookupAttributeIdLimit ::
  Map.Map U32.U32 U32.U32 ->
  CompressedWord.CompressedWord ->
  BitGet.BitGet Word
lookupAttributeIdLimit :: Map U32 U32 -> CompressedWord -> BitGet Word
lookupAttributeIdLimit Map U32 U32
attributes CompressedWord
actor =
  forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe
    (Word -> MissingAttributeLimit
MissingAttributeLimit.MissingAttributeLimit forall a b. (a -> b) -> a -> b
$ CompressedWord -> Word
CompressedWord.value CompressedWord
actor)
    (Map U32 U32 -> Maybe Word
ClassAttributeMap.getAttributeIdLimit Map U32 U32
attributes)

lookupAttributeName ::
  ClassAttributeMap.ClassAttributeMap ->
  Map.Map U32.U32 U32.U32 ->
  CompressedWord.CompressedWord ->
  BitGet.BitGet Str.Str
lookupAttributeName :: ClassAttributeMap -> Map U32 U32 -> CompressedWord -> BitGet Str
lookupAttributeName ClassAttributeMap
classes Map U32 U32
attributes CompressedWord
attribute =
  forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe
    (Word -> MissingAttributeName
MissingAttributeName.MissingAttributeName forall a b. (a -> b) -> a -> b
$ CompressedWord -> Word
CompressedWord.value CompressedWord
attribute)
    (ClassAttributeMap -> Map U32 U32 -> CompressedWord -> Maybe Str
ClassAttributeMap.getAttributeName ClassAttributeMap
classes Map U32 U32
attributes CompressedWord
attribute)

fromMaybe :: (Exception.Exception e) => e -> Maybe a -> BitGet.BitGet a
fromMaybe :: forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe e
message = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> BitGet a
BitGet.throw e
message) forall (f :: * -> *) a. Applicative f => a -> f a
pure