module Rattletrap.Type.Str where 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 Rattletrap.Utility.Bytes import qualified Rattletrap.Utility.Json as Json import qualified Data.ByteString as Bytes 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 Debug.Trace as Debug newtype Str = Str Text.Text deriving (Eq, Ord, Show) instance Json.FromJSON Str where parseJSON = fmap fromText . Json.parseJSON instance Json.ToJSON Str where toJSON = Json.toJSON . toText schema :: Schema.Schema schema = Schema.named "str" $ Json.object [Json.pair "type" "string"] fromText :: Text.Text -> Str fromText = Str toText :: Str -> Text.Text toText (Str x) = x fromString :: String -> Str fromString = fromText . Text.pack toString :: Str -> String toString = Text.unpack . toText bytePut :: Str -> BytePut.BytePut bytePut text = let size = getTextSize text encode = getTextEncoder size in I32.bytePut size <> (BytePut.byteString . encode . addNull $ toText text) bitPut :: Str -> BitPut.BitPut bitPut = BitPut.fromBytePut . bytePut getTextSize :: Str -> I32.I32 getTextSize text = let value = toText text scale = if Text.all Char.isLatin1 value then 1 else -1 :: Int.Int32 rawSize = if Text.null value then 0 else fromIntegral (Text.length value) + 1 :: Int.Int32 size = if value == Text.pack "\x00\x00\x00None" then 0x05000000 else scale * rawSize :: Int.Int32 in I32.fromInt32 size getTextEncoder :: I32.I32 -> Text.Text -> Bytes.ByteString getTextEncoder size text = if I32.toInt32 size < 0 then Text.encodeUtf16LE text else encodeLatin1 text addNull :: Text.Text -> Text.Text addNull text = if Text.null text then text else Text.snoc text '\x00' byteGet :: ByteGet.ByteGet Str byteGet = do rawSize <- I32.byteGet bytes <- ByteGet.byteString (normalizeTextSize rawSize) pure (fromText (dropNull (getTextDecoder rawSize bytes))) bitGet :: BitGet.BitGet Str bitGet = do rawSize <- I32.bitGet bytes <- BitGet.byteString (normalizeTextSize rawSize) pure (fromText (dropNull (getTextDecoder rawSize (reverseBytes bytes)))) normalizeTextSize :: Integral a => I32.I32 -> a normalizeTextSize size = case I32.toInt32 size of 0x05000000 -> 8 x -> if x < 0 then (-2 * fromIntegral x) else fromIntegral x getTextDecoder :: I32.I32 -> Bytes.ByteString -> Text.Text getTextDecoder size bytes = let decode = if I32.toInt32 size < 0 then Text.decodeUtf16LEWith $ \message input -> do Debug.traceM $ "WARNING: " <> show (Text.DecodeError message input) Text.lenientDecode message input else Text.decodeLatin1 in decode bytes dropNull :: Text.Text -> Text.Text dropNull = Text.dropWhileEnd (== '\x00')