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.U64 as U64
import qualified Rattletrap.Utility.Json as Json

data Property = Property
  { Property -> Str
kind :: Str.Str,
    -- | Not used.
    Property -> U64
size :: U64.U64,
    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
    Str
kind <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"kind"
    U64
size <- Object -> String -> Parser U64
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"size"
    PropertyValue Property
value <- Object -> String -> Parser (PropertyValue Property)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"value"
    Property -> Parser Property
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Property {Str
kind :: Str
kind :: Str
kind, U64
size :: U64
size :: U64
size, PropertyValue Property
value :: PropertyValue Property
value :: PropertyValue Property
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 -> U64 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"size" (U64 -> (Key, Value)) -> U64 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Property -> U64
size 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
U64.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
<> U64 -> BytePut
U64.bytePut (Property -> U64
size 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
  Str
kind <- String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"kind" ByteGet Str
Str.byteGet
  U64
size <- String -> ByteGet U64 -> ByteGet U64
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"size" ByteGet U64
U64.byteGet
  PropertyValue Property
value <- String
-> ByteGet (PropertyValue Property)
-> ByteGet (PropertyValue Property)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"value" (ByteGet (PropertyValue Property)
 -> ByteGet (PropertyValue Property))
-> ByteGet (PropertyValue Property)
-> ByteGet (PropertyValue Property)
forall a b. (a -> b) -> a -> b
$ ByteGet Property -> Str -> ByteGet (PropertyValue Property)
forall a. ByteGet a -> Str -> ByteGet (PropertyValue a)
PropertyValue.byteGet ByteGet Property
byteGet Str
kind
  Property -> ByteGet Property
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Property {Str
kind :: Str
kind :: Str
kind, U64
size :: U64
size :: U64
size, PropertyValue Property
value :: PropertyValue Property
value :: PropertyValue Property
value}