{-# language BangPatterns #-}
{-# language DataKinds #-}
{-# language GADTSyntax #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language PatternSynonyms #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language UnboxedTuples #-}

-- | This module provides functions for encoding fixed-width words
-- using the base-62 encoding scheme. The encoding functions in this
-- module produce byte sequences that are ASCII-compatible text
-- encodings (e.g. ISO-8859-1 and UTF-8). Similarly, the decoding
-- functions only decode byte sequences that are an ASCII-compatible
-- text encoding of characters in the class @[A-Za-Z0-9]@. Other
-- encodings (notably UTF-16) are not supported but would be
-- accepted in a pull request.
module Data.Word.Base62
  ( -- * 64-bit Word
    encode64
  , builder64
  , decode64
    -- * 128-bit Word
  , encode128
  , shortText128
  , text128
  , builder128
  , decode128
  ) where

import Data.ByteString.Short.Internal (ShortByteString(SBS))
import Data.Bytes.Builder.Bounded.Unsafe (Builder(..))
import Data.Bytes.Types (Bytes(Bytes))
import Data.Char (ord)
import Data.Primitive (ByteArray(..),readByteArray,writeByteArray)
import Data.Primitive (MutableByteArray(MutableByteArray))
import Data.Text (Text)
import Data.Text.Short (ShortText)
import Data.WideWord.Word128 (Word128(Word128))
import GHC.Exts (ByteArray#,Int#,Int(I#),(+#),(-#))
import GHC.Exts (Char(C#),Word64#,Word8#,quotRemWord#,indexCharArray#)
import GHC.Exts (isTrue#,(>#))
import GHC.Exts (wordToWord64#,word64ToWord#)
import GHC.ST (ST(ST))
import GHC.Word (Word64(W64#),Word8(W8#))

import qualified Arithmetic.Nat as Nat
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Builder.Bounded as Builder
import qualified GHC.Exts as Exts
import qualified Data.Text.Short as TS
import qualified Data.Text.Short.Unsafe as TS

-- $setup
-- >>> :set -XNumericUnderscores
-- >>> import qualified Data.Bytes as Bytes

-- | Base62 encode a 64-bit word. Leading zero bits are suppressed.
--
-- >>> putStrLn (Bytes.toLatinString (Bytes.fromByteArray (encode64 213635)))
-- tZj
--
-- Note that this will encode the number 0 as the character 0 rather
-- than as the empty byte array.
encode64 :: Word64 -> ByteArray
encode64 :: Word64 -> ByteArray
encode64 = Nat 11 -> Builder 11 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Builder.run Nat 11
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Builder 11 -> ByteArray)
-> (Word64 -> Builder 11) -> Word64 -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder 11
builder64

-- | Base62 encode a 64-bit word as a builder.
builder64 :: Word64 -> Builder 11
{-# inline builder64 #-}
builder64 :: Word64 -> Builder 11
builder64 (W64# Word64#
w) = Word64# -> Builder 11
builder64# Word64#
w

-- | Base62 encode a 128-bit word. Leading zero bits are suppressed.
--
-- >>> let octillion = 1_000_000_000_000_000_000_000_000_000
-- >>> putStrLn (Bytes.toLatinString (Bytes.fromByteArray (encode128 octillion)))
-- 1IdHllabYuAOlNK4
encode128 :: Word128 -> ByteArray
{-# inline encode128 #-}
encode128 :: Word128 -> ByteArray
encode128 = Nat 22 -> Builder 22 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Builder.run Nat 22
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Builder 22 -> ByteArray)
-> (Word128 -> Builder 22) -> Word128 -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word128 -> Builder 22
builder128

-- | Base62 encode a 128-bit word as @ShortText@.
shortText128 :: Word128 -> ShortText
{-# inline shortText128 #-}
shortText128 :: Word128 -> ShortText
shortText128 !Word128
w = case Word128 -> ByteArray
encode128 Word128
w of
  ByteArray ByteArray#
x -> ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
x)

-- | Base62 encode a 128-bit word as @Text@.
text128 :: Word128 -> Text
{-# inline text128 #-}
text128 :: Word128 -> Text
text128 = ShortText -> Text
TS.toText (ShortText -> Text) -> (Word128 -> ShortText) -> Word128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word128 -> ShortText
shortText128

-- | Base62 encode a 128-bit word as a builder.
builder128 :: Word128 -> Builder 22
{-# inline builder128 #-}
builder128 :: Word128 -> Builder 22
builder128 (Word128 (W64# Word64#
a) (W64# Word64#
b)) = Word64# -> Word64# -> Builder 22
builder128# Word64#
a Word64#
b

builder64# :: Word64# -> Builder 11
{-# noinline builder64# #-}
builder64# :: Word64# -> Builder 11
builder64# Word64#
w0 = (forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder 11
forall (a :: Nat).
(forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder a
Builder
  (\MutableByteArray# s
marr Int#
off0 State# s
s0 -> case Word64# -> Word#
word64ToWord# Word64#
w0 of
    Word#
0## -> case MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
Exts.writeWord8Array# MutableByteArray# s
marr Int#
off0 (Word# -> Word8#
Exts.wordToWord8# Word#
48##) State# s
s0 of
      State# s
s1 -> (# State# s
s1, Int#
off0 Int# -> Int# -> Int#
+# Int#
1# #)
    Word#
_ -> let go :: Int# -> Word64# -> State# s -> (# State# s, Int# #)
go Int#
ix Word64#
w State# s
s1 = case Word64# -> Word#
word64ToWord# Word64#
w of
               Word#
0## -> case MutableByteArray s -> Int -> Int -> ST s ()
forall s. MutableByteArray s -> Int -> Int -> ST s ()
reverseBytes (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
marr) (Int# -> Int
I# Int#
off0) (Int# -> Int
I# (Int#
ix Int# -> Int# -> Int#
-# Int#
1# )) of
                 ST STRep s ()
f -> case STRep s ()
f State# s
s1 of
                   (# State# s
s2, (()
_ :: ()) #) -> (# State# s
s2, Int#
ix #)
               Word#
_ ->
                 let !(# Word#
q0, Word#
r0 #) = Word# -> Word# -> (# Word#, Word# #)
quotRemWord# (Word64# -> Word#
word64ToWord# Word64#
w) Word#
62##
                     !q :: Word64#
q = Word# -> Word64#
wordToWord64# Word#
q0
                     !r :: Word64#
r = Word# -> Word64#
wordToWord64# Word#
r0
                  in case MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
Exts.writeWord8Array# MutableByteArray# s
marr Int#
ix (Word8 -> Word8#
unW8 (Word64 -> Word8
encodeByte (Word64# -> Word64
W64# Word64#
r))) State# s
s1 of
                       State# s
s2 -> Int# -> Word64# -> State# s -> (# State# s, Int# #)
go (Int#
ix Int# -> Int# -> Int#
+# Int#
1#) Word64#
q State# s
s2
          in Int# -> Word64# -> State# s -> (# State# s, Int# #)
go Int#
off0 Word64#
w0 State# s
s0
  )

-- Always outputs exactly ten digits. They do not need to be reversed.
builder62pow10# :: Word64# -> Builder 10
{-# noinline builder62pow10# #-}
builder62pow10# :: Word64# -> Builder 10
builder62pow10# Word64#
w0 = (forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder 10
forall (a :: Nat).
(forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder a
Builder
  (\MutableByteArray# s
marr Int#
off0 State# s
s0 -> 
    let go :: Int# -> Int# -> Word64# -> State# s -> (# State# s, Int# #)
go Int#
ix Int#
d Word64#
w State# s
s1 = case Int#
d of
          Int#
0# -> (# State# s
s1, Int#
ix Int# -> Int# -> Int#
+# Int#
11# #) 
          Int#
_ ->
            let !(# Word#
q0, Word#
r0 #) = Word# -> Word# -> (# Word#, Word# #)
quotRemWord# (Word64# -> Word#
word64ToWord# Word64#
w) Word#
62##
                !q :: Word64#
q = Word# -> Word64#
wordToWord64# Word#
q0
                !r :: Word64#
r = Word# -> Word64#
wordToWord64# Word#
r0
             in case MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
Exts.writeWord8Array# MutableByteArray# s
marr Int#
ix (Word8 -> Word8#
unW8 (Word64 -> Word8
encodeByte (Word64# -> Word64
W64# Word64#
r))) State# s
s1 of
                  State# s
s2 -> Int# -> Int# -> Word64# -> State# s -> (# State# s, Int# #)
go (Int#
ix Int# -> Int# -> Int#
-# Int#
1# ) (Int#
d Int# -> Int# -> Int#
-# Int#
1# ) Word64#
q State# s
s2
     in Int# -> Int# -> Word64# -> State# s -> (# State# s, Int# #)
go (Int#
off0 Int# -> Int# -> Int#
+# Int#
9# ) Int#
10# Word64#
w0 State# s
s0
  )

builder128# :: Word64# -> Word64# -> Builder 22
{-# noinline builder128# #-}
builder128# :: Word64# -> Word64# -> Builder 22
builder128# Word64#
wa Word64#
wb = (forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder 22
forall (a :: Nat).
(forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder a
Builder
  (\MutableByteArray# s
marr Int#
off0 State# s
s0 -> case Word64# -> Word#
word64ToWord# Word64#
wa of
    Word#
0## -> case Word64# -> Builder 11
builder64# Word64#
wb of Builder forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f MutableByteArray# s
marr Int#
off0 State# s
s0
    Word#
_ -> case Word128 -> Word128 -> (Word128, Word128)
forall a. Integral a => a -> a -> (a, a)
quotRem (Word64 -> Word64 -> Word128
Word128 (Word64# -> Word64
W64# Word64#
wa) (Word64# -> Word64
W64# Word64#
wb)) (Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
n62pow10) of
      (upper :: Word128
upper@(Word128 Word64
upperHi (W64# Word64#
upperLo)), (Word128 Word64
shouldBeZeroA (W64# Word64#
lower))) -> case Word64
shouldBeZeroA of
        Word64
0 -> case Word64
upperHi of
          Word64
0 -> case Word64# -> Builder 11
builder64# Word64#
upperLo Builder 11 -> Builder 10 -> Builder (11 + 10)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Builder.append` Word64# -> Builder 10
builder62pow10# Word64#
lower of Builder forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f MutableByteArray# s
marr Int#
off0 State# s
s0
          Word64
_ -> case Word128 -> Word128 -> (Word128, Word128)
forall a. Integral a => a -> a -> (a, a)
quotRem Word128
upper (Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
n62pow10) of
            (Word128 Word64
shouldBeZeroB (W64# Word64#
x),Word128 Word64
shouldBeZeroC (W64# Word64#
y)) -> case Word64
shouldBeZeroB of
              Word64
0 -> case Word64
shouldBeZeroC of
                Word64
0 -> case Word64# -> Builder 11
builder64# Word64#
x Builder 11 -> Builder 20 -> Builder (11 + 20)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Builder.append` (Word64# -> Builder 10
builder62pow10# Word64#
y Builder 10 -> Builder 10 -> Builder (10 + 10)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Builder.append` Word64# -> Builder 10
builder62pow10# Word64#
lower) of Builder forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f MutableByteArray# s
marr Int#
off0 State# s
s0
                Word64
_ -> [Char] -> (# State# s, Int# #)
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Word.Base62: logical error c"
              Word64
_ -> [Char] -> (# State# s, Int# #)
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Word.Base62: logical error b"
        Word64
_ -> [Char] -> (# State# s, Int# #)
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Word.Base62: logical error a"
  )

-- Reverse the bytes in the designated slice. This takes
-- an inclusive start offset and an inclusive end offset.
reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()
{-# inline reverseBytes #-}
reverseBytes :: forall s. MutableByteArray s -> Int -> Int -> ST s ()
reverseBytes MutableByteArray s
arr Int
begin Int
end = Int -> Int -> ST s ()
forall {m :: * -> *}.
(PrimState m ~ s, PrimMonad m) =>
Int -> Int -> m ()
go Int
begin Int
end where
  go :: Int -> Int -> m ()
go Int
ixA Int
ixB = if Int
ixA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ixB
    then do
      Word8
a :: Word8 <- MutableByteArray (PrimState m) -> Int -> m Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
arr Int
ixA
      Word8
b :: Word8 <- MutableByteArray (PrimState m) -> Int -> m Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState m)
arr Int
ixB
      MutableByteArray (PrimState m) -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState m)
arr Int
ixA Word8
b
      MutableByteArray (PrimState m) -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState m)
arr Int
ixB Word8
a
      Int -> Int -> m ()
go (Int
ixA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
ixB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    else () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Precondition: argument is less than 62.
encodeByte :: Word64 -> Word8
encodeByte :: Word64 -> Word8
encodeByte Word64
w
  | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
10 = Word64 -> Word8
unsafeW8 (Char -> Word64
c2w Char
'0' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w)
  | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
36 = Word64 -> Word8
unsafeW8 ((Char -> Word64
c2w Char
'A' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
10) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w)
  | Bool
otherwise = Word64 -> Word8
unsafeW8 ((Char -> Word64
c2w Char
'a' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
36) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w)

-- We use Char here since it produces more readable Core.
-- Performance is not impacted in any way.
decodeByte :: Char -> Maybe Word64
decodeByte :: Char -> Maybe Word64
decodeByte Char
w
  | Char
w Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
w Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Char -> Word64
c2w Char
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Char -> Word64
c2w Char
'0')
  | Char
w Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
w Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Char -> Word64
c2w Char
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Char -> Word64
c2w Char
'A' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
10))
  | Char
w Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
w Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Char -> Word64
c2w Char
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Char -> Word64
c2w Char
'a' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
36))
  | Bool
otherwise = Maybe Word64
forall a. Maybe a
Nothing

c2w :: Char -> Word64
c2w :: Char -> Word64
c2w = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (Char -> Int) -> Char -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

-- Precondition: the argument is less than 256
unsafeW8 :: Word64 -> Word8
unsafeW8 :: Word64 -> Word8
unsafeW8 (W64# Word64#
w) = Word8# -> Word8
W8# (Word# -> Word8#
Exts.wordToWord8# (Word64# -> Word#
word64ToWord# Word64#
w))

unW8 :: Word8 -> Word8#
unW8 :: Word8 -> Word8#
unW8 (W8# Word8#
w) = Word8#
w

-- | Decode a base62-encoded 64-bit word. This rejects the empty
-- string rather than decoding it as zero. This also rejects encoded
-- numbers greater than or equal to @2^64@.
--
-- >>> decode64 (Bytes.fromAsciiString "LygHa16AHYB")
-- Just 18446744073709551611
-- >>> decode64 (Bytes.fromAsciiString "1IdHllabYuAOlNK4")
-- Nothing
decode64 :: Bytes -> Maybe Word64
{-# inline decode64 #-}
decode64 :: Bytes -> Maybe Word64
decode64 b :: Bytes
b@(Bytes ByteArray
_ Int
_ Int
len) = case Int
len of
  Int
0 -> Maybe Word64
forall a. Maybe a
Nothing
  Int
_ -> case Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# Word64
0 Bytes
b of
    (# (# #) | #) -> Maybe Word64
forall a. Maybe a
Nothing
    (# | Word64#
w #) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64# -> Word64
W64# Word64#
w)

-- Worker-wrapper will turn this into good code as long as
-- we do not put a noinline pragma on it. It is recursive,
-- so it cannot inline anywhere.
decode64# :: Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# :: Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# !acc :: Word64
acc@(W64# Word64#
acc# ) b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len) = case Int
len of
  Int
0 -> (# | Word64#
acc# #)
  Int
_ -> case Char -> Maybe Word64
decodeByte (ByteArray -> Int -> Char
indexAsciiArray ByteArray
arr Int
off) of
    Maybe Word64
Nothing -> (# (# #) | #)
    Just Word64
w ->
      -- If we overflow, the accumulator will shrink. We
      -- return Nothing in this case.
      let (Bool
overflow,Word64
acc') = Word64 -> Word64 -> (Bool, Word64)
unsignedPushBase62 Word64
acc Word64
w
       in if Bool
overflow
            then (# (# #) | #)
            else Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# Word64
acc' (Int -> Bytes -> Bytes
Bytes.unsafeDrop Int
1 Bytes
b)

n62pow10 :: Word64
n62pow10 :: Word64
n62pow10 = Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62

n62pow20 :: Word128
n62pow20 :: Word128
n62pow20 = Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
n62pow10 Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
n62pow10

-- Precondition: there are at least 10 bytes starting at the offset.
-- The result is in [0,62^10) Notice that we do not need to check
-- for overflow in this function. While @off@ tracks the actual
-- position in the bytearray, @d@ tracks the number of digits
-- consumed by this particular function. The caller should always
-- set @d@ to 0.
unsafeDecode62pow10# :: Word64 -> ByteArray -> Int -> Int -> (# (# #) | Word64# #)
unsafeDecode62pow10# :: Word64 -> ByteArray -> Int -> Int -> (# (# #) | Word64# #)
unsafeDecode62pow10# !acc :: Word64
acc@(W64# Word64#
acc# ) !ByteArray
arr !Int
off !Int
d = if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10
  then case Char -> Maybe Word64
decodeByte (ByteArray -> Int -> Char
indexAsciiArray ByteArray
arr Int
off) of
    Maybe Word64
Nothing -> (# (# #) | #)
    Just Word64
w ->
      let acc' :: Word64
acc' = Word64
acc Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
62 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w
       in Word64 -> ByteArray -> Int -> Int -> (# (# #) | Word64# #)
unsafeDecode62pow10# Word64
acc' ByteArray
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  else (# | Word64#
acc# #)

-- | Decode a base62-encoded 128-bit word. This rejects the empty
-- string rather than decoding it as zero. This also rejects encoded
-- numbers greater than or equal to @2^128@.
--
-- >>> decode128 (Bytes.fromAsciiString "LygHa16AHYB")
-- Just 18446744073709551611
-- >>> decode128 (Bytes.fromAsciiString "7n42DGM5Tflk9n8mt7Fhc6")
-- Just 340282366920938463463374607431768211454
-- >>> decode128 (Bytes.fromAsciiString "7n42DGM5Tflk9n8mt7Fhc9")
-- Nothing
decode128 :: Bytes -> Maybe Word128
{-# inline decode128 #-}
decode128 :: Bytes -> Maybe Word128
decode128 (Bytes (ByteArray ByteArray#
arr) (I# Int#
off) (I# Int#
len)) =
  case ByteArray# -> Int# -> Int# -> (# (# #) | (# Word64#, Word64# #) #)
decode128# ByteArray#
arr Int#
off Int#
len of
    (# (# #) | #) -> Maybe Word128
forall a. Maybe a
Nothing
    (# | (# Word64#
a, Word64#
b #) #) -> Word128 -> Maybe Word128
forall a. a -> Maybe a
Just (Word64 -> Word64 -> Word128
Word128 (Word64# -> Word64
W64# Word64#
a) (Word64# -> Word64
W64# Word64#
b))

decode128# :: ByteArray# -> Int# -> Int# -> (# (# #) | (# Word64#, Word64# #) #)
{-# noinline decode128# #-}
decode128# :: ByteArray# -> Int# -> Int# -> (# (# #) | (# Word64#, Word64# #) #)
decode128# ByteArray#
arr Int#
off Int#
len
  | Int# -> Bool
isTrue# (Int#
len Int# -> Int# -> Int#
># Int#
22# ) = (# (# #) | #) -- always overflows
  | Int# -> Bool
isTrue# (Int#
len Int# -> Int# -> Int#
># Int#
20# ) =
      case Word64 -> ByteArray -> Int -> Int -> (# (# #) | Word64# #)
unsafeDecode62pow10# Word64
0 (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# (Int#
off Int# -> Int# -> Int#
+# Int#
len Int# -> Int# -> Int#
-# Int#
10# )) Int
0 of
        (# (# #) | #) -> (# (# #) | #)
        (# | Word64#
c #) -> case Word64 -> ByteArray -> Int -> Int -> (# (# #) | Word64# #)
unsafeDecode62pow10# Word64
0 (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# (Int#
off Int# -> Int# -> Int#
+# Int#
len Int# -> Int# -> Int#
-# Int#
20# )) Int
0 of
          (# (# #) | #) -> (# (# #) | #)
          (# | Word64#
b #) -> case Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# Word64
0 (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# Int#
off) (Int# -> Int
I# (Int#
len Int# -> Int# -> Int#
-# Int#
20# ))) of
            (# (# #) | #) -> (# (# #) | #)
            (# | Word64#
a #) -> if Word64# -> Word64
W64# Word64#
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
484
              then
                let r0 :: Word128
r0 = Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64# -> Word64
W64# Word64#
c) Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ (Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
n62pow10 Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
* (Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64# -> Word64
W64# Word64#
b)))
                    !r1 :: Word128
r1@(Word128 (W64# Word64#
r1x) (W64# Word64#
r1y)) = Word128
n62pow20 Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64# -> Word64
W64# Word64#
a) Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ Word128
r0
                 in if Word128
r1 Word128 -> Word128 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word128
r0
                      then (# | (# Word64#
r1x, Word64#
r1y #) #)
                      else (# (# #) | #)
              else (# (# #) | #)
  | Int# -> Bool
isTrue# (Int#
len Int# -> Int# -> Int#
># Int#
10# ) =
      case Word64 -> ByteArray -> Int -> Int -> (# (# #) | Word64# #)
unsafeDecode62pow10# Word64
0 (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# (Int#
off Int# -> Int# -> Int#
+# Int#
len Int# -> Int# -> Int#
-# Int#
10# )) Int
0 of
        (# (# #) | #) -> (# (# #) | #)
        (# | Word64#
b #) -> case Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# Word64
0 (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# Int#
off) (Int# -> Int
I# (Int#
len Int# -> Int# -> Int#
-# Int#
10# ))) of
          (# (# #) | #) -> (# (# #) | #)
          (# | Word64#
a #) -> case Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64# -> Word64
W64# Word64#
b) Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ (Word64 -> Word128
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n62pow10 Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64# -> Word64
W64# Word64#
a)) of
            Word128 (W64# Word64#
x) (W64# Word64#
y) -> (# | (# Word64#
x, Word64#
y #) #)
  | Bool
otherwise = case Word64 -> Bytes -> (# (# #) | Word64# #)
decode64# Word64
0 (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# Int#
off) (Int# -> Int
I# Int#
len)) of
      (# (# #) | #) -> (# (# #) | #)
      (# | Word64#
w #) -> (# | (# Word# -> Word64#
wordToWord64# Word#
0##, Word64#
w #) #)

indexAsciiArray :: ByteArray -> Int -> Char
indexAsciiArray :: ByteArray -> Int -> Char
indexAsciiArray (ByteArray ByteArray#
arr) (I# Int#
i) = Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexCharArray# ByteArray#
arr Int#
i)

unsignedPushBase62 :: Word64 -> Word64 -> (Bool,Word64)
{-# inline unsignedPushBase62 #-}
unsignedPushBase62 :: Word64 -> Word64 -> (Bool, Word64)
unsignedPushBase62 (W64# Word64#
a) (W64# Word64#
b) = 
  let !(# Word#
ca, Word#
r0 #) = Word# -> Word# -> (# Word#, Word# #)
Exts.timesWord2# (Word64# -> Word#
word64ToWord# Word64#
a) Word#
62##
   in case Word#
ca of
        Word#
0## ->
          let !r0' :: Word64#
r0' = Word# -> Word64#
wordToWord64# Word#
r0
              !r1 :: Word64#
r1 = Word64# -> Word64# -> Word64#
Exts.plusWord64# Word64#
r0' Word64#
b
           in case Word64# -> Word64# -> Int#
Exts.ltWord64# Word64#
r1 Word64#
r0' of
                Int#
1# -> (Bool
True,Word64
0)
                Int#
_ -> (Bool
False,Word64# -> Word64
W64# Word64#
r1)
        Word#
_ -> (Bool
True,Word64
0)