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

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

instance Json.ToJSON Attribute where
  toJSON :: Attribute -> Value
toJSON Attribute
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> CompressedWord -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"id" (CompressedWord -> (Key, Value)) -> CompressedWord -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Attribute -> CompressedWord
Rattletrap.Type.Attribute.id Attribute
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Attribute -> Str
name Attribute
x,
        String -> AttributeValue -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"value" (AttributeValue -> (Key, Value)) -> AttributeValue -> (Key, 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" (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
"id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"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
"value" (Value -> (Key, Value)) -> Value -> (Key, 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)
    BitPut -> BitPut -> BitPut
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 =
  String -> BitGet Attribute -> BitGet Attribute
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Attribute" (BitGet Attribute -> BitGet Attribute)
-> BitGet Attribute -> BitGet Attribute
forall a b. (a -> b) -> a -> b
$ do
    attributes <- ClassAttributeMap
-> Map CompressedWord U32 -> CompressedWord -> BitGet (Map U32 U32)
lookupAttributeMap ClassAttributeMap
classes Map CompressedWord U32
actors CompressedWord
actor
    limit <- lookupAttributeIdLimit attributes actor
    id_ <- BitGet.label "id" $ CompressedWord.bitGet limit
    name <- lookupAttributeName classes attributes id_
    value <-
      BitGet.label "value" $
        AttributeValue.bitGet
          version
          buildVersion
          (ClassAttributeMap.objectMap classes)
          name
    pure Attribute {Rattletrap.Type.Attribute.id = id_, name, 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 =
  UnknownActor -> Maybe (Map U32 U32) -> BitGet (Map U32 U32)
forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe
    (Word -> UnknownActor
UnknownActor.UnknownActor (Word -> UnknownActor) -> Word -> 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 =
  MissingAttributeLimit -> Maybe Word -> BitGet Word
forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe
    (Word -> MissingAttributeLimit
MissingAttributeLimit.MissingAttributeLimit (Word -> MissingAttributeLimit) -> Word -> 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 =
  MissingAttributeName -> Maybe Str -> BitGet Str
forall e a. Exception e => e -> Maybe a -> BitGet a
fromMaybe
    (Word -> MissingAttributeName
MissingAttributeName.MissingAttributeName (Word -> MissingAttributeName) -> Word -> 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 = BitGet a -> (a -> BitGet a) -> Maybe a -> BitGet a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> BitGet a
forall e a. Exception e => e -> BitGet a
BitGet.throw e
message) a -> BitGet a
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure