module Rattletrap.Type.ClassMapping where

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

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

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

instance Json.ToJSON ClassMapping where
  toJSON :: ClassMapping -> Value
toJSON ClassMapping
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
"name" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ClassMapping -> Str
name ClassMapping
x, String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"stream_id" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ClassMapping -> U32
streamId ClassMapping
x]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"classMapping" (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
"name" (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
"stream_id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
      ]

bytePut :: ClassMapping -> BytePut.BytePut
bytePut :: ClassMapping -> BytePut
bytePut ClassMapping
x = Str -> BytePut
Str.bytePut (ClassMapping -> Str
name ClassMapping
x) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (ClassMapping -> U32
streamId ClassMapping
x)

byteGet :: ByteGet.ByteGet ClassMapping
byteGet :: ByteGet ClassMapping
byteGet = String -> ByteGet ClassMapping -> ByteGet ClassMapping
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"ClassMapping" (ByteGet ClassMapping -> ByteGet ClassMapping)
-> ByteGet ClassMapping -> ByteGet ClassMapping
forall a b. (a -> b) -> a -> b
$ do
  Str
name <- String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"name" ByteGet Str
Str.byteGet
  U32
streamId <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"streamId" ByteGet U32
U32.byteGet
  ClassMapping -> ByteGet ClassMapping
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClassMapping {Str
name :: Str
name :: Str
name, U32
streamId :: U32
streamId :: U32
streamId}