{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
{-# OPTIONS_GHC -O2 #-}
module GHC.Utils.Encoding (
utf8DecodeCharAddr#,
utf8PrevChar,
utf8CharStart,
utf8DecodeChar,
utf8DecodeByteString,
utf8UnconsByteString,
utf8DecodeShortByteString,
utf8DecodeStringLazy,
utf8EncodeChar,
utf8EncodeString,
utf8EncodeShortByteString,
utf8EncodedLength,
countUTF8Chars,
zEncodeString,
zDecodeString,
toBase62,
toBase62Padded
) where
import GHC.Prelude
import Foreign
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Data.Char
import qualified Data.Char as Char
import Numeric
import GHC.IO
import GHC.ST
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BS
import Data.ByteString.Short.Internal (ShortByteString(..))
import GHC.Exts
{-# INLINE utf8DecodeChar# #-}
utf8DecodeChar# :: (Int# -> Word#) -> (# Char#, Int# #)
utf8DecodeChar# :: (Int# -> Word#) -> (# Char#, Int# #)
utf8DecodeChar# Int# -> Word#
indexWord8# =
let !ch0 :: Int#
ch0 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
0#) in
case () of
()
_ | Int# -> Bool
isTrue# (Int#
ch0 Int# -> Int# -> Int#
<=# Int#
0x7F#) -> (# Int# -> Char#
chr# Int#
ch0, Int#
1# #)
| Int# -> Bool
isTrue# ((Int#
ch0 Int# -> Int# -> Int#
>=# Int#
0xC0#) Int# -> Int# -> Int#
`andI#` (Int#
ch0 Int# -> Int# -> Int#
<=# Int#
0xDF#)) ->
let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
1#) in
if Int# -> Bool
isTrue# ((Int#
ch1 Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
ch1 Int# -> Int# -> Int#
>=# Int#
0xC0#)) then Int# -> (# Char#, Int# #)
fail Int#
1# else
(# Int# -> Char#
chr# (((Int#
ch0 Int# -> Int# -> Int#
-# Int#
0xC0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
+#
(Int#
ch1 Int# -> Int# -> Int#
-# Int#
0x80#)),
Int#
2# #)
| Int# -> Bool
isTrue# ((Int#
ch0 Int# -> Int# -> Int#
>=# Int#
0xE0#) Int# -> Int# -> Int#
`andI#` (Int#
ch0 Int# -> Int# -> Int#
<=# Int#
0xEF#)) ->
let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
1#) in
if Int# -> Bool
isTrue# ((Int#
ch1 Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
ch1 Int# -> Int# -> Int#
>=# Int#
0xC0#)) then Int# -> (# Char#, Int# #)
fail Int#
1# else
let !ch2 :: Int#
ch2 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
2#) in
if Int# -> Bool
isTrue# ((Int#
ch2 Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
ch2 Int# -> Int# -> Int#
>=# Int#
0xC0#)) then Int# -> (# Char#, Int# #)
fail Int#
2# else
(# Int# -> Char#
chr# (((Int#
ch0 Int# -> Int# -> Int#
-# Int#
0xE0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
+#
((Int#
ch1 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
+#
(Int#
ch2 Int# -> Int# -> Int#
-# Int#
0x80#)),
Int#
3# #)
| Int# -> Bool
isTrue# ((Int#
ch0 Int# -> Int# -> Int#
>=# Int#
0xF0#) Int# -> Int# -> Int#
`andI#` (Int#
ch0 Int# -> Int# -> Int#
<=# Int#
0xF8#)) ->
let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
1#) in
if Int# -> Bool
isTrue# ((Int#
ch1 Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
ch1 Int# -> Int# -> Int#
>=# Int#
0xC0#)) then Int# -> (# Char#, Int# #)
fail Int#
1# else
let !ch2 :: Int#
ch2 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
2#) in
if Int# -> Bool
isTrue# ((Int#
ch2 Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
ch2 Int# -> Int# -> Int#
>=# Int#
0xC0#)) then Int# -> (# Char#, Int# #)
fail Int#
2# else
let !ch3 :: Int#
ch3 = Word# -> Int#
word2Int# (Int# -> Word#
indexWord8# Int#
3#) in
if Int# -> Bool
isTrue# ((Int#
ch3 Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
ch3 Int# -> Int# -> Int#
>=# Int#
0xC0#)) then Int# -> (# Char#, Int# #)
fail Int#
3# else
(# Int# -> Char#
chr# (((Int#
ch0 Int# -> Int# -> Int#
-# Int#
0xF0#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
18#) Int# -> Int# -> Int#
+#
((Int#
ch1 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
+#
((Int#
ch2 Int# -> Int# -> Int#
-# Int#
0x80#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
+#
(Int#
ch3 Int# -> Int# -> Int#
-# Int#
0x80#)),
Int#
4# #)
| Bool
otherwise -> Int# -> (# Char#, Int# #)
fail Int#
1#
where
fail :: Int# -> (# Char#, Int# #)
fail :: Int# -> (# Char#, Int# #)
fail Int#
nBytes# = (# Char#
'\0'#, Int#
nBytes# #)
utf8DecodeCharAddr# :: Addr# -> Int# -> (# Char#, Int# #)
utf8DecodeCharAddr# :: Addr# -> Int# -> (# Char#, Int# #)
utf8DecodeCharAddr# Addr#
a# Int#
off# =
(Int# -> Word#) -> (# Char#, Int# #)
utf8DecodeChar# (\Int#
i# -> Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# (Int#
i# Int# -> Int# -> Int#
+# Int#
off#))
utf8DecodeCharByteArray# :: ByteArray# -> Int# -> (# Char#, Int# #)
utf8DecodeCharByteArray# :: ByteArray# -> Int# -> (# Char#, Int# #)
utf8DecodeCharByteArray# ByteArray#
ba# Int#
off# =
(Int# -> Word#) -> (# Char#, Int# #)
utf8DecodeChar# (\Int#
i# -> ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba# (Int#
i# Int# -> Int# -> Int#
+# Int#
off#))
utf8DecodeChar :: Ptr Word8 -> (Char, Int)
utf8DecodeChar :: Ptr Word8 -> (Char, Int)
utf8DecodeChar !(Ptr Addr#
a#) =
case Addr# -> Int# -> (# Char#, Int# #)
utf8DecodeCharAddr# Addr#
a# Int#
0# of
(# Char#
c#, Int#
nBytes# #) -> ( Char# -> Char
C# Char#
c#, Int# -> Int
I# Int#
nBytes# )
utf8PrevChar :: Ptr Word8 -> IO (Ptr Word8)
utf8PrevChar :: Ptr Word8 -> IO (Ptr Word8)
utf8PrevChar Ptr Word8
p = Ptr Word8 -> IO (Ptr Word8)
utf8CharStart (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))
utf8CharStart :: Ptr Word8 -> IO (Ptr Word8)
utf8CharStart :: Ptr Word8 -> IO (Ptr Word8)
utf8CharStart Ptr Word8
p = Ptr Word8 -> IO (Ptr Word8)
forall {b}. (Storable b, Ord b, Num b) => Ptr b -> IO (Ptr b)
go Ptr Word8
p
where go :: Ptr b -> IO (Ptr b)
go Ptr b
p = do b
w <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
if b
w b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0x80 Bool -> Bool -> Bool
&& b
w b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0xC0
then Ptr b -> IO (Ptr b)
go (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))
else Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr b
p
{-# INLINE utf8DecodeLazy# #-}
utf8DecodeLazy# :: (IO ()) -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]
utf8DecodeLazy# :: IO () -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]
utf8DecodeLazy# IO ()
retain Int# -> (# Char#, Int# #)
decodeChar# Int#
len#
= Int# -> IO [Char]
unpack Int#
0#
where
unpack :: Int# -> IO [Char]
unpack Int#
i#
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
len#) = IO ()
retain IO () -> IO [Char] -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise =
case Int# -> (# Char#, Int# #)
decodeChar# Int#
i# of
(# Char#
c#, Int#
nBytes# #) -> do
[Char]
rest <- IO [Char] -> IO [Char]
forall a. IO a -> IO a
unsafeDupableInterleaveIO (IO [Char] -> IO [Char]) -> IO [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ Int# -> IO [Char]
unpack (Int#
i# Int# -> Int# -> Int#
+# Int#
nBytes#)
[Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char# -> Char
C# Char#
c# Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rest)
utf8DecodeByteString :: ByteString -> [Char]
utf8DecodeByteString :: ByteString -> [Char]
utf8DecodeByteString (BS.PS ForeignPtr Word8
fptr Int
offset Int
len)
= ForeignPtr Word8 -> Int -> Int -> [Char]
utf8DecodeStringLazy ForeignPtr Word8
fptr Int
offset Int
len
utf8UnconsByteString :: ByteString -> Maybe (Char, ByteString)
utf8UnconsByteString :: ByteString -> Maybe (Char, ByteString)
utf8UnconsByteString (BS.PS ForeignPtr Word8
_ Int
_ Int
0) = Maybe (Char, ByteString)
forall a. Maybe a
Nothing
utf8UnconsByteString (BS.PS ForeignPtr Word8
fptr Int
offset Int
len)
= IO (Maybe (Char, ByteString)) -> Maybe (Char, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe (Char, ByteString)) -> Maybe (Char, ByteString))
-> IO (Maybe (Char, ByteString)) -> Maybe (Char, ByteString)
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe (Char, ByteString)))
-> IO (Maybe (Char, ByteString))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Maybe (Char, ByteString)))
-> IO (Maybe (Char, ByteString)))
-> (Ptr Word8 -> IO (Maybe (Char, ByteString)))
-> IO (Maybe (Char, ByteString))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let (Char
c,Int
n) = Ptr Word8 -> (Char, Int)
utf8DecodeChar (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
Maybe (Char, ByteString) -> IO (Maybe (Char, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Char, ByteString) -> IO (Maybe (Char, ByteString)))
-> Maybe (Char, ByteString) -> IO (Maybe (Char, ByteString))
forall a b. (a -> b) -> a -> b
$ (Char, ByteString) -> Maybe (Char, ByteString)
forall a. a -> Maybe a
Just (Char
c, ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))
utf8DecodeStringLazy :: ForeignPtr Word8 -> Int -> Int -> [Char]
utf8DecodeStringLazy :: ForeignPtr Word8 -> Int -> Int -> [Char]
utf8DecodeStringLazy ForeignPtr Word8
fp Int
offset (I# Int#
len#)
= IO [Char] -> [Char]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Char] -> [Char]) -> IO [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ do
let !(Ptr Addr#
a#) = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
IO () -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]
utf8DecodeLazy# (ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp) (Addr# -> Int# -> (# Char#, Int# #)
utf8DecodeCharAddr# Addr#
a#) Int#
len#
utf8DecodeShortByteString :: ShortByteString -> [Char]
utf8DecodeShortByteString :: ShortByteString -> [Char]
utf8DecodeShortByteString (SBS ByteArray#
ba#)
= IO [Char] -> [Char]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Char] -> [Char]) -> IO [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
let len# :: Int#
len# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba# in
IO () -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]
utf8DecodeLazy# (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ByteArray# -> Int# -> (# Char#, Int# #)
utf8DecodeCharByteArray# ByteArray#
ba#) Int#
len#
countUTF8Chars :: ShortByteString -> IO Int
countUTF8Chars :: ShortByteString -> IO Int
countUTF8Chars (SBS ByteArray#
ba) = Int# -> Int# -> IO Int
forall {m :: * -> *}. Monad m => Int# -> Int# -> m Int
go Int#
0# Int#
0#
where
len# :: Int#
len# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba
go :: Int# -> Int# -> m Int
go Int#
i# Int#
n#
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
len#) =
Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int# -> Int
I# Int#
n#)
| Bool
otherwise = do
case ByteArray# -> Int# -> (# Char#, Int# #)
utf8DecodeCharByteArray# ByteArray#
ba Int#
i# of
(# Char#
_, Int#
nBytes# #) -> Int# -> Int# -> m Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
nBytes#) (Int#
n# Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE utf8EncodeChar #-}
utf8EncodeChar :: (Int# -> Word# -> State# s -> State# s)
-> Char -> ST s Int
utf8EncodeChar :: forall s.
(Int# -> Word# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar Int# -> Word# -> State# s -> State# s
write# Char
c =
let x :: Int
x = Char -> Int
ord Char
c in
case () of
()
_ | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x007f -> do
Int -> Int -> ST s ()
write Int
0 Int
x
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07ff -> do
Int -> Int -> ST s ()
write Int
0 (Int
0xC0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1F))
Int -> Int -> ST s ()
write Int
1 (Int
0x80 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F))
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff -> do
Int -> Int -> ST s ()
write Int
0 (Int
0xE0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x0F)
Int -> Int -> ST s ()
write Int
1 (Int
0x80 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F)
Int -> Int -> ST s ()
write Int
2 (Int
0x80 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F))
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
| Bool
otherwise -> do
Int -> Int -> ST s ()
write Int
0 (Int
0xF0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
Int -> Int -> ST s ()
write Int
1 (Int
0x80 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F))
Int -> Int -> ST s ()
write Int
2 (Int
0x80 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F))
Int -> Int -> ST s ()
write Int
3 (Int
0x80 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F))
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
where
{-# INLINE write #-}
write :: Int -> Int -> ST s ()
write (I# Int#
off#) (I# Int#
c#) = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case Int# -> Word# -> State# s -> State# s
write# Int#
off# (Int# -> Word#
int2Word# Int#
c#) State# s
s of
State# s
s -> (# State# s
s, () #)
utf8EncodeString :: Ptr Word8 -> String -> IO ()
utf8EncodeString :: Ptr Word8 -> [Char] -> IO ()
utf8EncodeString (Ptr Addr#
a#) [Char]
str = Addr# -> [Char] -> IO ()
go Addr#
a# [Char]
str
where go :: Addr# -> [Char] -> IO ()
go !Addr#
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Addr#
a# (Char
c:[Char]
cs) = do
I# Int#
off# <- ST RealWorld Int -> IO Int
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld Int -> IO Int) -> ST RealWorld Int -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int# -> Word# -> State# RealWorld -> State# RealWorld)
-> Char -> ST RealWorld Int
forall s.
(Int# -> Word# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar (Addr# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord8OffAddr# Addr#
a#) Char
c
Addr# -> [Char] -> IO ()
go (Addr#
a# Addr# -> Int# -> Addr#
`plusAddr#` Int#
off#) [Char]
cs
utf8EncodeShortByteString :: String -> IO ShortByteString
utf8EncodeShortByteString :: [Char] -> IO ShortByteString
utf8EncodeShortByteString [Char]
str = (State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString)
-> (State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case [Char] -> Int
utf8EncodedLength [Char]
str of { I# Int#
len# ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len# State# RealWorld
s of { (# State# RealWorld
s, MutableByteArray# RealWorld
mba# #) ->
case MutableByteArray# RealWorld -> Int# -> [Char] -> ST RealWorld ()
forall {s}. MutableByteArray# s -> Int# -> [Char] -> ST s ()
go MutableByteArray# RealWorld
mba# Int#
0# [Char]
str of { ST STRep RealWorld ()
f_go ->
case STRep RealWorld ()
f_go State# RealWorld
s of { (# State# RealWorld
s, () #) ->
case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba# State# RealWorld
s of { (# State# RealWorld
s, ByteArray#
ba# #) ->
(# State# RealWorld
s, ByteArray# -> ShortByteString
SBS ByteArray#
ba# #) }}}}}
where
go :: MutableByteArray# s -> Int# -> [Char] -> ST s ()
go MutableByteArray# s
_ Int#
_ [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go MutableByteArray# s
mba# Int#
i# (Char
c:[Char]
cs) = do
I# Int#
off# <- (Int# -> Word# -> State# s -> State# s) -> Char -> ST s Int
forall s.
(Int# -> Word# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar (\Int#
j# -> MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# (Int#
i# Int# -> Int# -> Int#
+# Int#
j#)) Char
c
MutableByteArray# s -> Int# -> [Char] -> ST s ()
go MutableByteArray# s
mba# (Int#
i# Int# -> Int# -> Int#
+# Int#
off#) [Char]
cs
utf8EncodedLength :: String -> Int
utf8EncodedLength :: [Char] -> Int
utf8EncodedLength [Char]
str = Int -> [Char] -> Int
forall {a}. Num a => a -> [Char] -> a
go Int
0 [Char]
str
where go :: a -> [Char] -> a
go !a
n [] = a
n
go a
n (Char
c:[Char]
cs)
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x007f = a -> [Char] -> a
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [Char]
cs
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07ff = a -> [Char] -> a
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
2) [Char]
cs
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = a -> [Char] -> a
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
3) [Char]
cs
| Bool
otherwise = a -> [Char] -> a
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
4) [Char]
cs
type UserString = String
type EncodedString = String
zEncodeString :: UserString -> EncodedString
zEncodeString :: [Char] -> [Char]
zEncodeString [Char]
cs = case [Char] -> Maybe [Char]
maybe_tuple [Char]
cs of
Just [Char]
n -> [Char]
n
Maybe [Char]
Nothing -> [Char] -> [Char]
go [Char]
cs
where
go :: [Char] -> [Char]
go [] = []
go (Char
c:[Char]
cs) = Char -> [Char]
encode_digit_ch Char
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
go' [Char]
cs
go' :: [Char] -> [Char]
go' [] = []
go' (Char
c:[Char]
cs) = Char -> [Char]
encode_ch Char
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
go' [Char]
cs
unencodedChar :: Char -> Bool
unencodedChar :: Char -> Bool
unencodedChar Char
'Z' = Bool
False
unencodedChar Char
'z' = Bool
False
unencodedChar Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
encode_digit_ch :: Char -> EncodedString
encode_digit_ch :: Char -> [Char]
encode_digit_ch Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char -> [Char]
encode_as_unicode_char Char
c
encode_digit_ch Char
c | Bool
otherwise = Char -> [Char]
encode_ch Char
c
encode_ch :: Char -> EncodedString
encode_ch :: Char -> [Char]
encode_ch Char
c | Char -> Bool
unencodedChar Char
c = [Char
c]
encode_ch Char
'(' = [Char]
"ZL"
encode_ch Char
')' = [Char]
"ZR"
encode_ch Char
'[' = [Char]
"ZM"
encode_ch Char
']' = [Char]
"ZN"
encode_ch Char
':' = [Char]
"ZC"
encode_ch Char
'Z' = [Char]
"ZZ"
encode_ch Char
'z' = [Char]
"zz"
encode_ch Char
'&' = [Char]
"za"
encode_ch Char
'|' = [Char]
"zb"
encode_ch Char
'^' = [Char]
"zc"
encode_ch Char
'$' = [Char]
"zd"
encode_ch Char
'=' = [Char]
"ze"
encode_ch Char
'>' = [Char]
"zg"
encode_ch Char
'#' = [Char]
"zh"
encode_ch Char
'.' = [Char]
"zi"
encode_ch Char
'<' = [Char]
"zl"
encode_ch Char
'-' = [Char]
"zm"
encode_ch Char
'!' = [Char]
"zn"
encode_ch Char
'+' = [Char]
"zp"
encode_ch Char
'\'' = [Char]
"zq"
encode_ch Char
'\\' = [Char]
"zr"
encode_ch Char
'/' = [Char]
"zs"
encode_ch Char
'*' = [Char]
"zt"
encode_ch Char
'_' = [Char]
"zu"
encode_ch Char
'%' = [Char]
"zv"
encode_ch Char
c = Char -> [Char]
encode_as_unicode_char Char
c
encode_as_unicode_char :: Char -> EncodedString
encode_as_unicode_char :: Char -> [Char]
encode_as_unicode_char Char
c = Char
'z' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: if Char -> Bool
isDigit ([Char] -> Char
forall a. [a] -> a
head [Char]
hex_str) then [Char]
hex_str
else Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
hex_str
where hex_str :: [Char]
hex_str = Int -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex (Char -> Int
ord Char
c) [Char]
"U"
zDecodeString :: EncodedString -> UserString
zDecodeString :: [Char] -> [Char]
zDecodeString [] = []
zDecodeString (Char
'Z' : Char
d : [Char]
rest)
| Char -> Bool
isDigit Char
d = Char -> [Char] -> [Char]
decode_tuple Char
d [Char]
rest
| Bool
otherwise = Char -> Char
decode_upper Char
d Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
zDecodeString [Char]
rest
zDecodeString (Char
'z' : Char
d : [Char]
rest)
| Char -> Bool
isDigit Char
d = Char -> [Char] -> [Char]
decode_num_esc Char
d [Char]
rest
| Bool
otherwise = Char -> Char
decode_lower Char
d Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
zDecodeString [Char]
rest
zDecodeString (Char
c : [Char]
rest) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
zDecodeString [Char]
rest
decode_upper, decode_lower :: Char -> Char
decode_upper :: Char -> Char
decode_upper Char
'L' = Char
'('
decode_upper Char
'R' = Char
')'
decode_upper Char
'M' = Char
'['
decode_upper Char
'N' = Char
']'
decode_upper Char
'C' = Char
':'
decode_upper Char
'Z' = Char
'Z'
decode_upper Char
ch = Char
ch
decode_lower :: Char -> Char
decode_lower Char
'z' = Char
'z'
decode_lower Char
'a' = Char
'&'
decode_lower Char
'b' = Char
'|'
decode_lower Char
'c' = Char
'^'
decode_lower Char
'd' = Char
'$'
decode_lower Char
'e' = Char
'='
decode_lower Char
'g' = Char
'>'
decode_lower Char
'h' = Char
'#'
decode_lower Char
'i' = Char
'.'
decode_lower Char
'l' = Char
'<'
decode_lower Char
'm' = Char
'-'
decode_lower Char
'n' = Char
'!'
decode_lower Char
'p' = Char
'+'
decode_lower Char
'q' = Char
'\''
decode_lower Char
'r' = Char
'\\'
decode_lower Char
's' = Char
'/'
decode_lower Char
't' = Char
'*'
decode_lower Char
'u' = Char
'_'
decode_lower Char
'v' = Char
'%'
decode_lower Char
ch = Char
ch
decode_num_esc :: Char -> EncodedString -> UserString
decode_num_esc :: Char -> [Char] -> [Char]
decode_num_esc Char
d [Char]
rest
= Int -> [Char] -> [Char]
go (Char -> Int
digitToInt Char
d) [Char]
rest
where
go :: Int -> [Char] -> [Char]
go Int
n (Char
c : [Char]
rest) | Char -> Bool
isHexDigit Char
c = Int -> [Char] -> [Char]
go (Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) [Char]
rest
go Int
n (Char
'U' : [Char]
rest) = Int -> Char
chr Int
n Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n [Char]
other = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char]
"decode_num_esc: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
' 'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
other)
decode_tuple :: Char -> EncodedString -> UserString
decode_tuple :: Char -> [Char] -> [Char]
decode_tuple Char
d [Char]
rest
= Int -> [Char] -> [Char]
go (Char -> Int
digitToInt Char
d) [Char]
rest
where
go :: Int -> [Char] -> [Char]
go Int
n (Char
c : [Char]
rest) | Char -> Bool
isDigit Char
c = Int -> [Char] -> [Char]
go (Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) [Char]
rest
go Int
0 (Char
'T':[Char]
rest) = [Char]
"()" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n (Char
'T':[Char]
rest) = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
',' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
1 (Char
'H':[Char]
rest) = [Char]
"(# #)" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n (Char
'H':[Char]
rest) = Char
'(' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'#' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
',' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#)" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n [Char]
other = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char]
"decode_tuple: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
' 'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
other)
maybe_tuple :: UserString -> Maybe EncodedString
maybe_tuple :: [Char] -> Maybe [Char]
maybe_tuple [Char]
"(# #)" = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just([Char]
"Z1H")
maybe_tuple (Char
'(' : Char
'#' : [Char]
cs) = case Int -> [Char] -> (Int, [Char])
count_commas (Int
0::Int) [Char]
cs of
(Int
n, Char
'#' : Char
')' : [Char]
_) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Char
'Z' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Char]
"H")
(Int, [Char])
_ -> Maybe [Char]
forall a. Maybe a
Nothing
maybe_tuple [Char]
"()" = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just([Char]
"Z0T")
maybe_tuple (Char
'(' : [Char]
cs) = case Int -> [Char] -> (Int, [Char])
count_commas (Int
0::Int) [Char]
cs of
(Int
n, Char
')' : [Char]
_) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Char
'Z' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Char]
"T")
(Int, [Char])
_ -> Maybe [Char]
forall a. Maybe a
Nothing
maybe_tuple [Char]
_ = Maybe [Char]
forall a. Maybe a
Nothing
count_commas :: Int -> String -> (Int, String)
count_commas :: Int -> [Char] -> (Int, [Char])
count_commas Int
n (Char
',' : [Char]
cs) = Int -> [Char] -> (Int, [Char])
count_commas (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Char]
cs
count_commas Int
n [Char]
cs = (Int
n,[Char]
cs)
word64Base62Len :: Int
word64Base62Len :: Int
word64Base62Len = Int
11
toBase62Padded :: Word64 -> String
toBase62Padded :: Word64 -> [Char]
toBase62Padded Word64
w = [Char]
pad [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str
where
pad :: [Char]
pad = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
len Char
'0'
len :: Int
len = Int
word64Base62Len Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str
str :: [Char]
str = Word64 -> [Char]
toBase62 Word64
w
toBase62 :: Word64 -> String
toBase62 :: Word64 -> [Char]
toBase62 Word64
w = Word64 -> (Int -> Char) -> Word64 -> [Char] -> [Char]
forall a.
(Integral a, Show a) =>
a -> (Int -> Char) -> a -> [Char] -> [Char]
showIntAtBase Word64
62 Int -> Char
represent Word64
w [Char]
""
where
represent :: Int -> Char
represent :: Int -> Char
represent Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
Char.chr (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
Char.chr (Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
62 = Int -> Char
Char.chr (Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
36)
| Bool
otherwise = [Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"represent (base 62): impossible!"