module Rattletrap.Type.Property where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.PropertyValue as PropertyValue
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Json as Json

data Property = Property
  { Property -> Str
kind :: Str.Str,
    -- | Not used.
    Property -> U32
size :: U32.U32,
    Property -> U32
index :: U32.U32,
    Property -> PropertyValue Property
value :: PropertyValue.PropertyValue Property
  }
  deriving (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> String
show :: Property -> String
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show)

instance Json.FromJSON Property where
  parseJSON :: Value -> Parser Property
parseJSON = String -> (Object -> Parser Property) -> Value -> Parser Property
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Property" ((Object -> Parser Property) -> Value -> Parser Property)
-> (Object -> Parser Property) -> Value -> Parser Property
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    kind <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"kind"
    size <- Json.required object "size"
    index <- Json.required object "index"
    value <- Json.required object "value"
    pure Property {kind, size, index, value}

instance Json.ToJSON Property where
  toJSON :: Property -> Value
toJSON Property
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"kind" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Property -> Str
kind Property
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"size" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Property -> U32
size Property
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"index" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Property -> U32
index Property
x,
        String -> PropertyValue Property -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"value" (PropertyValue Property -> (Key, Value))
-> PropertyValue Property -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Property -> PropertyValue Property
value Property
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"property" (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
"kind" (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
"size" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"index" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.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))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.ref (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
PropertyValue.schema Schema
schema, Bool
True)
      ]

bytePut :: Property -> BytePut.BytePut
bytePut :: Property -> BytePut
bytePut Property
x =
  Str -> BytePut
Str.bytePut (Property -> Str
kind Property
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Property -> U32
size Property
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Property -> U32
index Property
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Property -> BytePut) -> PropertyValue Property -> BytePut
forall a. (a -> BytePut) -> PropertyValue a -> BytePut
PropertyValue.bytePut
      Property -> BytePut
bytePut
      (Property -> PropertyValue Property
value Property
x)

byteGet :: ByteGet.ByteGet Property
byteGet :: ByteGet Property
byteGet = String -> ByteGet Property -> ByteGet Property
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Property" (ByteGet Property -> ByteGet Property)
-> ByteGet Property -> ByteGet Property
forall a b. (a -> b) -> a -> b
$ do
  kind <- String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"kind" ByteGet Str
Str.byteGet
  size <- ByteGet.label "size" U32.byteGet
  index <- ByteGet.label "index" U32.byteGet
  value <- ByteGet.label "value" $ PropertyValue.byteGet byteGet kind
  pure Property {kind, size, index, value}