module Rattletrap.Type.Str where

import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import qualified Data.Int as Int
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Utility.Bytes as Bytes
import qualified Rattletrap.Utility.Json as Json

newtype Str
  = Str Text.Text
  deriving (Str -> Str -> Bool
(Str -> Str -> Bool) -> (Str -> Str -> Bool) -> Eq Str
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c== :: Str -> Str -> Bool
Eq, Eq Str
Eq Str
-> (Str -> Str -> Ordering)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Bool)
-> (Str -> Str -> Str)
-> (Str -> Str -> Str)
-> Ord Str
Str -> Str -> Bool
Str -> Str -> Ordering
Str -> Str -> Str
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Str -> Str -> Str
$cmin :: Str -> Str -> Str
max :: Str -> Str -> Str
$cmax :: Str -> Str -> Str
>= :: Str -> Str -> Bool
$c>= :: Str -> Str -> Bool
> :: Str -> Str -> Bool
$c> :: Str -> Str -> Bool
<= :: Str -> Str -> Bool
$c<= :: Str -> Str -> Bool
< :: Str -> Str -> Bool
$c< :: Str -> Str -> Bool
compare :: Str -> Str -> Ordering
$ccompare :: Str -> Str -> Ordering
$cp1Ord :: Eq Str
Ord, Int -> Str -> ShowS
[Str] -> ShowS
Str -> String
(Int -> Str -> ShowS)
-> (Str -> String) -> ([Str] -> ShowS) -> Show Str
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Str] -> ShowS
$cshowList :: [Str] -> ShowS
show :: Str -> String
$cshow :: Str -> String
showsPrec :: Int -> Str -> ShowS
$cshowsPrec :: Int -> Str -> ShowS
Show)

instance Json.FromJSON Str where
  parseJSON :: Value -> Parser Str
parseJSON = (Text -> Str) -> Parser Text -> Parser Str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Str
fromText (Parser Text -> Parser Str)
-> (Value -> Parser Text) -> Value -> Parser Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Str where
  toJSON :: Str -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Text -> Value) -> (Str -> Text) -> Str -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Text
toText

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"str" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"string"]

fromText :: Text.Text -> Str
fromText :: Text -> Str
fromText = Text -> Str
Str

toText :: Str -> Text.Text
toText :: Str -> Text
toText (Str Text
x) = Text
x

fromString :: String -> Str
fromString :: String -> Str
fromString = Text -> Str
fromText (Text -> Str) -> (String -> Text) -> String -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

toString :: Str -> String
toString :: Str -> String
toString = Text -> String
Text.unpack (Text -> String) -> (Str -> Text) -> Str -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Text
toText

bytePut :: Str -> BytePut.BytePut
bytePut :: Str -> BytePut
bytePut Str
text =
  let
    size :: I32
size = Str -> I32
getTextSize Str
text
    encode :: Text -> ByteString
encode = I32 -> Text -> ByteString
getTextEncoder I32
size
  in I32 -> BytePut
I32.bytePut I32
size BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (ByteString -> BytePut
BytePut.byteString (ByteString -> BytePut) -> (Text -> ByteString) -> Text -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encode (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addNull (Text -> BytePut) -> Text -> BytePut
forall a b. (a -> b) -> a -> b
$ Str -> Text
toText Str
text)

bitPut :: Str -> BitPut.BitPut
bitPut :: Str -> BitPut
bitPut = BytePut -> BitPut
BitPut.fromBytePut (BytePut -> BitPut) -> (Str -> BytePut) -> Str -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> BytePut
bytePut

getTextSize :: Str -> I32.I32
getTextSize :: Str -> I32
getTextSize Str
text =
  let
    value :: Text
value = Str -> Text
toText Str
text
    scale :: Int32
scale = if (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isLatin1 Text
value then Int32
1 else -Int32
1 :: Int.Int32
    rawSize :: Int32
rawSize = if Text -> Bool
Text.null Text
value
      then Int32
0
      else Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
value) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1 :: Int.Int32
    size :: Int32
size = if Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"\x00\x00\x00None"
      then Int32
0x05000000
      else Int32
scale Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
rawSize :: Int.Int32
  in Int32 -> I32
I32.fromInt32 Int32
size

getTextEncoder :: I32.I32 -> Text.Text -> ByteString.ByteString
getTextEncoder :: I32 -> Text -> ByteString
getTextEncoder I32
size Text
text = if I32 -> Int32
I32.toInt32 I32
size Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
  then Text -> ByteString
Text.encodeUtf16LE Text
text
  else Text -> ByteString
Bytes.encodeLatin1 Text
text

addNull :: Text.Text -> Text.Text
addNull :: Text -> Text
addNull Text
text = if Text -> Bool
Text.null Text
text then Text
text else Text -> Char -> Text
Text.snoc Text
text Char
'\x00'

byteGet :: ByteGet.ByteGet Str
byteGet :: ByteGet Str
byteGet = String -> ByteGet Str -> ByteGet Str
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Str" (ByteGet Str -> ByteGet Str) -> ByteGet Str -> ByteGet Str
forall a b. (a -> b) -> a -> b
$ do
  I32
size <- String -> ByteGet I32 -> ByteGet I32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"size" ByteGet I32
I32.byteGet
  ByteString
bytes <- String -> ByteGet ByteString -> ByteGet ByteString
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"value" (ByteGet ByteString -> ByteGet ByteString)
-> (Int -> ByteGet ByteString) -> Int -> ByteGet ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteGet ByteString
ByteGet.byteString (Int -> ByteGet ByteString) -> Int -> ByteGet ByteString
forall a b. (a -> b) -> a -> b
$ I32 -> Int
forall a. Integral a => I32 -> a
normalizeTextSize I32
size
  Str -> ByteGet Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Str -> ByteGet Str) -> (Text -> Str) -> Text -> ByteGet Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Str
fromText (Text -> Str) -> (Text -> Text) -> Text -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNull (Text -> ByteGet Str) -> Text -> ByteGet Str
forall a b. (a -> b) -> a -> b
$ I32 -> ByteString -> Text
getTextDecoder I32
size ByteString
bytes

bitGet :: BitGet.BitGet Str
bitGet :: BitGet Str
bitGet = do
  I32
rawSize <- BitGet I32
I32.bitGet
  ByteString
bytes <- Int -> BitGet ByteString
BitGet.byteString (I32 -> Int
forall a. Integral a => I32 -> a
normalizeTextSize I32
rawSize)
  Str -> BitGet Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Str
fromText (Text -> Text
dropNull (I32 -> ByteString -> Text
getTextDecoder I32
rawSize ByteString
bytes)))

normalizeTextSize :: Integral a => I32.I32 -> a
normalizeTextSize :: I32 -> a
normalizeTextSize I32
size = case I32 -> Int32
I32.toInt32 I32
size of
  Int32
0x05000000 -> a
8
  Int32
x -> if Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0 then (-a
2 a -> a -> a
forall a. Num a => a -> a -> a
* Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x) else Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x

getTextDecoder :: I32.I32 -> ByteString.ByteString -> Text.Text
getTextDecoder :: I32 -> ByteString -> Text
getTextDecoder I32
size ByteString
bytes =
  let
    decode :: ByteString -> Text
decode = if I32 -> Int32
I32.toInt32 I32
size Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
      then OnDecodeError -> ByteString -> Text
Text.decodeUtf16LEWith OnDecodeError
Text.lenientDecode
      else ByteString -> Text
Text.decodeLatin1
  in ByteString -> Text
decode ByteString
bytes

dropNull :: Text.Text -> Text.Text
dropNull :: Text -> Text
dropNull = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x00')