module Data.TypeID.Internal where

import           Control.Exception
import           Control.Monad
import           Control.Monad.ST
import           Data.Aeson.Types hiding (Array, String)
import           Data.Array
import           Data.Array.ST
import           Data.Array.Unsafe (unsafeFreeze)
import           Data.Bifunctor
import           Data.Bits
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import           Data.Char
import           Data.String
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding
import           Data.TypeID.Class
import           Data.TypeID.Error
import           Data.UUID.V7 (UUID(..))
import qualified Data.UUID.V7 as UUID
import           Data.Word

-- | The constructor is not exposed to the public API to prevent generating
-- invalid @TypeID@s.
--
-- Note that the 'Show' instance is for debugging purposes only. To pretty-print
-- a 'TypeID', use 'toString', 'toText' or 'toByteString'. However, this
-- behaviour will be changed in the next major version as it is not useful. By
-- then, the 'Show' instance will be the same as 'toString'.
data TypeID = TypeID { TypeID -> Text
_getPrefix :: Text
                     , TypeID -> UUID
_getUUID   :: UUID }
  deriving (TypeID -> TypeID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeID -> TypeID -> Bool
$c/= :: TypeID -> TypeID -> Bool
== :: TypeID -> TypeID -> Bool
$c== :: TypeID -> TypeID -> Bool
Eq, Eq TypeID
TypeID -> TypeID -> Bool
TypeID -> TypeID -> Ordering
TypeID -> TypeID -> TypeID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeID -> TypeID -> TypeID
$cmin :: TypeID -> TypeID -> TypeID
max :: TypeID -> TypeID -> TypeID
$cmax :: TypeID -> TypeID -> TypeID
>= :: TypeID -> TypeID -> Bool
$c>= :: TypeID -> TypeID -> Bool
> :: TypeID -> TypeID -> Bool
$c> :: TypeID -> TypeID -> Bool
<= :: TypeID -> TypeID -> Bool
$c<= :: TypeID -> TypeID -> Bool
< :: TypeID -> TypeID -> Bool
$c< :: TypeID -> TypeID -> Bool
compare :: TypeID -> TypeID -> Ordering
$ccompare :: TypeID -> TypeID -> Ordering
Ord, Int -> TypeID -> ShowS
[TypeID] -> ShowS
TypeID -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TypeID] -> ShowS
$cshowList :: [TypeID] -> ShowS
show :: TypeID -> [Char]
$cshow :: TypeID -> [Char]
showsPrec :: Int -> TypeID -> ShowS
$cshowsPrec :: Int -> TypeID -> ShowS
Show)

instance ToJSON TypeID where
  toJSON :: TypeID -> Value
  toJSON :: TypeID -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeID -> Text
