{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, MultiWayIf #-}
{-# OPTIONS_GHC -O2 -fno-warn-name-shadowing #-}
module GHC.Utils.Encoding (
utf8DecodeCharAddr#,
utf8PrevChar,
utf8CharStart,
utf8DecodeChar,
utf8DecodeByteString,
utf8UnconsByteString,
utf8DecodeShortByteString,
utf8CompareShortByteString,
utf8DecodeStringLazy,
utf8EncodeChar,
utf8EncodeString,
utf8EncodeStringPtr,
utf8EncodeShortByteString,
utf8EncodedLength,
countUTF8Chars,
zEncodeString,
zDecodeString,
toBase62,
toBase62Padded
) where
import 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# =
#if !MIN_VERSION_base(4,16,0)
utf8DecodeChar# (\i# -> indexWord8OffAddr# a# (i# +# off#))
#else
(Int# -> Word#) -> (# Char#, Int# #)
utf8DecodeChar# (\Int#
i# -> Word8# -> Word#
word8ToWord# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
a# (Int#
i# Int# -> Int# -> Int#
+# Int#
off#)))
#endif
utf8DecodeCharByteArray# :: ByteArray# -> Int# -> (# Char#, Int# #)
utf8DecodeCharByteArray# :: ByteArray# -> Int# -> (# Char#, Int# #)
utf8DecodeCharByteArray# ByteArray#
ba# Int#
off# =
#if !MIN_VERSION_base(4,16,0)
utf8DecodeChar# (\i# -> indexWord8Array# ba# (i# +# off#))
#else
(Int# -> Word#) -> (# Char#, Int# #)
utf8DecodeChar# (\Int#
i# -> Word8# -> Word#
word8ToWord# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba# (Int#
i# Int# -> Int# -> Int#
+# Int#
off#)))
#endif
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 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 = 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
if b
w forall a. Ord a => a -> a -> Bool
>= b
0x80 Bool -> Bool -> Bool
&& b
w forall a. Ord a => a -> a -> Bool
< b
0xC0
then Ptr b -> IO (Ptr b)
go (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))
else 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 <- forall a. IO a -> IO a
unsafeDupableInterleaveIO forall a b. (a -> b) -> a -> b
$ Int# -> IO [Char]
unpack (Int#
i# Int# -> Int# -> Int#
+# Int#
nBytes#)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char# -> Char
C# Char#
c# 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) = forall a. Maybe a
Nothing
utf8UnconsByteString (BS.PS ForeignPtr Word8
fptr Int
offset Int
len)
= forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let (Char
c,Int
n) = Ptr Word8 -> (Char, Int)
utf8DecodeChar (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Char
c, ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fptr (Int
offset forall a. Num a => a -> a -> a
+ Int
n) (Int
len 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#)
= forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
let !(Ptr Addr#
a#) = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
IO () -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]
utf8DecodeLazy# (forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp) (Addr# -> Int# -> (# Char#, Int# #)
utf8DecodeCharAddr# Addr#
a#) Int#
len#
utf8CompareShortByteString :: ShortByteString -> ShortByteString -> Ordering
utf8CompareShortByteString :: ShortByteString -> ShortByteString -> Ordering
utf8CompareShortByteString (SBS ByteArray#
a1) (SBS ByteArray#
a2) = Int# -> Int# -> Ordering
go Int#
0# Int#
0#
where
!sz1 :: Int#
sz1 = ByteArray# -> Int#
sizeofByteArray# ByteArray#
a1
!sz2 :: Int#
sz2 = ByteArray# -> Int#
sizeofByteArray# ByteArray#
a2
go :: Int# -> Int# -> Ordering
go Int#
off1 Int#
off2
| Int# -> Bool
isTrue# ((Int#
off1 Int# -> Int# -> Int#
>=# Int#
sz1) Int# -> Int# -> Int#
`andI#` (Int#
off2 Int# -> Int# -> Int#
>=# Int#
sz2)) = Ordering
EQ
| Int# -> Bool
isTrue# (Int#
off1 Int# -> Int# -> Int#
>=# Int#
sz1) = Ordering
LT
| Int# -> Bool
isTrue# (Int#
off2 Int# -> Int# -> Int#
>=# Int#
sz2) = Ordering
GT
| Bool
otherwise =
#if !MIN_VERSION_base(4,16,0)
let !b1_1 = indexWord8Array# a1 off1
!b2_1 = indexWord8Array# a2 off2
#else
let !b1_1 :: Word#
b1_1 = Word8# -> Word#
word8ToWord# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
a1 Int#
off1)
!b2_1 :: Word#
b2_1 = Word8# -> Word#
word8ToWord# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
a2 Int#
off2)
#endif
in case Word#
b1_1 of
Word#
0xC0## -> case Word#
b2_1 of
Word#
0xC0## -> Int# -> Int# -> Ordering
go (Int#
off1 Int# -> Int# -> Int#
+# Int#
1#) (Int#
off2 Int# -> Int# -> Int#
+# Int#
1#)
#if !MIN_VERSION_base(4,16,0)
_ -> case indexWord8Array# a1 (off1 +# 1#) of
#else
Word#
_ -> case Word8# -> Word#
word8ToWord# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
a1 (Int#
off1 Int# -> Int# -> Int#
+# Int#
1#)) of
#endif
Word#
0x80## -> Ordering
LT
Word#
_ -> Int# -> Int# -> Ordering
go (Int#
off1 Int# -> Int# -> Int#
+# Int#
1#) (Int#
off2 Int# -> Int# -> Int#
+# Int#
1#)
Word#
_ -> case Word#
b2_1 of
#if !MIN_VERSION_base(4,16,0)
0xC0## -> case indexWord8Array# a2 (off2 +# 1#) of
#else
Word#
0xC0## -> case Word8# -> Word#
word8ToWord# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
a2 (Int#
off2 Int# -> Int# -> Int#
+# Int#
1#)) of
#endif
Word#
0x80## -> Ordering
GT
Word#
_ -> Int# -> Int# -> Ordering
go (Int#
off1 Int# -> Int# -> Int#
+# Int#
1#) (Int#
off2 Int# -> Int# -> Int#
+# Int#
1#)
Word#
_ | Int# -> Bool
isTrue# (Word#
b1_1 Word# -> Word# -> Int#
`gtWord#` Word#
b2_1) -> Ordering
GT
| Int# -> Bool
isTrue# (Word#
b1_1 Word# -> Word# -> Int#
`ltWord#` Word#
b2_1) -> Ordering
LT
| Bool
otherwise -> Int# -> Int# -> Ordering
go (Int#
off1 Int# -> Int# -> Int#
+# Int#
1#) (Int#
off2 Int# -> Int# -> Int#
+# Int#
1#)
utf8DecodeShortByteString :: ShortByteString -> [Char]
utf8DecodeShortByteString :: ShortByteString -> [Char]
utf8DecodeShortByteString (SBS ByteArray#
ba#)
= forall a. IO a -> a
unsafeDupablePerformIO 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# (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
go Int#
0# Int#
0#
where
len# :: Int#
len# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba
go :: Int# -> Int# -> IO Int
go Int#
i# Int#
n#
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
len#) =
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# -> IO Int
go (Int#
i# Int# -> Int# -> Int#
+# Int#
nBytes#) (Int#
n# Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE utf8EncodeChar #-}
utf8EncodeChar :: (Int# -> Word8# -> State# s -> State# s)
-> Char -> ST s Int
utf8EncodeChar :: forall s.
(Int# -> Word8# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar Int# -> Word8# -> State# s -> State# s
write# Char
c =
let x :: Word
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) in
case () of
()
_ | Word
x forall a. Ord a => a -> a -> Bool
> Word
0 Bool -> Bool -> Bool
&& Word
x forall a. Ord a => a -> a -> Bool
<= Word
0x007f -> do
Int -> Word -> ST s ()
write Int
0 Word
x
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
| Word
x forall a. Ord a => a -> a -> Bool
<= Word
0x07ff -> do
Int -> Word -> ST s ()
write Int
0 (Word
0xC0 forall a. Bits a => a -> a -> a
.|. ((Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word
0x1F))
Int -> Word -> ST s ()
write Int
1 (Word
0x80 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> a -> a
.&. Word
0x3F))
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
| Word
x forall a. Ord a => a -> a -> Bool
<= Word
0xffff -> do
Int -> Word -> ST s ()
write Int
0 (Word
0xE0 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Word
0x0F)
Int -> Word -> ST s ()
write Int
1 (Word
0x80 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word
0x3F)
Int -> Word -> ST s ()
write Int
2 (Word
0x80 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> a -> a
.&. Word
0x3F))
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
| Bool
otherwise -> do
Int -> Word -> ST s ()
write Int
0 (Word
0xF0 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
Int -> Word -> ST s ()
write Int
1 (Word
0x80 forall a. Bits a => a -> a -> a
.|. ((Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> Word -> ST s ()
write Int
2 (Word
0x80 forall a. Bits a => a -> a -> a
.|. ((Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> Word -> ST s ()
write Int
3 (Word
0x80 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> a -> a
.&. Word
0x3F))
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
where
{-# INLINE write #-}
write :: Int -> Word -> ST s ()
write (I# Int#
off#) (W# Word#
c#) = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s ->
#if !MIN_VERSION_base(4,16,0)
case write# off# (narrowWord8# c#) s of
#else
case Int# -> Word8# -> State# s -> State# s
write# Int#
off# (Word# -> Word8#
wordToWord8# Word#
c#) State# s
s of
#endif
State# s
s -> (# State# s
s, () #)
utf8EncodeString :: String -> ByteString
utf8EncodeString :: [Char] -> ByteString
utf8EncodeString [Char]
s =
forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
let len :: Int
len = [Char] -> Int
utf8EncodedLength [Char]
s
ForeignPtr Word8
buf <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
len
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
Ptr Word8 -> [Char] -> IO ()
utf8EncodeStringPtr Ptr Word8
ptr [Char]
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr ForeignPtr Word8
buf Int
0 Int
len)
utf8EncodeStringPtr :: Ptr Word8 -> String -> IO ()
utf8EncodeStringPtr :: Ptr Word8 -> [Char] -> IO ()
utf8EncodeStringPtr (Ptr Addr#
a#) [Char]
str = Addr# -> [Char] -> IO ()
go Addr#
a# [Char]
str
where go :: Addr# -> [Char] -> IO ()
go !Addr#
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Addr#
a# (Char
c:[Char]
cs) = do
#if !MIN_VERSION_base(4,16,0)
I# off# <- stToIO $ utf8EncodeChar (\i w -> writeWord8OffAddr# a# i (extendWord8# w)) c
#else
I# Int#
off# <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s.
(Int# -> Word8# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar (forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
a#) Char
c
#endif
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 = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case [Char] -> Int
utf8EncodedLength [Char]
str of { I# Int#
len# ->
case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len# State# RealWorld
s of { (# State# RealWorld
s, MutableByteArray# RealWorld
mba# #) ->
case 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 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#
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go MutableByteArray# s
mba# Int#
i# (Char
c:[Char]
cs) = do
#if !MIN_VERSION_base(4,16,0)
I# off# <- utf8EncodeChar (\j# w -> writeWord8Array# mba# (i# +# j#) (extendWord8# w)) c
#else
I# Int#
off# <- forall s.
(Int# -> Word8# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar (\Int#
j# -> forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# (Int#
i# Int# -> Int# -> Int#
+# Int#
j#)) Char
c
#endif
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 = forall {t}. Num t => t -> [Char] -> t
go Int
0 [Char]
str
where go :: t -> [Char] -> t
go !t
n [] = t
n
go t
n (Char
c:[Char]
cs)
| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0x007f = t -> [Char] -> t
go (t
nforall a. Num a => a -> a -> a
+t
1) [Char]
cs
| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0x07ff = t -> [Char] -> t
go (t
nforall a. Num a => a -> a -> a
+t
2) [Char]
cs
| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0xffff = t -> [Char] -> t
go (t
nforall a. Num a => a -> a -> a
+t
3) [Char]
cs
| Bool
otherwise = t -> [Char] -> t
go (t
nforall a. Num a => a -> a -> a
+t
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 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 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 forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z'
Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z'
Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c 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 forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c 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' forall a. a -> [a] -> [a]
: if Char -> Bool
isDigit (forall a. [a] -> a
head [Char]
hex_str) then [Char]
hex_str
else Char
'0'forall a. a -> [a] -> [a]
:[Char]
hex_str
where hex_str :: [Char]
hex_str = 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 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 forall a. a -> [a] -> [a]
: [Char] -> [Char]
zDecodeString [Char]
rest
zDecodeString (Char
c : [Char]
rest) = Char
c 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
16forall a. Num a => a -> a -> a
*Int
n 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 forall a. a -> [a] -> [a]
: [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n [Char]
other = forall a. HasCallStack => [Char] -> a
error ([Char]
"decode_num_esc: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ 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
10forall a. Num a => a -> a -> a
*Int
n forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) [Char]
rest
go Int
0 (Char
'T':[Char]
rest) = [Char]
"()" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n (Char
'T':[Char]
rest) = Char
'(' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
-Int
1) Char
',' forall a. [a] -> [a] -> [a]
++ [Char]
")" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
1 (Char
'H':[Char]
rest) = [Char]
"(# #)" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n (Char
'H':[Char]
rest) = Char
'(' forall a. a -> [a] -> [a]
: Char
'#' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
-Int
1) Char
',' forall a. [a] -> [a] -> [a]
++ [Char]
"#)" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
zDecodeString [Char]
rest
go Int
n [Char]
other = forall a. HasCallStack => [Char] -> a
error ([Char]
"decode_tuple: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ Char
' 'forall a. a -> [a] -> [a]
:[Char]
other)
maybe_tuple :: UserString -> Maybe EncodedString
maybe_tuple :: [Char] -> Maybe [Char]
maybe_tuple [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]
_) -> forall a. a -> Maybe a
Just (Char
'Z' forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char] -> [Char]
shows (Int
nforall a. Num a => a -> a -> a
+Int
1) [Char]
"H")
(Int, [Char])
_ -> forall a. Maybe a
Nothing
maybe_tuple [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]
_) -> forall a. a -> Maybe a
Just (Char
'Z' forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char] -> [Char]
shows (Int
nforall a. Num a => a -> a -> a
+Int
1) [Char]
"T")
(Int, [Char])
_ -> forall a. Maybe a
Nothing
maybe_tuple [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
nforall 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 forall a. [a] -> [a] -> [a]
++ [Char]
str
where
pad :: [Char]
pad = forall a. Int -> a -> [a]
replicate Int
len Char
'0'
len :: Int
len = Int
word64Base62Len forall a. Num a => a -> a -> a
- 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 = 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 forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
Char.chr (Int
48 forall a. Num a => a -> a -> a
+ Int
x)
| Int
x forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
Char.chr (Int
65 forall a. Num a => a -> a -> a
+ Int
x forall a. Num a => a -> a -> a
- Int
10)
| Int
x forall a. Ord a => a -> a -> Bool
< Int
62 = Int -> Char
Char.chr (Int
97 forall a. Num a => a -> a -> a
+ Int
x forall a. Num a => a -> a -> a
- Int
36)
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"represent (base 62): impossible!"