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 (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 -> Bytes.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 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 = do I32 rawSize <- ByteGet I32 I32.byteGet ByteString bytes <- Int -> ByteGet ByteString ByteGet.byteString (I32 -> Int forall a. Integral a => I32 -> a normalizeTextSize I32 rawSize) Str -> ByteGet Str forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Str fromText (Text -> Text dropNull (I32 -> ByteString -> Text getTextDecoder I32 rawSize 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 -> ByteString reverseBytes 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 -> Bytes.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 -> 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 -> ShowS 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')