toText
  {-# INLINE toJSON #-}

instance FromJSON TypeID where
  parseJSON :: Value -> Parser TypeID
  parseJSON :: Value -> Parser TypeID
parseJSON Value
str = do
    Text
s <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
str
    case Text -> Either TypeIDError TypeID
parseText Text
s of
      Left TypeIDError
err  -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show TypeIDError
err
      Right TypeID
tid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeID
tid
  {-# INLINE parseJSON #-}

instance ToJSONKey TypeID where
  toJSONKey :: ToJSONKeyFunction TypeID
  toJSONKey :: ToJSONKeyFunction TypeID
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText TypeID -> Text
toText
  {-# INLINE toJSONKey #-}

instance FromJSONKey TypeID where
  fromJSONKey :: FromJSONKeyFunction TypeID
  fromJSONKey :: FromJSONKeyFunction TypeID
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser \Text
t -> case Text -> Either TypeIDError TypeID
parseText Text
t of
    Left TypeIDError
err  -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show TypeIDError
err
    Right TypeID
tid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeID
tid
  {-# INLINE fromJSONKey #-}

-- | Get the prefix, 'UUID', and timestamp of a 'TypeID'.
instance IDType TypeID where
  getPrefix :: TypeID -> Text
  getPrefix :: TypeID -> Text
getPrefix = TypeID -> Text
_getPrefix
  {-# INLINE getPrefix #-}

  getUUID :: TypeID -> UUID
  getUUID :: TypeID -> UUID
getUUID = TypeID -> UUID
_getUUID
  {-# INLINE getUUID #-}

  getTime :: TypeID -> Word64
  getTime :: TypeID -> Word64
getTime = UUID -> Word64
UUID.getTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDType a => a -> UUID
getUUID
  {-# INLINE getTime #-}

-- | Conversion between 'TypeID' and 'String'/'Text'/'ByteString'.
instance IDConv TypeID where
  string2ID :: String -> Either TypeIDError TypeID
  string2ID :: [Char] -> Either TypeIDError TypeID
string2ID = [Char] -> Either TypeIDError TypeID
parseString
  {-# INLINE string2ID #-}

  text2ID :: Text -> Either TypeIDError TypeID
  text2ID :: Text -> Either TypeIDError TypeID
text2ID = Text -> Either TypeIDError TypeID
parseText
  {-# INLINE text2ID #-}

  byteString2ID :: ByteString -> Either TypeIDError TypeID
  byteString2ID :: ByteString -> Either TypeIDError TypeID
byteString2ID = ByteString -> Either TypeIDError TypeID
parseByteString
  {-# INLINE byteString2ID #-}

  id2String :: TypeID -> String
  id2String :: TypeID -> [Char]
id2String = TypeID -> [Char]
toString
  {-# INLINE id2String #-}

  id2Text :: TypeID -> Text
  id2Text :: TypeID -> Text
id2Text = TypeID -> Text
toText
  {-# INLINE id2Text #-}

  id2ByteString :: TypeID -> ByteString
  id2ByteString :: TypeID -> ByteString
id2ByteString = TypeID -> ByteString
toByteString
  {-# INLINE id2ByteString #-}

-- | Generate a new 'TypeID' from a prefix.
--
-- It throws a 'TypeIDError' if the prefix does not match the specification,
-- namely if it's longer than 63 characters or if it contains characters other
-- than lowercase latin letters.
genTypeID :: Text -> IO TypeID
genTypeID :: Text -> IO TypeID
genTypeID = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Word16 -> IO [TypeID]
`genTypeIDs` Word16
1)
{-# INLINE genTypeID #-}

-- | Generate n 'TypeID's from a prefix.
--
-- It tries its best to generate 'TypeID's at the same timestamp, but it may not
-- be possible if we are asking too many 'UUID's at the same time.
--
-- It is guaranteed that the first 32768 'TypeID's are generated at the same
-- timestamp.
genTypeIDs :: Text -> Word16 -> IO [TypeID]
genTypeIDs :: Text -> Word16 -> IO [TypeID]
genTypeIDs Text
prefix Word16
n = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> forall a b. (a -> b) -> [a] -> [b]
map (Text -> UUID -> TypeID
TypeID Text
prefix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> IO [UUID]
UUID.genUUIDs Word16
n
  Just TypeIDError
err -> forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
{-# INLINE genTypeIDs #-}

-- | The nil 'TypeID'.
nil :: TypeID
nil :: TypeID
nil = Text -> UUID -> TypeID
TypeID Text
"" UUID
UUID.nil
{-# INLINE nil #-}
{-# DEPRECATED nil "Use nilTypeID instead." #-}

-- | The nil 'TypeID'.
nilTypeID :: TypeID
nilTypeID :: TypeID
nilTypeID = Text -> UUID -> TypeID
TypeID Text
"" UUID
UUID.nil
{-# INLINE nilTypeID #-}

-- | Obtain a 'TypeID' from a prefix and a 'UUID'.
decorate :: Text -> UUID -> Either TypeIDError TypeID
decorate :: Text -> UUID -> Either TypeIDError TypeID
decorate Text
prefix UUID
uuid = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> UUID -> TypeID
TypeID Text
prefix UUID
uuid
  Just TypeIDError
err -> forall a b. a -> Either a b
Left TypeIDError
err
{-# INLINE decorate #-}
{-# DEPRECATED decorate "Use decorateTypeID instead." #-}

-- | Obtain a 'TypeID' from a prefix and a 'UUID'.
decorateTypeID :: Text -> UUID -> Either TypeIDError TypeID
decorateTypeID :: Text -> UUID -> Either TypeIDError TypeID
decorateTypeID Text
prefix UUID
uuid = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> UUID -> TypeID
TypeID Text
prefix UUID
uuid
  Just TypeIDError
err -> forall a b. a -> Either a b
Left TypeIDError
err
{-# INLINE decorateTypeID #-}

-- | Pretty-print a 'TypeID'. It is 'id2String' with concrete type.
toString :: TypeID -> String
toString :: TypeID -> [Char]
toString (TypeID Text
prefix (UUID ByteString
bs)) = if Text -> Bool
T.null Text
prefix
  then ByteString -> [Char]
suffixEncode ByteString
bs
  else Text -> [Char]
T.unpack Text
prefix forall a. [a] -> [a] -> [a]
++ [Char]
"_" forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
suffixEncode ByteString
bs
{-# INLINE toString #-}

-- | Pretty-print a 'TypeID' to strict 'Text'. It is 'id2Text' with concrete
-- type.
toText :: TypeID -> Text
toText :: TypeID -> Text
toText (TypeID Text
prefix (UUID ByteString
bs)) = if Text -> Bool
T.null Text
prefix
  then [Char] -> Text
T.pack (ByteString -> [Char]
suffixEncode ByteString
bs)
  else Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
suffixEncode ByteString
bs)
{-# INLINE toText #-}

-- | Pretty-print a 'TypeID' to lazy 'ByteString'. It is 'id2ByteString' with
-- concrete type.
toByteString :: TypeID -> ByteString
toByteString :: TypeID -> ByteString
toByteString = forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeID -> [Char]
toString
{-# INLINE toByteString #-}

-- | Parse a 'TypeID' from its 'String' representation. It is 'string2ID' with
-- concrete type.
parseString :: String -> Either TypeIDError TypeID
parseString :: [Char] -> Either TypeIDError TypeID
parseString [Char]
str = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'_') [Char]
str of
  ([Char]
"", [Char]
_)              -> forall a b. a -> Either a b
Left TypeIDError
TypeIDExtraSeparator
  ([Char]
_, [Char]
"")              -> Text -> UUID -> TypeID
TypeID Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
  ([Char]
prefix, Char
_ : [Char]
suffix) -> do
    let prefix' :: Text
prefix' = [Char] -> Text
T.pack [Char]
prefix
    let bs :: ByteString
bs      = forall a. IsString a => [Char] -> a
fromString [Char]
suffix
    case Text -> Maybe TypeIDError
checkPrefix Text
prefix' of
      Maybe TypeIDError
Nothing  -> Text -> UUID -> TypeID
TypeID Text
prefix' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
      Just TypeIDError
err -> forall a b. a -> Either a b
Left TypeIDError
err
  where
    bs :: ByteString
bs = forall a. IsString a => [Char] -> a
fromString [Char]
str

-- | Parse a 'TypeID' from its string representation as a strict 'Text'. It is
-- 'text2ID' with concrete type.
parseText :: Text -> Either TypeIDError TypeID
parseText :: Text -> Either TypeIDError TypeID
parseText Text
text = case forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
/= Char
'_') Text
text of
  (Text
"", Maybe (Char, Text)
_)                    -> forall a b. a -> Either a b
Left TypeIDError
TypeIDExtraSeparator
  (Text
_, Maybe (Char, Text)
Nothing)               -> Text -> UUID -> TypeID
TypeID Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
  (Text
prefix, Just (Char
_, Text
suffix)) -> do
    let bs :: ByteString
bs = ByteString -> ByteString
BSL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
suffix
    case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
      Maybe TypeIDError
Nothing  -> Text -> UUID -> TypeID
TypeID Text
prefix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
      Just TypeIDError
err -> forall a b. a -> Either a b
Left TypeIDError
err
  where
    bs :: ByteString
bs = ByteString -> ByteString
BSL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
text

-- | Parse a 'TypeID' from its string representation as a lazy 'ByteString'. It
-- is 'byteString2ID' with concrete type.
parseByteString :: ByteString -> Either TypeIDError TypeID
parseByteString :: ByteString -> Either TypeIDError TypeID
parseByteString ByteString
bs = case forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> Maybe (Word8, ByteString)
BSL.uncons forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BSL.span (forall a. Eq a => a -> a -> Bool
/= Word8
95) ByteString
bs of
  (ByteString
"", Maybe (Word8, ByteString)
_)                    -> forall a b. a -> Either a b
Left TypeIDError
TypeIDExtraSeparator
  (ByteString
_, Maybe (Word8, ByteString)
Nothing)               -> Text -> UUID -> TypeID
TypeID Text
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
  (ByteString
prefix, Just (Word8
_, ByteString
suffix)) -> do
    let prefix' :: Text
prefix' = ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
prefix
    case Text -> Maybe TypeIDError
checkPrefix Text
prefix' of
      Maybe TypeIDError
Nothing  -> Text -> UUID -> TypeID
TypeID Text
prefix' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
suffix
      Just TypeIDError
err -> forall a b. a -> Either a b
Left TypeIDError
err

-- | Parse a 'TypeID' from the given prefix and the 'String' representation of a
-- suffix.
parseStringWithPrefix :: Text -> String -> Either TypeIDError TypeID
parseStringWithPrefix :: Text -> [Char] -> Either TypeIDError TypeID
parseStringWithPrefix Text
prefix [Char]
str = case [Char] -> Either TypeIDError TypeID
parseString [Char]
str of
  Right (TypeID Text
"" UUID
uuid) -> Text -> UUID -> Either TypeIDError TypeID
decorate Text
prefix UUID
uuid
  Right (TypeID Text
p  UUID
_)    -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TypeIDError
TypeIDErrorAlreadyHasPrefix Text
p
  Left TypeIDError
err               -> forall a b. a -> Either a b
Left TypeIDError
err
{-# INLINE parseStringWithPrefix #-}
{-# DEPRECATED parseStringWithPrefix "Use 'parseString' and 'decorate' instead" #-}

-- | Parse a 'TypeID' from the given prefix and the string representation of a
-- suffix as a strict 'Text'.
parseTextWithPrefix :: Text -> Text -> Either TypeIDError TypeID
parseTextWithPrefix :: Text -> Text -> Either TypeIDError TypeID
parseTextWithPrefix Text
prefix Text
text = case Text -> Either TypeIDError TypeID
parseText Text
text of
  Right (TypeID Text
"" UUID
uuid) -> Text -> UUID -> Either TypeIDError TypeID
decorate Text
prefix UUID
uuid
  Right (TypeID Text
p  UUID
_)    -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TypeIDError
TypeIDErrorAlreadyHasPrefix Text
p
  Left TypeIDError
err               -> forall a b. a -> Either a b
Left TypeIDError
err
{-# INLINE parseTextWithPrefix #-}
{-# DEPRECATED parseTextWithPrefix "Use 'parseText' and 'decorate' instead" #-}

-- | Parse a 'TypeID' from the given prefix and the string representation of a
-- suffix as a lazy 'ByteString'.
parseByteStringWithPrefix :: Text -> ByteString -> Either TypeIDError TypeID
parseByteStringWithPrefix :: Text -> ByteString -> Either TypeIDError TypeID
parseByteStringWithPrefix Text
prefix ByteString
bs = case ByteString -> Either TypeIDError TypeID
parseByteString ByteString
bs of
  Right (TypeID Text
"" UUID
uuid) -> Text -> UUID -> Either TypeIDError TypeID
decorate Text
prefix UUID
uuid
  Right (TypeID Text
p  UUID
_)    -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TypeIDError
TypeIDErrorAlreadyHasPrefix Text
p
  Left TypeIDError
err               -> forall a b. a -> Either a b
Left TypeIDError
err
{-# INLINE parseByteStringWithPrefix #-}
{-# DEPRECATED parseByteStringWithPrefix "Use 'parseByteString' and 'decorate' instead" #-}

-- | Check if the given prefix is a valid TypeID prefix.
checkPrefix :: Text -> Maybe TypeIDError
checkPrefix :: Text -> Maybe TypeIDError
checkPrefix Text
prefix
  | Text -> Int
T.length Text
prefix forall a. Ord a => a -> a -> Bool
> Int
63 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> TypeIDError
TypeIDErrorPrefixTooLong (Text -> Int
T.length Text
prefix)
  | Bool
otherwise  
      = case Text -> Maybe (Char, Text)
T.uncons ((Char -> Bool) -> Text -> Text
T.dropWhile (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&) Char -> Bool
isLower Char -> Bool
isAscii) Text
prefix) of
        Maybe (Char, Text)
Nothing     -> forall a. Maybe a
Nothing
        Just (Char
c, Text
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> TypeIDError
TypeIDErrorPrefixInvalidChar Char
c
{-# INLINE checkPrefix #-}

-- The helpers below are verbatim translations from the official highly magical
-- Go implementation.

suffixEncode :: ByteString -> String
suffixEncode :: ByteString -> [Char]
suffixEncode ByteString
bs = (Array Word8 Char
alphabet forall i e. Ix i => Array i e -> i -> e
!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (forall s. ST s a) -> a
runST do
  STUArray s Int Word8
dest <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
0, Int
25) :: ST s (STUArray s Int Word8)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
0 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
0 forall a. Bits a => a -> a -> a
.&. Word8
224) forall a. Bits a => a -> Int -> a
`shiftR` Int
5
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
1 forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
0 forall a. Bits a => a -> a -> a
.&. Word8
31
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
2 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
1 forall a. Bits a => a -> a -> a
.&. Word8
248) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
3 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
1 forall a. Bits a => a -> a -> a
.&. Word8
7) forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
2 forall a. Bits a => a -> a -> a
.&. Word8
192) forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
4 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
2 forall a. Bits a => a -> a -> a
.&. Word8
62) forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
5 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
2 forall a. Bits a => a -> a -> a
.&. Word8
1) forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
3 forall a. Bits a => a -> a -> a
.&. Word8
240) forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
6 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
3 forall a. Bits a => a -> a -> a
.&. Word8
15) forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
4 forall a. Bits a => a -> a -> a
.&. Word8
128) forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
7 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
4 forall a. Bits a => a -> a -> a
.&. Word8
124) forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
8 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
4 forall a. Bits a => a -> a -> a
.&. Word8
3) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
5 forall a. Bits a => a -> a -> a
.&. Word8
224) forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
9 forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
5 forall a. Bits a => a -> a -> a
.&. Word8
31
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
10 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
6 forall a. Bits a => a -> a -> a
.&. Word8
248) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
11 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
6 forall a. Bits a => a -> a -> a
.&. Word8
7) forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
7 forall a. Bits a => a -> a -> a
.&. Word8
192) forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
12 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
7 forall a. Bits a => a -> a -> a
.&. Word8
62) forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
13 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
7 forall a. Bits a => a -> a -> a
.&. Word8
1) forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
8 forall a. Bits a => a -> a -> a
.&. Word8
240) forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
14 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
8 forall a. Bits a => a -> a -> a
.&. Word8
15) forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
9 forall a. Bits a => a -> a -> a
.&. Word8
128) forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
15 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
9 forall a. Bits a => a -> a -> a
.&. Word8
124) forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
16 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
9 forall a. Bits a => a -> a -> a
.&. Word8
3) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
10 forall a. Bits a => a -> a -> a
.&. Word8
224) forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
17 forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
10 forall a. Bits a => a -> a -> a
.&. Word8
31
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
18 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
11 forall a. Bits a => a -> a -> a
.&. Word8
248) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
19 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
11 forall a. Bits a => a -> a -> a
.&. Word8
7) forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
12 forall a. Bits a => a -> a -> a
.&. Word8
192) forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
20 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
12 forall a. Bits a => a -> a -> a
.&. Word8
62) forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
21 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
12 forall a. Bits a => a -> a -> a
.&. Word8
1) forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
13 forall a. Bits a => a -> a -> a
.&. Word8
240) forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
22 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
13 forall a. Bits a => a -> a -> a
.&. Word8
15) forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
14 forall a. Bits a => a -> a -> a
.&. Word8
128) forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
23 forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
14 forall a. Bits a => a -> a -> a
.&. Word8
124) forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
24 forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
14 forall a. Bits a => a -> a -> a
.&. Word8
3) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
15 forall a. Bits a => a -> a -> a
.&. Word8
224) forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
25 forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
15 forall a. Bits a => a -> a -> a
.&. Word8
31
  forall i e. Array i e -> [e]
