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
  , Property -> U64
size :: U64.U64
  -- ^ Not used.
  , 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
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: 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
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 = 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 (f :: * -> *) a. Applicative f => a -> f a
pure Property :: Str -> U64 -> PropertyValue Property -> Property
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 = [Pair] -> Value
Json.object
    [ String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"kind" (Str -> Pair) -> Str -> Pair
forall a b. (a -> b) -> a -> b
$ Property -> Str
kind Property
x
    , String -> U64 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" (U64 -> Pair) -> U64 -> Pair
forall a b. (a -> b) -> a -> b
$ Property -> U64
size Property
x
    , String -> PropertyValue Property -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" (PropertyValue Property -> Pair) -> PropertyValue Property -> Pair
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
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"kind" (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
"size" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U64.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.ref (Schema -> Pair) -> Schema -> Pair
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 (f :: * -> *) a. Applicative f => a -> f a
pure Property :: Str -> U64 -> PropertyValue Property -> Property
Property { Str
kind :: Str
kind :: Str
kind, U64
size :: U64
size :: U64
size, PropertyValue Property
value :: PropertyValue Property
value :: PropertyValue Property
value }