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
$c== :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
/= :: 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
$ccompare :: Str -> Str -> Ordering
compare :: Str -> Str -> Ordering
$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
>= :: Str -> Str -> Bool
$cmax :: Str -> Str -> Str
max :: Str -> Str -> Str
$cmin :: Str -> Str -> Str
min :: Str -> Str -> 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
$cshowsPrec :: Int -> Str -> ShowS
showsPrec :: Int -> Str -> ShowS
$cshow :: Str -> String
show :: Str -> String
$cshowList :: [Str] -> ShowS
showList :: [Str] -> ShowS
Show)

instance Json.FromJSON Str where
  parseJSON :: Value -> Parser Str
parseJSON = (Text -> Str) -> Parser Text -> Parser Str
forall a b. (a -> b) -> Parser a -> Parser b
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 a. a -> Get ByteString Identity a
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 a. a -> Get BitString Identity a
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 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')