elems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Word8
dest
  where
    alphabet :: Array Word8 Char
alphabet = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Word8
0, Word8
31) [Char]
"0123456789abcdefghjkmnpqrstvwxyz"

suffixDecode :: ByteString -> ByteString
suffixDecode :: ByteString -> ByteString
suffixDecode ByteString
bs = [Word8] -> ByteString
BSL.pack forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST do
  STUArray s Int Word8
dest <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
0, Int
15) :: ST s (STUArray s Int Word8)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
0 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
0)) forall a. Bits a => a -> Int -> a
`shiftL` Int
5) forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
1))
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
1 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
2)) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
3)) forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
2 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
3)) forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
4)) forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
5)) forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
3 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
5)) forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
6)) forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
4 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
6)) forall a. Bits a => a -> Int -> a
`shiftL` Int
7) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
7)) forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
8)) forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
5 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
8)) forall a. Bits a => a -> Int -> a
`shiftL` Int
5) forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
9))
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
6 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
10)) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
11)) forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
7 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
11)) forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
12)) forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
13)) forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
8 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
13)) forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
14)) forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
9 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
14)) forall a. Bits a => a -> Int -> a
`shiftL` Int
7) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
15)) forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
16)) forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
10 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
16)) forall a. Bits a => a -> Int -> a
`shiftL` Int
5) forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
17))
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
11 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
18)) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
19)) forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
12 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
19)) forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
20)) forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
21)) forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
13 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
21)) forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
22)) forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
14 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
22)) forall a. Bits a => a -> Int -> a
`shiftL` Int
7) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
23)) forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
24)) forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word8
dest Int
15 forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
24)) forall a. Bits a => a -> Int -> a
`shiftL` Int
5) forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
25))
  forall i e. Array i e -> [e]
