module Rattletrap.Decode.Str
  ( decodeStr
  , decodeStrBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Int32le
import Rattletrap.Type.Int32le
import Rattletrap.Type.Str
import Rattletrap.Utility.Bytes

import qualified Data.ByteString as Bytes
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import qualified Debug.Trace as Debug

decodeStr :: Decode Str
decodeStr :: Decode Str
decodeStr = do
  Int32le
rawSize <- Decode Int32le
decodeInt32le
  ByteString
bytes <- Int -> Get ByteString
getByteString (Int32le -> Int
forall a. Integral a => Int32le -> a
normalizeTextSize Int32le
rawSize)
  Str -> Decode Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Str
Str (Text -> Text
dropNull (Int32le -> ByteString -> Text
getTextDecoder Int32le
rawSize ByteString
bytes)))

decodeStrBits :: DecodeBits Str
decodeStrBits :: DecodeBits Str
decodeStrBits = do
  Int32le
rawSize <- DecodeBits Int32le
decodeInt32leBits
  ByteString
bytes <- Int -> DecodeBits ByteString
getByteStringBits (Int32le -> Int
forall a. Integral a => Int32le -> a
normalizeTextSize Int32le
rawSize)
  Str -> DecodeBits Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Str
Str (Text -> Text
dropNull (Int32le -> ByteString -> Text
getTextDecoder Int32le
rawSize (ByteString -> ByteString
reverseBytes ByteString
bytes))))

normalizeTextSize :: Integral a => Int32le -> a
normalizeTextSize :: Int32le -> a
normalizeTextSize Int32le
size = case Int32le -> Int32
int32leValue Int32le
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 :: Int32le -> Bytes.ByteString -> Text.Text
getTextDecoder :: Int32le -> ByteString -> Text
getTextDecoder Int32le
size ByteString
bytes =
  let
    decode :: ByteString -> Text
decode = if Int32le
size Int32le -> Int32le -> Bool
forall a. Ord a => a -> a -> Bool
< Int32 -> Int32le
Int32le Int32
0
      then OnDecodeError -> ByteString -> Text
Text.decodeUtf16LEWith (OnDecodeError -> ByteString -> Text)
-> OnDecodeError -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ \String
message Maybe Word8
input -> do
        String -> Maybe ()
forall (f :: * -> *). Applicative f => String -> f ()
Debug.traceM (String -> Maybe ()) -> String -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
"WARNING: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> String
forall a. Show a => a -> String
show (String -> Maybe Word8 -> UnicodeException
Text.DecodeError String
message Maybe Word8
input)
        OnDecodeError
Text.lenientDecode String
message Maybe Word8
input
      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')