{-# 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 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 a. a -> IO a
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO [Char]
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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#
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#)
= 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 a. a -> IO a
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 a. a -> m a
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# -> 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 = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) in
case () of
()
_ | Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 Bool -> Bool -> Bool
&& Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x007f -> do
Int -> Word -> ST s ()
write Int
0 Word
x
Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
| Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x07ff -> do
Int -> Word -> ST s ()
write Int
0 (Word
0xC0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x1F))
Int -> Word -> ST s ()
write Int
1 (Word
0x80 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
| Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0xffff -> do
Int -> Word -> ST s ()
write Int
0 (Word
0xE0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0F)
Int -> Word -> ST s ()
write Int
1 (Word
0x80 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3F)
Int -> Word -> ST s ()
write Int
2 (Word
0x80 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
| Bool
otherwise -> do
Int -> Word -> ST s ()
write Int
0 (Word
0xF0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
Int -> Word -> ST s ()
write Int
1 (Word
0x80 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> Word -> ST s ()
write Int
2 (Word
0x80 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> Word -> ST s ()
write Int
3 (Word
0x80 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3F))
Int -> ST s Int
forall a. a -> ST s a
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#) = 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 ->
#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 =
IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
let len :: Int
len = [Char] -> Int
utf8EncodedLength [Char]
s
ForeignPtr Word8
buf <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
len
ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
Ptr Word8 -> [Char] -> IO ()
utf8EncodeStringPtr Ptr Word8
ptr [Char]
s
ByteString -> IO ByteString
forall a. a -> IO a
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#
_ [] = () -> IO ()
forall a. a -> IO a
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# <- 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# -> Word8# -> State# RealWorld -> State# RealWorld)
-> Char -> ST RealWorld Int
forall s.
(Int# -> Word8# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar (Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
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 = (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 a. a -> ST s a
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# <- (Int# -> Word8# -> State# s -> State# s) -> Char -> ST s Int
forall s.
(Int# -> Word8# -> State# s -> State# s) -> Char -> ST s Int
utf8EncodeChar (\Int#
j# -> MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
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 = Int -> [Char] -> Int
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 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 = t -> [Char] -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) [Char]
cs
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07ff = t -> [Char] -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
2) [Char]
cs
| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = t -> [Char] -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
3) [Char]
cs
| Bool
otherwise = t -> [Char] -> t
go (t
nt -> t -> t
forall 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 [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. HasCallStack => [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 => 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 a. [a] -> 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 => 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!"