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
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
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
Ord, Int -> Str -> ShowS
[Str] -> ShowS
Str -> String
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Str
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Str where
  toJSON :: Str -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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" forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [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 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 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 forall a. Semigroup a => a -> a -> a
<> (ByteString -> BytePut
BytePut.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addNull forall a b. (a -> b) -> a -> b
$ Str -> Text
toText Str
text)

bitPut :: Str -> BitPut.BitPut
bitPut :: Str -> BitPut
bitPut = BytePut -> BitPut
BitPut.fromBytePut 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 forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
value) forall a. Num a => a -> a -> a
+ Int32
1 :: Int.Int32
      size :: Int32
size =
        if Text
value forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"\x00\x00\x00None"
          then Int32
0x05000000
          else Int32
scale 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 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 = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Str" forall a b. (a -> b) -> a -> b
$ do
  I32
size <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"size" ByteGet I32
I32.byteGet
  ByteString
bytes <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"value" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ByteString Identity ByteString
ByteGet.byteString forall a b. (a -> b) -> a -> b
$ forall a. Integral a => I32 -> a
normalizeTextSize I32
size
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Str
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNull 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 (forall a. Integral a => I32 -> a
normalizeTextSize I32
rawSize)
  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 :: forall a. Integral a => I32 -> a
normalizeTextSize I32
size = case I32 -> Int32
I32.toInt32 I32
size of
  Int32
0x05000000 -> a
8
  Int32
x -> if Int32
x forall a. Ord a => a -> a -> Bool
< Int32
0 then (-a
2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x) else 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 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 (forall a. Eq a => a -> a -> Bool
== Char
'\x00')