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
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
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) <- forall a. FromJSON a => Value -> Parser a
Json.parseJSON Value
json
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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" forall a b. (a -> b) -> a -> b
$
    [Value] -> Value
Schema.tuple
      [Schema -> Value
Schema.ref Schema
Str.schema, Schema -> Value
Schema.json 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) forall a. Semigroup a => a -> a -> a
<> 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 = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Byte" forall a b. (a -> b) -> a -> b
$ do
  Str
key <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"key" ByteGet Str
Str.byteGet
  let isSteam :: Bool
isSteam = Str
key forall a. Eq a => a -> a -> Bool
== String -> Str
Str.fromString String
"OnlinePlatform_Steam"
      isPlayStation :: Bool
isPlayStation = Str
key forall a. Eq a => a -> a -> Bool
== String -> Str
Str.fromString String
"OnlinePlatform_PS4"
  Maybe Str
value <-
    forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"value" forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Bool
isSteam Bool -> Bool -> Bool
|| Bool
isPlayStation) ByteGet Str
Str.byteGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Byte {Str
key :: Str
key :: Str
key, Maybe Str
value :: Maybe Str
value :: Maybe Str
value}