module Rattletrap.Type.AttributeMapping where

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

data AttributeMapping = AttributeMapping
  { AttributeMapping -> U32
objectId :: U32.U32
  , AttributeMapping -> U32
streamId :: U32.U32
  }
  deriving (AttributeMapping -> AttributeMapping -> Bool
(AttributeMapping -> AttributeMapping -> Bool)
-> (AttributeMapping -> AttributeMapping -> Bool)
-> Eq AttributeMapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeMapping -> AttributeMapping -> Bool
$c/= :: AttributeMapping -> AttributeMapping -> Bool
== :: AttributeMapping -> AttributeMapping -> Bool
$c== :: AttributeMapping -> AttributeMapping -> Bool
Eq, Int -> AttributeMapping -> ShowS
[AttributeMapping] -> ShowS
AttributeMapping -> String
(Int -> AttributeMapping -> ShowS)
-> (AttributeMapping -> String)
-> ([AttributeMapping] -> ShowS)
-> Show AttributeMapping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeMapping] -> ShowS
$cshowList :: [AttributeMapping] -> ShowS
show :: AttributeMapping -> String
$cshow :: AttributeMapping -> String
showsPrec :: Int -> AttributeMapping -> ShowS
$cshowsPrec :: Int -> AttributeMapping -> ShowS
Show)

instance Json.FromJSON AttributeMapping where
  parseJSON :: Value -> Parser AttributeMapping
parseJSON = String
-> (Object -> Parser AttributeMapping)
-> Value
-> Parser AttributeMapping
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"AttributeMapping" ((Object -> Parser AttributeMapping)
 -> Value -> Parser AttributeMapping)
-> (Object -> Parser AttributeMapping)
-> Value
-> Parser AttributeMapping
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    U32
objectId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_id"
    U32
streamId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stream_id"
    AttributeMapping -> Parser AttributeMapping
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeMapping :: U32 -> U32 -> AttributeMapping
AttributeMapping { U32
objectId :: U32
objectId :: U32
objectId, U32
streamId :: U32
streamId :: U32
streamId }

instance Json.ToJSON AttributeMapping where
  toJSON :: AttributeMapping -> Value
toJSON AttributeMapping
x = [Pair] -> Value
Json.object
    [String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_id" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ AttributeMapping -> U32
objectId AttributeMapping
x, String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stream_id" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ AttributeMapping -> U32
streamId AttributeMapping
x]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attributeMapping" (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
"object_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stream_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  ]

bytePut :: AttributeMapping -> BytePut.BytePut
bytePut :: AttributeMapping -> BytePut
bytePut AttributeMapping
x = U32 -> BytePut
U32.bytePut (AttributeMapping -> U32
objectId AttributeMapping
x) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (AttributeMapping -> U32
streamId AttributeMapping
x)

byteGet :: ByteGet.ByteGet AttributeMapping
byteGet :: ByteGet AttributeMapping
byteGet = String -> ByteGet AttributeMapping -> ByteGet AttributeMapping
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"AttributeMapping" (ByteGet AttributeMapping -> ByteGet AttributeMapping)
-> ByteGet AttributeMapping -> ByteGet AttributeMapping
forall a b. (a -> b) -> a -> b
$ do
  U32
objectId <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"objectId" ByteGet U32
U32.byteGet
  U32
streamId <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"streamId" ByteGet U32
U32.byteGet
  AttributeMapping -> ByteGet AttributeMapping
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeMapping :: U32 -> U32 -> AttributeMapping
AttributeMapping { U32
objectId :: U32
objectId :: U32
objectId, U32
streamId :: U32
streamId :: U32
streamId }