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

instance Json.FromJSON Property where
  parseJSON :: Value -> Parser Property
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Property" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Str
kind <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"kind"
    U64
size <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"size"
    PropertyValue Property
value <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"value"
    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
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"kind" forall a b. (a -> b) -> a -> b
$ Property -> Str
kind Property
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" forall a b. (a -> b) -> a -> b
$ Property -> U64
size Property
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"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" 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
"kind" 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
"size" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U64.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.ref 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)
    forall a. Semigroup a => a -> a -> a
<> U64 -> BytePut
U64.bytePut (Property -> U64
size Property
x)
    forall a. Semigroup a => a -> a -> a
<> 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 = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Property" forall a b. (a -> b) -> a -> b
$ do
  Str
kind <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"kind" ByteGet Str
Str.byteGet
  U64
size <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"size" ByteGet U64
U64.byteGet
  PropertyValue Property
value <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"value" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> Str -> ByteGet (PropertyValue a)
PropertyValue.byteGet ByteGet Property
byteGet Str
kind
  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}