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.Type.U8 as U8
import qualified Rattletrap.Utility.Json as Json

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

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

instance Json.ToJSON Byte where
  toJSON :: Byte -> Value
toJSON Byte
byte = (Str, Maybe (Either U8 Str)) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Byte -> Str
key Byte
byte, Byte -> Maybe (Either U8 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,
        [Value] -> Value
Schema.oneOf
          [ Schema -> Value
Schema.ref Schema
Schema.null,
            [((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
"Left" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True)],
            [((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
"Right" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True)]
          ]
      ]

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
<> (Either U8 Str -> BytePut) -> Maybe (Either U8 Str) -> BytePut
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((U8 -> BytePut) -> (Str -> BytePut) -> Either U8 Str -> BytePut
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either U8 -> BytePut
U8.bytePut Str -> BytePut
Str.bytePut) (Byte -> Maybe (Either U8 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
  key <- String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"key" ByteGet Str
Str.byteGet
  let isSteam = Str
key Str -> Str -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Str
Str.fromString String
"OnlinePlatform_Steam"
      isPlayStation = Str
key Str -> Str -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Str
Str.fromString String
"OnlinePlatform_PS4"
      isNone = Str
key Str -> Str -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Str
Str.fromString String
"None"
  value <-
    ByteGet.label "value" $
      if isSteam || isPlayStation
        then pure Nothing
        else
          if isNone
            then Just . Left <$> U8.byteGet
            else Just . Right <$> Str.byteGet
  pure Byte {key, value}