module Rattletrap.Type.Mark 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 Mark = Mark
  { -- | Which type of mark this is, like @Team0Goal@.
    Mark -> Str
value :: Str.Str,
    -- | Which frame this mark belongs to, starting from 0.
    Mark -> U32
frame :: U32.U32
  }
  deriving (Mark -> Mark -> Bool
(Mark -> Mark -> Bool) -> (Mark -> Mark -> Bool) -> Eq Mark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mark -> Mark -> Bool
== :: Mark -> Mark -> Bool
$c/= :: Mark -> Mark -> Bool
/= :: Mark -> Mark -> Bool
Eq, Int -> Mark -> ShowS
[Mark] -> ShowS
Mark -> String
(Int -> Mark -> ShowS)
-> (Mark -> String) -> ([Mark] -> ShowS) -> Show Mark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mark -> ShowS
showsPrec :: Int -> Mark -> ShowS
$cshow :: Mark -> String
show :: Mark -> String
$cshowList :: [Mark] -> ShowS
showList :: [Mark] -> ShowS
Show)

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

instance Json.ToJSON Mark where
  toJSON :: Mark -> Value
toJSON Mark
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
"value" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Mark -> Str
value Mark
x, 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
$ Mark -> U32
frame Mark
x]

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

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

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