module Rattletrap.Type.Message 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 Message = Message
  { -- | Which frame this message belongs to, starting from 0.
    Message -> U32
frame :: U32.U32,
    -- | The primary player's name.
    Message -> Str
name :: Str.Str,
    -- | The content of the message.
    Message -> Str
value :: Str.Str
  }
  deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

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

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

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

bytePut :: Message -> BytePut.BytePut
bytePut :: Message -> BytePut
bytePut Message
x =
  U32 -> BytePut
U32.bytePut (Message -> U32
frame Message
x) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> Str -> BytePut
Str.bytePut (Message -> Str
name Message
x) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> Str -> BytePut
Str.bytePut (Message -> Str
value Message
x)

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