module Rattletrap.Type.Property.Byte 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.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

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

instance Json.FromJSON Byte where
  parseJSON :: Value -> Parser Byte
parseJSON Value
json = do
    (Str
key, Maybe Str
value) <- Value -> Parser (Str, Maybe Str)
forall a. FromJSON a => Value -> Parser a
Json.parseJSON Value
json
    Byte -> Parser Byte
forall (f :: * -> *) a. Applicative f => a -> f a
pure Byte :: Str -> Maybe Str -> Byte
Byte { Str
key :: Str
key :: Str
key, Maybe Str
value :: Maybe Str
value :: Maybe Str
value }

instance Json.ToJSON Byte where
  toJSON :: Byte -> Value
toJSON Byte
byte = (Str, Maybe Str) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Byte -> Str
key Byte
byte, Byte -> Maybe Str
value Byte
byte)

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"property-byte" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
Schema.tuple
  [Schema -> Value
Schema.ref Schema
Str.schema, Schema -> Value
Schema.json (Schema -> Value) -> Schema -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Str.schema]

bytePut :: Byte -> BytePut.BytePut
bytePut :: Byte -> BytePut
bytePut Byte
byte = Str -> BytePut
Str.bytePut (Byte -> Str
key Byte
byte) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Str -> BytePut) -> Maybe Str -> BytePut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Str -> BytePut
Str.bytePut (Byte -> Maybe Str
value Byte
byte)

byteGet :: ByteGet.ByteGet Byte
byteGet :: ByteGet Byte
byteGet = String -> ByteGet Byte -> ByteGet Byte
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Byte" (ByteGet Byte -> ByteGet Byte) -> ByteGet Byte -> ByteGet Byte
forall a b. (a -> b) -> a -> b
$ do
  Str
key <- String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"key" ByteGet Str
Str.byteGet
  Maybe Str
value <- String -> ByteGet (Maybe Str) -> ByteGet (Maybe Str)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"value" (ByteGet (Maybe Str) -> ByteGet (Maybe Str))
-> ByteGet (Maybe Str) -> ByteGet (Maybe Str)
forall a b. (a -> b) -> a -> b
$ Bool -> ByteGet Str -> ByteGet (Maybe Str)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe
    (Str -> String
Str.toString Str
key String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"OnlinePlatform_Steam")
    ByteGet Str
Str.byteGet
  Byte -> ByteGet Byte
forall (f :: * -> *) a. Applicative f => a -> f a
pure Byte :: Str -> Maybe Str -> Byte
Byte { Str
key :: Str
key :: Str
key, Maybe Str
value :: Maybe Str
value :: Maybe Str
value }