module Rattletrap.Type.Attribute where

import qualified Control.Exception as Exception
import qualified Data.Map as Map
import Prelude hiding (id)
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
  , Attribute -> Str
name :: Str.Str
  -- ^ Read-only! Changing an attribute's name requires editing the class
  -- attribute map.
  , 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 { CompressedWord
id :: CompressedWord
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
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
  -> ClassAttributeMap.ClassAttributeMap
  -> Map.Map CompressedWord.CompressedWord U32.U32
  -> CompressedWord.CompressedWord
  -> BitGet.BitGet Attribute
bitGet :: Version
-> ClassAttributeMap
-> Map CompressedWord U32
-> CompressedWord
-> BitGet Attribute
bitGet Version
version 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 -> Map U32 Str -> Str -> BitGet AttributeValue
AttributeValue.bitGet
    Version
version
    (ClassAttributeMap -> Map U32 Str
ClassAttributeMap.objectMap ClassAttributeMap
classes)
    Str
name
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute { CompressedWord
id :: CompressedWord
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