module Rattletrap.Type.Attribute where

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.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
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
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
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
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 = 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
    CompressedWord
id <- Object -> String -> Parser CompressedWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"id"
    Str
name <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"name"
    AttributeValue
value <- Object -> String -> Parser AttributeValue
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"value"
    Attribute -> Parser Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute :: CompressedWord -> Str -> AttributeValue -> Attribute
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 = [Pair] -> Value
Json.object
    [ String -> CompressedWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" (CompressedWord -> Pair) -> CompressedWord -> Pair
forall a b. (a -> b) -> a -> b
$ Attribute -> CompressedWord
id Attribute
x
    , String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" (Str -> Pair) -> Str -> Pair
forall a b. (a -> b) -> a -> b
$ Attribute -> Str
name Attribute
x
    , String -> AttributeValue -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" (AttributeValue -> Pair) -> AttributeValue -> Pair
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
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" (Value -> Pair) -> Value -> Pair
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
  -> 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 = 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
attribute <- Word -> BitGet CompressedWord
CompressedWord.bitGet Word
limit
  Str
name_ <- ClassAttributeMap -> Map U32 U32 -> CompressedWord -> BitGet Str
lookupAttributeName ClassAttributeMap
classes Map U32 U32
attributes CompressedWord
attribute
  CompressedWord -> Str -> AttributeValue -> Attribute
Attribute CompressedWord
attribute Str
name_
    (AttributeValue -> Attribute)
-> BitGet AttributeValue -> BitGet Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Map U32 Str -> Str -> BitGet AttributeValue
AttributeValue.bitGet
          Version
version
          (ClassAttributeMap -> Map U32 Str
ClassAttributeMap.objectMap ClassAttributeMap
classes)
          Str
name_

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 = String -> Maybe (Map U32 U32) -> BitGet (Map U32 U32)
forall a. String -> Maybe a -> BitGet a
fromMaybe
  (String
"[RT01] could not get attribute map for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CompressedWord -> String
forall a. Show a => a -> String
show 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 = String -> Maybe Word -> BitGet Word
forall a. String -> Maybe a -> BitGet a
fromMaybe
  (String
"[RT02] could not get attribute ID limit for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CompressedWord -> String
forall a. Show a => a -> String
show 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 = String -> Maybe Str -> BitGet Str
forall a. String -> Maybe a -> BitGet a
fromMaybe
  (String
"[RT03] could not get attribute name for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CompressedWord -> String
forall a. Show a => a -> String
show CompressedWord
attribute)
  (ClassAttributeMap -> Map U32 U32 -> CompressedWord -> Maybe Str
ClassAttributeMap.getAttributeName ClassAttributeMap
classes Map U32 U32
attributes CompressedWord
attribute)

fromMaybe :: String -> Maybe a -> BitGet.BitGet a
fromMaybe :: String -> Maybe a -> BitGet a
fromMaybe String
message = BitGet a -> (a -> BitGet a) -> Maybe a -> BitGet a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> BitGet a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
message) a -> BitGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure