module Rattletrap.Type.RemoteId.PlayStation where

import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Word as Word
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Bytes as Bytes
import qualified Rattletrap.Utility.Json as Json

data PlayStation = PlayStation
  { PlayStation -> Text
name :: Text.Text
  , PlayStation -> [Word8]
code :: [Word.Word8]
  }
  deriving (PlayStation -> PlayStation -> Bool
(PlayStation -> PlayStation -> Bool)
-> (PlayStation -> PlayStation -> Bool) -> Eq PlayStation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlayStation -> PlayStation -> Bool
$c/= :: PlayStation -> PlayStation -> Bool
== :: PlayStation -> PlayStation -> Bool
$c== :: PlayStation -> PlayStation -> Bool
Eq, Int -> PlayStation -> ShowS
[PlayStation] -> ShowS
PlayStation -> String
(Int -> PlayStation -> ShowS)
-> (PlayStation -> String)
-> ([PlayStation] -> ShowS)
-> Show PlayStation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlayStation] -> ShowS
$cshowList :: [PlayStation] -> ShowS
show :: PlayStation -> String
$cshow :: PlayStation -> String
showsPrec :: Int -> PlayStation -> ShowS
$cshowsPrec :: Int -> PlayStation -> ShowS
Show)

instance Json.FromJSON PlayStation where
  parseJSON :: Value -> Parser PlayStation
parseJSON Value
json = do
    (Text
name, [Word8]
code) <- Value -> Parser (Text, [Word8])
forall a. FromJSON a => Value -> Parser a
Json.parseJSON Value
json
    PlayStation -> Parser PlayStation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlayStation :: Text -> [Word8] -> PlayStation
PlayStation { Text
name :: Text
name :: Text
name, [Word8]
code :: [Word8]
code :: [Word8]
code }

instance Json.ToJSON PlayStation where
  toJSON :: PlayStation -> Value
toJSON PlayStation
x = (Text, [Word8]) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (PlayStation -> Text
name PlayStation
x, PlayStation -> [Word8]
code PlayStation
x)

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"remote-id-play-station" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
Schema.tuple
  [Schema -> Value
Schema.ref Schema
Schema.string, Schema -> Value
Schema.json (Schema -> Value) -> Schema -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
Schema.number]

bitPut :: PlayStation -> BitPut.BitPut
bitPut :: PlayStation -> BitPut
bitPut PlayStation
x =
  let
    nameBytes :: ByteString
nameBytes = Int -> ByteString -> ByteString
forall a. Integral a => a -> ByteString -> ByteString
Bytes.padBytes (Int
16 :: Int) (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Bytes.encodeLatin1 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ PlayStation -> Text
name PlayStation
x
    codeBytes :: ByteString
codeBytes = [Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ PlayStation -> [Word8]
code PlayStation
x
  in ByteString -> BitPut
BitPut.byteString ByteString
nameBytes BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> ByteString -> BitPut
BitPut.byteString ByteString
codeBytes

bitGet :: Version.Version -> BitGet.BitGet PlayStation
bitGet :: Version -> BitGet PlayStation
bitGet Version
version = String -> BitGet PlayStation -> BitGet PlayStation
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"PlayStation" (BitGet PlayStation -> BitGet PlayStation)
-> BitGet PlayStation -> BitGet PlayStation
forall a b. (a -> b) -> a -> b
$ do
  Text
name <- String -> BitGet Text -> BitGet Text
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"name" BitGet Text
getCode
  [Word8]
code <- String -> BitGet [Word8] -> BitGet [Word8]
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"code" (BitGet [Word8] -> BitGet [Word8])
-> BitGet [Word8] -> BitGet [Word8]
forall a b. (a -> b) -> a -> b
$ Version -> BitGet [Word8]
getName Version
version
  PlayStation -> BitGet PlayStation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlayStation :: Text -> [Word8] -> PlayStation
PlayStation { Text
name :: Text
name :: Text
name, [Word8]
code :: [Word8]
code :: [Word8]
code }

getCode :: BitGet.BitGet Text.Text
getCode :: BitGet Text
getCode = (ByteString -> Text)
-> Get BitString Identity ByteString -> BitGet Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x00') (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1)
  (Get BitString Identity ByteString -> BitGet Text)
-> Get BitString Identity ByteString -> BitGet Text
forall a b. (a -> b) -> a -> b
$ Int -> Get BitString Identity ByteString
BitGet.byteString Int
16

getName :: Version.Version -> BitGet.BitGet [Word.Word8]
getName :: Version -> BitGet [Word8]
getName Version
version =
  (ByteString -> [Word8])
-> Get BitString Identity ByteString -> BitGet [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Word8]
ByteString.unpack
    (Get BitString Identity ByteString -> BitGet [Word8])
-> (Int -> Get BitString Identity ByteString)
-> Int
-> BitGet [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get BitString Identity ByteString
BitGet.byteString
    (Int -> BitGet [Word8]) -> Int -> BitGet [Word8]
forall a b. (a -> b) -> a -> b
$ if Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
20 Int
1 Version
version then Int
24 else Int
16