elems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Word8
dest

decodeUUID :: ByteString -> Either TypeIDError UUID
decodeUUID :: ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int64
BSL.length ByteString
bs forall a. Eq a => a -> a -> Bool
== Int64
26) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
`BSL.index` Int64
0 forall a. Ord a => a -> a -> Bool
<= Word8
55) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== Word8
0xFF) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Word8 Word8
table forall i e. Ix i => Array i e -> i -> e
!)) forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BSL.unpack ByteString
bs) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UUID
UUID forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
suffixDecode ByteString
bs

table :: Array Word8 Word8
table :: Array Word8 Word8
table = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Word8
0, Word8
255) 
  [ Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0x00, Word8
0x01
  , Word8
0x02, Word8
0x03, Word8
0x04, Word8
0x05, Word8
0x06, Word8
0x07, Word8
0x08, Word8
0x09, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0x0A, Word8
0x0B, Word8
0x0C
  , Word8
0x0D, Word8
0x0E, Word8
0x0F, Word8
0x10, Word8
0x11, Word8
0xFF, Word8
0x12, Word8
0x13, Word8
0xFF, Word8
0x14
  , Word8
0x15, Word8
0xFF, Word8
0x16, Word8
0x17, Word8
0x18, Word8
0x19, Word8
0x1A, Word8
0xFF, Word8
0x1B, Word8
0x1C
  , Word8
0x1D, Word8
0x1E, Word8
0x1F, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF
  , Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF, Word8
0xFF ]