-- |
-- Module      : Data.TypeID.Internal
-- License     : MIT
-- Maintainer  : mmzk1526@outlook.com
-- Portability : GHC
--
module Data.TypeID.Internal where

import           Control.Exception
import           Control.Monad
import           Control.Monad.IO.Class
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.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import           Data.Bifunctor
import           Data.Bits
import qualified Data.ByteString as BS
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import           Data.Char
import           Data.Data (Data)
import           Data.Functor.Identity
import           Data.Hashable
import           Data.Proxy
import           Data.String
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding
import           Data.Tuple
import           Data.Typeable (Typeable)
import           Data.TypeID.Class
import           Data.TypeID.Error
import           Data.UUID.Types.Internal (UUID(..))
import qualified Data.UUID.V1 as V1
import qualified Data.UUID.V4 as V4
import qualified Data.UUID.V5 as V5
import qualified Data.UUID.V7 as V7
import           Data.UUID.Versions
import           Foreign
import           System.Random

-- | This data type also supports 'Data.TypeID.V7.TypeID's with 'UUID' versions
-- other than v7.
--
--  The constructor is not exposed to the public API to prevent generating
-- invalid 'TypeID''s.
data TypeID' (version :: UUIDVersion) = TypeID' Text UUID
  deriving (TypeID' version -> TypeID' version -> Bool
(TypeID' version -> TypeID' version -> Bool)
-> (TypeID' version -> TypeID' version -> Bool)
-> Eq (TypeID' version)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
$c== :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
== :: TypeID' version -> TypeID' version -> Bool
$c/= :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
/= :: TypeID' version -> TypeID' version -> Bool
Eq, Eq (TypeID' version)
Eq (TypeID' version)
-> (TypeID' version -> TypeID' version -> Ordering)
-> (TypeID' version -> TypeID' version -> Bool)
-> (TypeID' version -> TypeID' version -> Bool)
-> (TypeID' version -> TypeID' version -> Bool)
-> (TypeID' version -> TypeID' version -> Bool)
-> (TypeID' version -> TypeID' version -> TypeID' version)
-> (TypeID' version -> TypeID' version -> TypeID' version)
-> Ord (TypeID' version)
TypeID' version -> TypeID' version -> Bool
TypeID' version -> TypeID' version -> Ordering
TypeID' version -> TypeID' version -> TypeID' version
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
forall (version :: UUIDVersion). Eq (TypeID' version)
forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Ordering
forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> TypeID' version
$ccompare :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Ordering
compare :: TypeID' version -> TypeID' version -> Ordering
$c< :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
< :: TypeID' version -> TypeID' version -> Bool
$c<= :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
<= :: TypeID' version -> TypeID' version -> Bool
$c> :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
> :: TypeID' version -> TypeID' version -> Bool
$c>= :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> Bool
>= :: TypeID' version -> TypeID' version -> Bool
$cmax :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> TypeID' version
max :: TypeID' version -> TypeID' version -> TypeID' version
$cmin :: forall (version :: UUIDVersion).
TypeID' version -> TypeID' version -> TypeID' version
min :: TypeID' version -> TypeID' version -> TypeID' version
Ord, Typeable (TypeID' version)
Typeable (TypeID' version)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TypeID' version -> c (TypeID' version))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (TypeID' version))
-> (TypeID' version -> Constr)
-> (TypeID' version -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (TypeID' version)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (TypeID' version)))
-> ((forall b. Data b => b -> b)
    -> TypeID' version -> TypeID' version)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeID' version -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeID' version -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TypeID' version -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypeID' version -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TypeID' version -> m (TypeID' version))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypeID' version -> m (TypeID' version))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypeID' version -> m (TypeID' version))
-> Data (TypeID' version)
TypeID' version -> Constr
TypeID' version -> DataType
(forall b. Data b => b -> b) -> TypeID' version -> TypeID' version
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TypeID' version -> u
forall u. (forall d. Data d => d -> u) -> TypeID' version -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
forall {version :: UUIDVersion}.
Typeable version =>
Typeable (TypeID' version)
forall (version :: UUIDVersion).
Typeable version =>
TypeID' version -> Constr
forall (version :: UUIDVersion).
Typeable version =>
TypeID' version -> DataType
forall (version :: UUIDVersion).
Typeable version =>
(forall b. Data b => b -> b) -> TypeID' version -> TypeID' version
forall (version :: UUIDVersion) u.
Typeable version =>
Int -> (forall d. Data d => d -> u) -> TypeID' version -> u
forall (version :: UUIDVersion) u.
Typeable version =>
(forall d. Data d => d -> u) -> TypeID' version -> [u]
forall (version :: UUIDVersion) r r'.
Typeable version =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
forall (version :: UUIDVersion) r r'.
Typeable version =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
forall (version :: UUIDVersion) (m :: * -> *).
(Typeable version, Monad m) =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
forall (version :: UUIDVersion) (m :: * -> *).
(Typeable version, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
forall (version :: UUIDVersion) (c :: * -> *).
Typeable version =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeID' version)
forall (version :: UUIDVersion) (c :: * -> *).
Typeable version =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeID' version -> c (TypeID' version)
forall (version :: UUIDVersion) (t :: * -> *) (c :: * -> *).
(Typeable version, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeID' version))
forall (version :: UUIDVersion) (t :: * -> * -> *) (c :: * -> *).
(Typeable version, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeID' version))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeID' version)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeID' version -> c (TypeID' version)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeID' version))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeID' version))
$cgfoldl :: forall (version :: UUIDVersion) (c :: * -> *).
Typeable version =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeID' version -> c (TypeID' version)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeID' version -> c (TypeID' version)
$cgunfold :: forall (version :: UUIDVersion) (c :: * -> *).
Typeable version =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeID' version)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeID' version)
$ctoConstr :: forall (version :: UUIDVersion).
Typeable version =>
TypeID' version -> Constr
toConstr :: TypeID' version -> Constr
$cdataTypeOf :: forall (version :: UUIDVersion).
Typeable version =>
TypeID' version -> DataType
dataTypeOf :: TypeID' version -> DataType
$cdataCast1 :: forall (version :: UUIDVersion) (t :: * -> *) (c :: * -> *).
(Typeable version, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeID' version))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeID' version))
$cdataCast2 :: forall (version :: UUIDVersion) (t :: * -> * -> *) (c :: * -> *).
(Typeable version, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeID' version))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeID' version))
$cgmapT :: forall (version :: UUIDVersion).
Typeable version =>
(forall b. Data b => b -> b) -> TypeID' version -> TypeID' version
gmapT :: (forall b. Data b => b -> b) -> TypeID' version -> TypeID' version
$cgmapQl :: forall (version :: UUIDVersion) r r'.
Typeable version =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
$cgmapQr :: forall (version :: UUIDVersion) r r'.
Typeable version =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeID' version -> r
$cgmapQ :: forall (version :: UUIDVersion) u.
Typeable version =>
(forall d. Data d => d -> u) -> TypeID' version -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeID' version -> [u]
$cgmapQi :: forall (version :: UUIDVersion) u.
Typeable version =>
Int -> (forall d. Data d => d -> u) -> TypeID' version -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TypeID' version -> u
$cgmapM :: forall (version :: UUIDVersion) (m :: * -> *).
(Typeable version, Monad m) =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
$cgmapMp :: forall (version :: UUIDVersion) (m :: * -> *).
(Typeable version, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
$cgmapMo :: forall (version :: UUIDVersion) (m :: * -> *).
(Typeable version, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeID' version -> m (TypeID' version)
Data, Typeable)

instance Show (TypeID' version) where
  show :: TypeID' version -> String
  show :: TypeID' version -> String
show = TypeID' version -> String
forall (version :: UUIDVersion). TypeID' version -> String
toString
  {-# INLINE show #-}

instance Read (TypeID' version) where
  readsPrec :: Int -> String -> [(TypeID' version, String)]
  readsPrec :: Int -> ReadS (TypeID' version)
readsPrec Int
_ String
str = case String -> Either TypeIDError (TypeID' version, String)
forall (version :: UUIDVersion).
String -> Either TypeIDError (TypeID' version, String)
parseStringS String
str of
    Left TypeIDError
_       -> []
    Right (TypeID' version
x, String
y) -> [(TypeID' version
x, String
y)]
  {-# INLINE readsPrec #-}

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

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

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

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

-- | Since the specification does not formulate a concrete binary format, this
-- instance is based on the following custom format:
--
-- * The first 16 bytes are the suffix 'UUID' encoded in base32.
-- * The next byte is the length of the prefix encoded in a byte.
-- * The next bytes are the prefix, each letter taking 5 bits, mapping \'a\' to
--   1 and \'z\' to 26. The underscore \'_\' is mapped to 27.
--
-- Note that the prefix and the 'UUID' is swapped compared to the string
-- representation, this is for the convenience of the use case where only the
-- suffix 'UUID' is required. Because of this, the sorting order may be
-- different from the string representation, but they are guaranteed to be the
-- same if the same prefix is used.
instance Binary (TypeID' version) where
  put :: TypeID' version -> Put
  put :: TypeID' version -> Put
put (TypeID' Text
prefix UUID
uuid) = do
    UUID -> Put
forall t. Binary t => t -> Put
put UUID
uuid
    let fore :: a -> a
fore a
95 = a
27
        fore a
a  = a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
96
    let encodedPrefix :: [Word8]
encodedPrefix = [Word8] -> [Word8]
concat5BitInts ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word8
forall {a}. (Eq a, Num a) => a -> a
fore ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
                      (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
prefix
    Word8 -> Put
putWord8 (Word8 -> Put) -> (Int -> Word8) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
encodedPrefix
    [Word8] -> (Word8 -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word8]
encodedPrefix Word8 -> Put
putWord8
  {-# INLINE put #-}

  get :: Get (TypeID' version)
  get :: Get (TypeID' version)
get = do
    UUID
uuid          <- Get UUID
forall t. Binary t => Get t
get
    Word8
len           <- Get Word8
getWord8
    [Word8]
encodedPrefix <- [Word8] -> [Word8]
separate5BitInts ([Word8] -> [Word8]) -> Get [Word8] -> Get [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len) Get Word8
getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
encodedPrefix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63) do String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary: Prefix too long"
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
1) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
26)) [Word8]
encodedPrefix) do
      String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary: Invalid prefix"
    let back :: a -> a
back a
27 = a
95
        back a
a  = a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
96
    TypeID' version -> Get (TypeID' version)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeID' version -> Get (TypeID' version))
-> TypeID' version -> Get (TypeID' version)
forall a b. (a -> b) -> a -> b
$ Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Text) -> [Word8] -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word8
forall {a}. (Eq a, Num a) => a -> a
back [Word8]
encodedPrefix) UUID
uuid
  {-# INLINE get #-}

-- | Similar to the 'Binary' instance, but the 'UUID' is stored in host endian.
instance Storable (TypeID' version) where
  sizeOf :: TypeID' version -> Int
  sizeOf :: TypeID' version -> Int
sizeOf TypeID' version
_ = Int
60
  {-# INLINE sizeOf #-}

  alignment :: TypeID' version -> Int
  alignment :: TypeID' version -> Int
alignment TypeID' version
_ = Int
4
  {-# INLINE alignment #-}

  peek :: Ptr (TypeID' version) -> IO (TypeID' version)
  peek :: Ptr (TypeID' version) -> IO (TypeID' version)
peek Ptr (TypeID' version)
ptr = do
    UUID
uuid          <- Ptr UUID -> IO UUID
forall a. Storable a => Ptr a -> IO a
peek (Ptr (TypeID' version) -> Ptr UUID
forall a b. Ptr a -> Ptr b
castPtr Ptr (TypeID' version)
ptr :: Ptr UUID)
    Int
len           <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr (TypeID' version) -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (TypeID' version)
ptr Int
16 :: IO Word8)
    [Word8]
encodedPrefix <- [Word8] -> [Word8]
separate5BitInts
                 ([Word8] -> [Word8]) -> IO [Word8] -> IO [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> (Int -> IO Word8) -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..Int
len] \Int
ix -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr (TypeID' version)
ptr (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
encodedPrefix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Storable: Prefix too long"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Bool -> Bool -> Bool)
-> (Word8 -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
1) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
26)) [Word8]
encodedPrefix) do
      String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Storable: Invalid prefix"
    let back :: a -> a
back a
27 = a
95
        back a
a  = a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
96
    TypeID' version -> IO (TypeID' version)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeID' version -> IO (TypeID' version))
-> TypeID' version -> IO (TypeID' version)
forall a b. (a -> b) -> a -> b
$ Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Text) -> [Word8] -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word8
forall {a}. (Eq a, Num a) => a -> a
back [Word8]
encodedPrefix) UUID
uuid
  {-# INLINE peek #-}

  poke :: Ptr (TypeID' version) -> TypeID' version -> IO ()
  poke :: Ptr (TypeID' version) -> TypeID' version -> IO ()
poke Ptr (TypeID' version)
ptr (TypeID' Text
prefix UUID
uuid) = do
    Ptr UUID -> UUID -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (TypeID' version) -> Ptr UUID
forall a b. Ptr a -> Ptr b
castPtr Ptr (TypeID' version)
ptr) UUID
uuid
    let fore :: a -> a
fore a
95 = a
27
        fore a
a  = a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
96
    let encodedPrefix :: [Word8]
encodedPrefix = [Word8] -> [Word8]
concat5BitInts ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word8
forall {a}. (Eq a, Num a) => a -> a
fore ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
                      (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
prefix
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff @Word8 Ptr (TypeID' version)
ptr Int
16 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
encodedPrefix)
    (Int -> Word8 -> IO ()) -> [Int] -> [Word8] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Ptr (TypeID' version) -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (TypeID' version)
ptr (Int -> Word8 -> IO ()) -> (Int -> Int) -> Int -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16)) [Int
1..] [Word8]
encodedPrefix
  {-# INLINE poke #-}

instance Hashable (TypeID' version) where
  hashWithSalt :: Int -> TypeID' version -> Int
  hashWithSalt :: Int -> TypeID' version -> Int
hashWithSalt Int
salt (TypeID' Text
prefix UUID
uuid)
    = Int
salt Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
prefix Int -> UUID -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` UUID
uuid
  {-# INLINE hashWithSalt #-}

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

  getUUID :: TypeID' version -> UUID
  getUUID :: TypeID' version -> UUID
getUUID (TypeID' Text
_ UUID
uuid) = UUID
uuid
  {-# INLINE getUUID #-}

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

-- | Conversion between 'TypeID'' and 'String'/'Text'/'ByteString'.
instance IDConv (TypeID' version) where
  string2ID :: String -> Either TypeIDError (TypeID' version)
  string2ID :: String -> Either TypeIDError (TypeID' version)
string2ID = String -> Either TypeIDError (TypeID' version)
forall (version :: UUIDVersion).
String -> Either TypeIDError (TypeID' version)
parseString
  {-# INLINE string2ID #-}

  text2ID :: Text -> Either TypeIDError (TypeID' version)
  text2ID :: Text -> Either TypeIDError (TypeID' version)
text2ID = Text -> Either TypeIDError (TypeID' version)
forall (version :: UUIDVersion).
Text -> Either TypeIDError (TypeID' version)
parseText
  {-# INLINE text2ID #-}

  byteString2ID :: ByteString -> Either TypeIDError (TypeID' version)
  byteString2ID :: ByteString -> Either TypeIDError (TypeID' version)
byteString2ID = ByteString -> Either TypeIDError (TypeID' version)
forall (version :: UUIDVersion).
ByteString -> Either TypeIDError (TypeID' version)
parseByteString
  {-# INLINE byteString2ID #-}

  id2String :: TypeID' version -> String
  id2String :: TypeID' version -> String
id2String = TypeID' version -> String
forall (version :: UUIDVersion). TypeID' version -> String
toString
  {-# INLINE id2String #-}

  id2Text :: TypeID' version -> Text
  id2Text :: TypeID' version -> Text
id2Text = TypeID' version -> Text
forall (version :: UUIDVersion). TypeID' version -> Text
toText
  {-# INLINE id2Text #-}

  id2ByteString :: TypeID' version -> ByteString
  id2ByteString :: TypeID' version -> ByteString
id2ByteString = TypeID' version -> ByteString
forall (version :: UUIDVersion). TypeID' version -> ByteString
toByteString
  {-# INLINE id2ByteString #-}

  unsafeString2ID :: String -> TypeID' version
  unsafeString2ID :: String -> TypeID' version
unsafeString2ID = String -> TypeID' version
forall (version :: UUIDVersion). String -> TypeID' version
unsafeParseString
  {-# INLINE unsafeString2ID #-}

  unsafeText2ID :: Text -> TypeID' version
  unsafeText2ID :: Text -> TypeID' version
unsafeText2ID = Text -> TypeID' version
forall (version :: UUIDVersion). Text -> TypeID' version
unsafeParseText
  {-# INLINE unsafeText2ID #-}

  unsafeByteString2ID :: ByteString -> TypeID' version
  unsafeByteString2ID :: ByteString -> TypeID' version
unsafeByteString2ID = ByteString -> TypeID' version
forall (version :: UUIDVersion). ByteString -> TypeID' version
unsafeParseByteString
  {-# INLINE unsafeByteString2ID #-}

-- | Generate 'Data.TypeIDs.V7.TypeIDs'.
instance IDGen (TypeID' 'V7) where
  type IDGenPrefix (TypeID' 'V7) = 'Just Text

  type IDGenReq (TypeID' 'V7) a = a

  genID_ :: MonadIO m => Proxy (TypeID' 'V7) -> Text -> m (TypeID' 'V7)
  genID_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V7) -> Text -> m (TypeID' 'V7)
genID_ Proxy (TypeID' 'V7)
_ = Text -> m (TypeID' 'V7)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
genTypeID
  {-# INLINE genID_ #-}

  genID'_ :: MonadIO m => Proxy (TypeID' 'V7) -> Text -> m (TypeID' 'V7)
  genID'_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V7) -> Text -> m (TypeID' 'V7)
genID'_ Proxy (TypeID' 'V7)
_ = Text -> m (TypeID' 'V7)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
genTypeID'
  {-# INLINE genID'_ #-}

  genIDs_ :: MonadIO m
          => Proxy (TypeID' 'V7)
          -> Text
          -> Word16
          -> m [TypeID' 'V7]
  genIDs_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V7) -> Text -> Word16 -> m [TypeID' 'V7]
genIDs_ Proxy (TypeID' 'V7)
_ = Text -> Word16 -> m [TypeID' 'V7]
forall (m :: * -> *).
MonadIO m =>
Text -> Word16 -> m [TypeID' 'V7]
genTypeIDs
  {-# INLINE genIDs_ #-}

  decorate_ :: Proxy (TypeID' 'V7)
            -> Text
            -> UUID
            -> Either TypeIDError (TypeID' 'V7)
  decorate_ :: Proxy (TypeID' 'V7)
-> Text -> UUID -> Either TypeIDError (TypeID' 'V7)
decorate_ Proxy (TypeID' 'V7)
_ = Text -> UUID -> Either TypeIDError (TypeID' 'V7)
forall (version :: UUIDVersion).
Text -> UUID -> Either TypeIDError (TypeID' version)
decorateTypeID
  {-# INLINE decorate_ #-}

  checkID_ :: Proxy (TypeID' 'V7) -> TypeID' 'V7 -> Maybe TypeIDError
  checkID_ :: Proxy (TypeID' 'V7) -> TypeID' 'V7 -> Maybe TypeIDError
checkID_ Proxy (TypeID' 'V7)
_ = TypeID' 'V7 -> Maybe TypeIDError
checkTypeID
  {-# INLINE checkID_ #-}

  checkIDWithEnv_ :: MonadIO m
                  => Proxy (TypeID' 'V7)
                  -> TypeID' 'V7
                  -> m (Maybe TypeIDError)
  checkIDWithEnv_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V7) -> TypeID' 'V7 -> m (Maybe TypeIDError)
checkIDWithEnv_ Proxy (TypeID' 'V7)
_ = TypeID' 'V7 -> m (Maybe TypeIDError)
forall (m :: * -> *).
MonadIO m =>
TypeID' 'V7 -> m (Maybe TypeIDError)
checkTypeIDWithEnv
  {-# INLINE checkIDWithEnv_ #-}

-- | Generate 'TypeID'' ''V1's.
instance IDGen (TypeID' 'V1) where
  type IDGenPrefix (TypeID' 'V1) = 'Just Text

  type IDGenReq (TypeID' 'V1) a = a

  genID_ :: MonadIO m => Proxy (TypeID' 'V1) -> Text -> m (TypeID' 'V1)
  genID_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V1) -> Text -> m (TypeID' 'V1)
genID_ Proxy (TypeID' 'V1)
_ = Text -> m (TypeID' 'V1)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V1)
genTypeIDV1
  {-# INLINE genID_ #-}

  genIDs_ :: MonadIO m
          => Proxy (TypeID' 'V1)
          -> Text
          -> Word16
          -> m [TypeID' 'V1]
  genIDs_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V1) -> Text -> Word16 -> m [TypeID' 'V1]
genIDs_ Proxy (TypeID' 'V1)
_ Text
prefix Word16
n = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
    Maybe TypeIDError
Nothing  -> (UUID -> TypeID' 'V1) -> [UUID] -> [TypeID' 'V1]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> UUID -> TypeID' 'V1
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix)
            ([UUID] -> [TypeID' 'V1]) -> m [UUID] -> m [TypeID' 'V1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m UUID -> m [UUID]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n) (IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextUUID)
    Just TypeIDError
err -> IO [TypeID' 'V1] -> m [TypeID' 'V1]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TypeID' 'V1] -> m [TypeID' 'V1])
-> IO [TypeID' 'V1] -> m [TypeID' 'V1]
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO [TypeID' 'V1]
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
  {-# INLINE genIDs_ #-}

  decorate_ :: Proxy (TypeID' 'V1)
            -> Text
            -> UUID
            -> Either TypeIDError (TypeID' 'V1)
  decorate_ :: Proxy (TypeID' 'V1)
-> Text -> UUID -> Either TypeIDError (TypeID' 'V1)
decorate_ Proxy (TypeID' 'V1)
_ = Text -> UUID -> Either TypeIDError (TypeID' 'V1)
forall (version :: UUIDVersion).
Text -> UUID -> Either TypeIDError (TypeID' version)
decorateTypeID
  {-# INLINE decorate_ #-}

  checkID_ :: Proxy (TypeID' 'V1) -> TypeID' 'V1 -> Maybe TypeIDError
  checkID_ :: Proxy (TypeID' 'V1) -> TypeID' 'V1 -> Maybe TypeIDError
checkID_ Proxy (TypeID' 'V1)
_ = TypeID' 'V1 -> Maybe TypeIDError
checkTypeIDV1
  {-# INLINE checkID_ #-}

-- | Generate 'TypeID'' ''V4's.
instance IDGen (TypeID' 'V4) where
  type IDGenPrefix (TypeID' 'V4) = 'Just Text

  type IDGenReq (TypeID' 'V4) a = a

  genID_ :: MonadIO m => Proxy (TypeID' 'V4) -> Text -> m (TypeID' 'V4)
  genID_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V4) -> Text -> m (TypeID' 'V4)
genID_ Proxy (TypeID' 'V4)
_ = Text -> m (TypeID' 'V4)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
genTypeIDV4
  {-# INLINE genID_ #-}

  genID'_ :: MonadIO m => Proxy (TypeID' 'V4) -> Text -> m (TypeID' 'V4)
  genID'_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V4) -> Text -> m (TypeID' 'V4)
genID'_ Proxy (TypeID' 'V4)
_ = Text -> m (TypeID' 'V4)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
genTypeIDV4'
  {-# INLINE genID'_ #-}

  genIDs_ :: MonadIO m
          => Proxy (TypeID' 'V4)
          -> Text
          -> Word16
          -> m [TypeID' 'V4]
  genIDs_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V4) -> Text -> Word16 -> m [TypeID' 'V4]
genIDs_ Proxy (TypeID' 'V4)
_ Text
prefix Word16
n = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
    Maybe TypeIDError
Nothing  -> (UUID -> TypeID' 'V4) -> [UUID] -> [TypeID' 'V4]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> UUID -> TypeID' 'V4
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix)
            ([UUID] -> [TypeID' 'V4]) -> m [UUID] -> m [TypeID' 'V4]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m UUID -> m [UUID]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n) (IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
V4.nextRandom)
    Just TypeIDError
err -> IO [TypeID' 'V4] -> m [TypeID' 'V4]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TypeID' 'V4] -> m [TypeID' 'V4])
-> IO [TypeID' 'V4] -> m [TypeID' 'V4]
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO [TypeID' 'V4]
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
  {-# INLINE genIDs_ #-}

  decorate_ :: Proxy (TypeID' 'V4)
            -> Text
            -> UUID
            -> Either TypeIDError (TypeID' 'V4)
  decorate_ :: Proxy (TypeID' 'V4)
-> Text -> UUID -> Either TypeIDError (TypeID' 'V4)
decorate_ Proxy (TypeID' 'V4)
_ = Text -> UUID -> Either TypeIDError (TypeID' 'V4)
forall (version :: UUIDVersion).
Text -> UUID -> Either TypeIDError (TypeID' version)
decorateTypeID
  {-# INLINE decorate_ #-}

  checkID_ :: Proxy (TypeID' 'V4) -> TypeID' 'V4 -> Maybe TypeIDError
  checkID_ :: Proxy (TypeID' 'V4) -> TypeID' 'V4 -> Maybe TypeIDError
checkID_ Proxy (TypeID' 'V4)
_ = TypeID' 'V4 -> Maybe TypeIDError
checkTypeIDV4
  {-# INLINE checkID_ #-}

-- | Generate 'TypeID'' ''V5's.
instance IDGen (TypeID' 'V5) where
  type IDGenPrefix (TypeID' 'V5) = 'Just Text

  type IDGenReq (TypeID' 'V5) r = UUID -> [Word8] -> r

  genID_ :: MonadIO m
         => Proxy (TypeID' 'V5) -> Text -> UUID -> [Word8] -> m (TypeID' 'V5)
  genID_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V5) -> Text -> UUID -> [Word8] -> m (TypeID' 'V5)
genID_ Proxy (TypeID' 'V5)
_ = Text -> UUID -> [Word8] -> m (TypeID' 'V5)
forall (m :: * -> *).
MonadIO m =>
Text -> UUID -> [Word8] -> m (TypeID' 'V5)
genTypeIDV5
  {-# INLINE genID_ #-}

  genIDs_ :: MonadIO m
          => Proxy (TypeID' 'V5)
          -> Text
          -> UUID
          -> [Word8]
          -> Word16
          -> m [TypeID' 'V5]
  -- Apparently this function is useless...
  genIDs_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (TypeID' 'V5)
-> Text -> UUID -> [Word8] -> Word16 -> m [TypeID' 'V5]
genIDs_ Proxy (TypeID' 'V5)
_ Text
prefix UUID
ns [Word8]
obj Word16
n = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
    Maybe TypeIDError
Nothing  -> Int -> m (TypeID' 'V5) -> m [TypeID' 'V5]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n)
              (m (TypeID' 'V5) -> m [TypeID' 'V5])
-> m (TypeID' 'V5) -> m [TypeID' 'V5]
forall a b. (a -> b) -> a -> b
$ TypeID' 'V5 -> m (TypeID' 'V5)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> UUID -> TypeID' 'V5
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> TypeID' 'V5) -> UUID -> TypeID' 'V5
forall a b. (a -> b) -> a -> b
$ UUID -> [Word8] -> UUID
V5.generateNamed UUID
ns [Word8]
obj)
    Just TypeIDError
err -> IO [TypeID' 'V5] -> m [TypeID' 'V5]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TypeID' 'V5] -> m [TypeID' 'V5])
-> IO [TypeID' 'V5] -> m [TypeID' 'V5]
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO [TypeID' 'V5]
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
  {-# INLINE genIDs_ #-}

  decorate_ :: Proxy (TypeID' 'V5)
            -> Text
            -> UUID
            -> Either TypeIDError (TypeID' 'V5)
  decorate_ :: Proxy (TypeID' 'V5)
-> Text -> UUID -> Either TypeIDError (TypeID' 'V5)
decorate_ Proxy (TypeID' 'V5)
_ = Text -> UUID -> Either TypeIDError (TypeID' 'V5)
forall (version :: UUIDVersion).
Text -> UUID -> Either TypeIDError (TypeID' version)
decorateTypeID
  {-# INLINE decorate_ #-}

  checkID_ :: Proxy (TypeID' 'V5) -> TypeID' 'V5 -> Maybe TypeIDError
  checkID_ :: Proxy (TypeID' 'V5) -> TypeID' 'V5 -> Maybe TypeIDError
checkID_ Proxy (TypeID' 'V5)
_ = TypeID' 'V5 -> Maybe TypeIDError
checkTypeIDV5
  {-# INLINE checkID_ #-}

-- | Generate a new 'Data.TypeID.V7.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 :: MonadIO m => Text -> m (TypeID' 'V7)
genTypeID :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
genTypeID = ([TypeID' 'V7] -> TypeID' 'V7)
-> m [TypeID' 'V7] -> m (TypeID' 'V7)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TypeID' 'V7] -> TypeID' 'V7
forall a. HasCallStack => [a] -> a
head (m [TypeID' 'V7] -> m (TypeID' 'V7))
-> (Text -> m [TypeID' 'V7]) -> Text -> m (TypeID' 'V7)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Word16 -> m [TypeID' 'V7]
forall (m :: * -> *).
MonadIO m =>
Text -> Word16 -> m [TypeID' 'V7]
`genTypeIDs` Word16
1)
{-# INLINE genTypeID #-}

-- | Generate a new 'Data.TypeID.V7.TypeID' from a prefix based on stateless
-- 'UUID'v7.
--
-- See the documentation of 'V7.genUUID'' for more information.
genTypeID' :: MonadIO m => Text -> m (TypeID' 'V7)
genTypeID' :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
genTypeID' Text
prefix = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> Text -> m (TypeID' 'V7)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
unsafeGenTypeID' Text
prefix
  Just TypeIDError
err -> IO (TypeID' 'V7) -> m (TypeID' 'V7)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TypeID' 'V7) -> m (TypeID' 'V7))
-> IO (TypeID' 'V7) -> m (TypeID' 'V7)
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO (TypeID' 'V7)
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
{-# INLINE genTypeID' #-}

-- | Generate a list of 'Data.TypeID.V7.TypeID's from a prefix.
--
-- It tries its best to generate 'Data.TypeID.V7.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 'Data.TypeID.V7.TypeID's are generated
-- at the same timestamp.
genTypeIDs :: MonadIO m => Text -> Word16 -> m [TypeID' 'V7]
genTypeIDs :: forall (m :: * -> *).
MonadIO m =>
Text -> Word16 -> m [TypeID' 'V7]
genTypeIDs Text
prefix Word16
n = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> Text -> Word16 -> m [TypeID' 'V7]
forall (m :: * -> *).
MonadIO m =>
Text -> Word16 -> m [TypeID' 'V7]
unsafeGenTypeIDs Text
prefix Word16
n
  Just TypeIDError
err -> IO [TypeID' 'V7] -> m [TypeID' 'V7]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TypeID' 'V7] -> m [TypeID' 'V7])
-> IO [TypeID' 'V7] -> m [TypeID' 'V7]
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO [TypeID' 'V7]
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
{-# INLINE genTypeIDs #-}

-- | Generate a new 'TypeID'' ''V1' 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.
genTypeIDV1 :: MonadIO m => Text -> m (TypeID' 'V1)
genTypeIDV1 :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V1)
genTypeIDV1 Text
prefix = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> Text -> m (TypeID' 'V1)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V1)
unsafeGenTypeIDV1 Text
prefix
  Just TypeIDError
err -> IO (TypeID' 'V1) -> m (TypeID' 'V1)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TypeID' 'V1) -> m (TypeID' 'V1))
-> IO (TypeID' 'V1) -> m (TypeID' 'V1)
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO (TypeID' 'V1)
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
{-# INLINE genTypeIDV1 #-}

-- | Generate a new 'TypeID'' ''V4' 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.
genTypeIDV4 :: MonadIO m => Text -> m (TypeID' 'V4)
genTypeIDV4 :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
genTypeIDV4 Text
prefix = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> Text -> m (TypeID' 'V4)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
unsafeGenTypeIDV4 Text
prefix
  Just TypeIDError
err -> IO (TypeID' 'V4) -> m (TypeID' 'V4)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TypeID' 'V4) -> m (TypeID' 'V4))
-> IO (TypeID' 'V4) -> m (TypeID' 'V4)
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO (TypeID' 'V4)
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
{-# INLINE genTypeIDV4 #-}

-- | Generate a new 'TypeID'' ''V4' from a prefix based on insecure 'UUID'v4.
genTypeIDV4' :: MonadIO m => Text -> m (TypeID' 'V4)
genTypeIDV4' :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
genTypeIDV4' Text
prefix = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> Text -> m (TypeID' 'V4)
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
unsafeGenTypeIDV4' Text
prefix
  Just TypeIDError
err -> IO (TypeID' 'V4) -> m (TypeID' 'V4)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TypeID' 'V4) -> m (TypeID' 'V4))
-> IO (TypeID' 'V4) -> m (TypeID' 'V4)
forall a b. (a -> b) -> a -> b
$ TypeIDError -> IO (TypeID' 'V4)
forall e a. Exception e => e -> IO a
throwIO TypeIDError
err
{-# INLINE genTypeIDV4' #-}

-- | Generate a new 'TypeID'' ''V5' from a prefix, namespace, and object.
--
-- 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.
genTypeIDV5 :: MonadIO m => Text -> UUID -> [Word8] -> m (TypeID' 'V5)
genTypeIDV5 :: forall (m :: * -> *).
MonadIO m =>
Text -> UUID -> [Word8] -> m (TypeID' 'V5)
genTypeIDV5 Text
prefix UUID
ns [Word8]
obj = case Text -> Maybe TypeIDError
checkPrefix Text
prefix of
  Maybe TypeIDError
Nothing  -> TypeID' 'V5 -> m (TypeID' 'V5)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeID' 'V5 -> m (TypeID' 'V5)) -> TypeID' 'V5 -> m (TypeID' 'V5)
forall a b. (a -> b) -> a -> b
$ Text -> UUID -> [Word8] -> TypeID' 'V5
unsafeGenTypeIDV5 Text
prefix UUID
ns [Word8]
obj
  Just TypeIDError
err -> TypeIDError -> m (TypeID' 'V5)
forall a e. Exception e => e -> a
throw TypeIDError
err
{-# INLINE genTypeIDV5 #-}

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

-- | Pretty-print a 'TypeID''. It is 'id2String' with concrete type.
toString :: TypeID' version -> String
toString :: forall (version :: UUIDVersion). TypeID' version -> String
toString (TypeID' Text
prefix (UUID Word64
w1 Word64
w2)) = if Text -> Bool
T.null Text
prefix
  then ByteString -> String
suffixEncode ByteString
bs
  else Text -> String
T.unpack Text
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
suffixEncode ByteString
bs
  where
    bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word64 -> Put) -> [Word64] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word64 -> Put
putWord64be [Word64
w1, Word64
w2]
{-# INLINE toString #-}

-- | Pretty-print a 'TypeID'' to strict 'Text'. It is 'id2Text' with concrete
-- type.
toText :: TypeID' version -> Text
toText :: forall (version :: UUIDVersion). TypeID' version -> Text
toText (TypeID' Text
prefix (UUID Word64
w1 Word64
w2)) = if Text -> Bool
T.null Text
prefix
  then String -> Text
T.pack (ByteString -> String
suffixEncode ByteString
bs)
  else Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
suffixEncode ByteString
bs)
  where
    bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word64 -> Put) -> [Word64] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word64 -> Put
putWord64be [Word64
w1, Word64
w2]
{-# INLINE toText #-}

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

-- | Parse a 'TypeID'' from its 'String' representation. It is 'string2ID' with
-- concrete type.
parseString :: String -> Either TypeIDError (TypeID' version)
parseString :: forall (version :: UUIDVersion).
String -> Either TypeIDError (TypeID' version)
parseString String
str = case String -> Either TypeIDError (TypeID' version, String)
forall (version :: UUIDVersion).
String -> Either TypeIDError (TypeID' version, String)
parseStringS String
str of
  Left TypeIDError
err        -> TypeIDError -> Either TypeIDError (TypeID' version)
forall a b. a -> Either a b
Left TypeIDError
err
  Right (TypeID' version
tid, String
"") -> TypeID' version -> Either TypeIDError (TypeID' version)
forall a b. b -> Either a b
Right TypeID' version
tid
  Either TypeIDError (TypeID' version, String)
_               -> TypeIDError -> Either TypeIDError (TypeID' version)
forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
{-# INLINE parseString #-}

parseStringS :: String -> Either TypeIDError (TypeID' version, String)
parseStringS :: forall (version :: UUIDVersion).
String -> Either TypeIDError (TypeID' version, String)
parseStringS String
str = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
spanEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') String
str of
  (String
_, String
"")          -> do
    let (String
uuid, String
nks) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
26 String
str
        bs :: ByteString
bs          = String -> ByteString
forall a. IsString a => String -> a
fromString String
uuid
    (, String
nks) (TypeID' version -> (TypeID' version, String))
-> (UUID -> TypeID' version) -> UUID -> (TypeID' version, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
"" (UUID -> (TypeID' version, String))
-> Either TypeIDError UUID
-> Either TypeIDError (TypeID' version, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
  (String
_, String
"_")         -> TypeIDError -> Either TypeIDError (TypeID' version, String)
forall a b. a -> Either a b
Left TypeIDError
TypeIDExtraSeparator
  (String
suffix, String
prefix) -> do
    let prefix' :: Text
prefix'     = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. HasCallStack => [a] -> [a]
init String
prefix
        (String
uuid, String
nks) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
26 String
suffix
        bs :: ByteString
bs          = String -> ByteString
forall a. IsString a => String -> a
fromString String
uuid
    case Text -> Maybe TypeIDError
checkPrefix Text
prefix' of
      Maybe TypeIDError
Nothing  -> (, String
nks) (TypeID' version -> (TypeID' version, String))
-> (UUID -> TypeID' version) -> UUID -> (TypeID' version, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix' (UUID -> (TypeID' version, String))
-> Either TypeIDError UUID
-> Either TypeIDError (TypeID' version, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either TypeIDError UUID
decodeUUID ByteString
bs
      Just TypeIDError
err -> TypeIDError -> Either TypeIDError (TypeID' version, String)
forall a b. a -> Either a b
Left TypeIDError
err

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

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

-- | Parse a 'TypeID'' from its 'String' representation, throwing an error when
-- the parsing fails. It is 'string2IDM' with concrete type.
parseStringM :: MonadIO m => String -> m (TypeID' version)
parseStringM :: forall (m :: * -> *) (version :: UUIDVersion).
MonadIO m =>
String -> m (TypeID' version)
parseStringM = String -> m (TypeID' version)
forall a (m :: * -> *). (IDConv a, MonadIO m) => String -> m a
forall (m :: * -> *). MonadIO m => String -> m (TypeID' version)
string2IDM
{-# INLINE parseStringM #-}

-- | Parse a 'TypeID'' from its string representation as a strict 'Text',
-- throwing an error when the parsing fails. It is 'text2IDM' with concrete
-- type.
parseTextM :: MonadIO m => Text -> m (TypeID' version)
parseTextM :: forall (m :: * -> *) (version :: UUIDVersion).
MonadIO m =>
Text -> m (TypeID' version)
parseTextM = Text -> m (TypeID' version)
forall a (m :: * -> *). (IDConv a, MonadIO m) => Text -> m a
forall (m :: * -> *). MonadIO m => Text -> m (TypeID' version)
text2IDM
{-# INLINE parseTextM #-}

-- | Parse a 'TypeID'' from its string representation as a lazy 'ByteString',
-- throwing an error when the parsing fails. It is 'byteString2IDM' with
-- concrete type.
parseByteStringM :: MonadIO m => ByteString -> m (TypeID' version)
parseByteStringM :: forall (m :: * -> *) (version :: UUIDVersion).
MonadIO m =>
ByteString -> m (TypeID' version)
parseByteStringM = ByteString -> m (TypeID' version)
forall a (m :: * -> *). (IDConv a, MonadIO m) => ByteString -> m a
forall (m :: * -> *).
MonadIO m =>
ByteString -> m (TypeID' version)
byteString2IDM
{-# INLINE parseByteStringM #-}

-- | 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63 = TypeIDError -> Maybe TypeIDError
forall a. a -> Maybe a
Just (TypeIDError -> Maybe TypeIDError)
-> TypeIDError -> Maybe TypeIDError
forall a b. (a -> b) -> a -> b
$ Int -> TypeIDError
TypeIDErrorPrefixTooLong (Text -> Int
T.length Text
prefix)
  | Text -> Bool
T.null Text
prefix        = Maybe TypeIDError
forall a. Maybe a
Nothing
  | HasCallStack => Text -> Char
Text -> Char
T.head Text
prefix Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = TypeIDError -> Maybe TypeIDError
forall a. a -> Maybe a
Just TypeIDError
TypeIDStartWithUnderscore
  | HasCallStack => Text -> Char
Text -> Char
T.last Text
prefix Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = TypeIDError -> Maybe TypeIDError
forall a. a -> Maybe a
Just TypeIDError
TypeIDEndWithUnderscore
  | Bool
otherwise
      = case Text -> Maybe (Char, Text)
T.uncons ( (Char -> Bool) -> Text -> Text
T.dropWhile ( (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||) (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
                                    ((Char -> Bool) -> Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
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     -> Maybe TypeIDError
forall a. Maybe a
Nothing
        Just (Char
c, Text
_) -> TypeIDError -> Maybe TypeIDError
forall a. a -> Maybe a
Just (TypeIDError -> Maybe TypeIDError)
-> TypeIDError -> Maybe TypeIDError
forall a b. (a -> b) -> a -> b
$ Char -> TypeIDError
TypeIDErrorPrefixInvalidChar Char
c
{-# INLINE checkPrefix #-}

-- | Check if the prefix is valid and the suffix 'UUID' has the correct v7
-- version and variant.
checkTypeID :: TypeID' 'V7 -> Maybe TypeIDError
checkTypeID :: TypeID' 'V7 -> Maybe TypeIDError
checkTypeID (TypeID' Text
prefix UUID
uuid)
  = [Maybe TypeIDError] -> Maybe TypeIDError
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Text -> Maybe TypeIDError
checkPrefix Text
prefix
         , TypeIDError
TypeIDErrorUUIDError TypeIDError -> Maybe () -> Maybe TypeIDError
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UUID -> Bool
V7.validate UUID
uuid) ]
{-# INLINE checkTypeID #-}

-- | Check if the prefix is valid and the suffix 'UUID' has the correct v1
-- version and variant.
checkTypeIDV1 :: TypeID' 'V1 -> Maybe TypeIDError
checkTypeIDV1 :: TypeID' 'V1 -> Maybe TypeIDError
checkTypeIDV1 (TypeID' Text
prefix UUID
uuid)
  = [Maybe TypeIDError] -> Maybe TypeIDError
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Text -> Maybe TypeIDError
checkPrefix Text
prefix
         , TypeIDError
TypeIDErrorUUIDError TypeIDError -> Maybe () -> Maybe TypeIDError
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UUID -> UUIDVersion -> Bool
validateWithVersion UUID
uuid UUIDVersion
V1) ]
{-# INLINE checkTypeIDV1 #-}

-- | Check if the prefix is valid and the suffix 'UUID' has the correct v4
-- version and variant.
checkTypeIDV4 :: TypeID' 'V4 -> Maybe TypeIDError
checkTypeIDV4 :: TypeID' 'V4 -> Maybe TypeIDError
checkTypeIDV4 (TypeID' Text
prefix UUID
uuid)
  = [Maybe TypeIDError] -> Maybe TypeIDError
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Text -> Maybe TypeIDError
checkPrefix Text
prefix
         , TypeIDError
TypeIDErrorUUIDError TypeIDError -> Maybe () -> Maybe TypeIDError
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UUID -> UUIDVersion -> Bool
validateWithVersion UUID
uuid UUIDVersion
V4) ]
{-# INLINE checkTypeIDV4 #-}

-- | Check if the prefix is valid and the suffix 'UUID' has the correct v4
-- version and variant.
checkTypeIDV5 :: TypeID' 'V5 -> Maybe TypeIDError
checkTypeIDV5 :: TypeID' 'V5 -> Maybe TypeIDError
checkTypeIDV5 (TypeID' Text
prefix UUID
uuid)
  = [Maybe TypeIDError] -> Maybe TypeIDError
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Text -> Maybe TypeIDError
checkPrefix Text
prefix
         , TypeIDError
TypeIDErrorUUIDError TypeIDError -> Maybe () -> Maybe TypeIDError
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UUID -> UUIDVersion -> Bool
validateWithVersion UUID
uuid UUIDVersion
V5) ]
{-# INLINE checkTypeIDV5 #-}

-- | Similar to 'checkTypeID', but also checks if the suffix 'UUID' is
-- generated in the past.
checkTypeIDWithEnv :: MonadIO m => TypeID' 'V7 -> m (Maybe TypeIDError)
checkTypeIDWithEnv :: forall (m :: * -> *).
MonadIO m =>
TypeID' 'V7 -> m (Maybe TypeIDError)
checkTypeIDWithEnv tid :: TypeID' 'V7
tid@(TypeID' Text
_ UUID
uuid)
  = (Maybe TypeIDError -> Maybe TypeIDError)
-> m (Maybe TypeIDError) -> m (Maybe TypeIDError)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeID' 'V7 -> Maybe TypeIDError
checkTypeID TypeID' 'V7
tid Maybe TypeIDError -> Maybe TypeIDError -> Maybe TypeIDError
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`)
         ((TypeIDError
TypeIDErrorUUIDError TypeIDError -> Maybe () -> Maybe TypeIDError
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Maybe () -> Maybe TypeIDError)
-> (Bool -> Maybe ()) -> Bool -> Maybe TypeIDError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Bool -> Bool) -> Bool -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Maybe TypeIDError) -> m Bool -> m (Maybe TypeIDError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UUID -> m Bool
forall (m :: * -> *). MonadIO m => UUID -> m Bool
V7.validateWithTime UUID
uuid)
{-# INLINE checkTypeIDWithEnv #-}

-- | Generate a new 'Data.TypeID.V7.TypeID' from a prefix, but without checking
-- if the prefix is valid.
unsafeGenTypeID :: MonadIO m => Text -> m (TypeID' 'V7)
unsafeGenTypeID :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
unsafeGenTypeID = ([TypeID' 'V7] -> TypeID' 'V7)
-> m [TypeID' 'V7] -> m (TypeID' 'V7)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TypeID' 'V7] -> TypeID' 'V7
forall a. HasCallStack => [a] -> a
head (m [TypeID' 'V7] -> m (TypeID' 'V7))
-> (Text -> m [TypeID' 'V7]) -> Text -> m (TypeID' 'V7)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Word16 -> m [TypeID' 'V7]
forall (m :: * -> *).
MonadIO m =>
Text -> Word16 -> m [TypeID' 'V7]
`unsafeGenTypeIDs` Word16
1)
{-# INLINE unsafeGenTypeID #-}

-- | Generate a new 'TypeID'' ''V1' from a prefix, but without checking if the
-- prefix is valid.
unsafeGenTypeIDV1 :: MonadIO m => Text -> m (TypeID' 'V1)
unsafeGenTypeIDV1 :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V1)
unsafeGenTypeIDV1 Text
prefix = Text -> UUID -> TypeID' 'V1
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> TypeID' 'V1) -> m UUID -> m (TypeID' 'V1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextUUID
{-# INLINE unsafeGenTypeIDV1 #-}

-- | Generate a new 'TypeID'' ''V4' from a prefix, but without checking if the
-- prefix is valid.
unsafeGenTypeIDV4 :: MonadIO m => Text -> m (TypeID' 'V4)
unsafeGenTypeIDV4 :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
unsafeGenTypeIDV4 Text
prefix = Text -> UUID -> TypeID' 'V4
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> TypeID' 'V4) -> m UUID -> m (TypeID' 'V4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
V4.nextRandom
{-# INLINE unsafeGenTypeIDV4 #-}

-- | Generate a new 'TypeID'' ''V5' from a prefix, namespace, and object, but
-- without checking if the prefix is valid.
unsafeGenTypeIDV5 :: Text -> UUID -> [Word8] -> TypeID' 'V5
unsafeGenTypeIDV5 :: Text -> UUID -> [Word8] -> TypeID' 'V5
unsafeGenTypeIDV5 Text
prefix UUID
ns [Word8]
obj = Text -> UUID -> TypeID' 'V5
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> [Word8] -> UUID
V5.generateNamed UUID
ns [Word8]
obj)
{-# INLINE unsafeGenTypeIDV5 #-}

-- | Generate a new 'Data.TypeID.V7.TypeID' from a prefix based on stateless
-- 'UUID'v7, but without checking if the prefix is valid.
unsafeGenTypeID' :: MonadIO m => Text -> m (TypeID' 'V7)
unsafeGenTypeID' :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V7)
unsafeGenTypeID' Text
prefix = Text -> UUID -> TypeID' 'V7
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> TypeID' 'V7) -> m UUID -> m (TypeID' 'V7)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UUID
forall (m :: * -> *). MonadIO m => m UUID
V7.genUUID'
{-# INLINE unsafeGenTypeID' #-}

-- | Generate a new 'TypeID'' ''V4' from a prefix based on insecure 'UUID'v4,
-- but without checking if the prefix is valid.
unsafeGenTypeIDV4' :: MonadIO m => Text -> m (TypeID' 'V4)
unsafeGenTypeIDV4' :: forall (m :: * -> *). MonadIO m => Text -> m (TypeID' 'V4)
unsafeGenTypeIDV4' Text
prefix = Text -> UUID -> TypeID' 'V4
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> TypeID' 'V4) -> m UUID -> m (TypeID' 'V4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
{-# INLINE unsafeGenTypeIDV4' #-}

-- | Generate n 'Data.TypeID.V7.TypeID's from a prefix, but without checking if
-- the prefix is valid.
--
-- It tries its best to generate 'Data.TypeID.V7.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 'Data.TypeID.V7.TypeID's are generated
-- at the same timestamp.
unsafeGenTypeIDs :: MonadIO m => Text -> Word16 -> m [TypeID' 'V7]
unsafeGenTypeIDs :: forall (m :: * -> *).
MonadIO m =>
Text -> Word16 -> m [TypeID' 'V7]
unsafeGenTypeIDs Text
prefix Word16
n = (UUID -> TypeID' 'V7) -> [UUID] -> [TypeID' 'V7]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> UUID -> TypeID' 'V7
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix) ([UUID] -> [TypeID' 'V7]) -> m [UUID] -> m [TypeID' 'V7]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> m [UUID]
forall (m :: * -> *). MonadIO m => Word16 -> m [UUID]
V7.genUUIDs Word16
n
{-# INLINE unsafeGenTypeIDs #-}

-- | Parse a 'TypeID'' from its 'String' representation, but crashes when
-- parsing fails.
unsafeParseString :: String -> TypeID' version
unsafeParseString :: forall (version :: UUIDVersion). String -> TypeID' version
unsafeParseString String
str = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') String
str of
  (String
_, String
"")              -> Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
"" (UUID -> TypeID' version)
-> (ByteString -> UUID) -> ByteString -> TypeID' version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UUID
unsafeDecodeUUID (ByteString -> TypeID' version) -> ByteString -> TypeID' version
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString String
str
  (String
prefix, Char
_ : String
suffix) -> Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' (String -> Text
T.pack String
prefix)
                        (UUID -> TypeID' version)
-> (ByteString -> UUID) -> ByteString -> TypeID' version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UUID
unsafeDecodeUUID (ByteString -> TypeID' version) -> ByteString -> TypeID' version
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString String
suffix
{-# INLINE unsafeParseString #-}

-- | Parse a 'TypeID'' from its string representation as a strict 'Text', but
-- crashes when parsing fails.
unsafeParseText :: Text -> TypeID' version
unsafeParseText :: forall (version :: UUIDVersion). Text -> TypeID' version
unsafeParseText Text
text = case (Text -> Maybe (Char, Text))
-> (Text, Text) -> (Text, Maybe (Char, Text))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> Maybe (Char, Text)
T.uncons ((Text, Text) -> (Text, Maybe (Char, Text)))
-> (Text, Text) -> (Text, Maybe (Char, Text))
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') Text
text of
  (Text
_, Maybe (Char, Text)
Nothing)               -> Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
"" (UUID -> TypeID' version)
-> (ByteString -> UUID) -> ByteString -> TypeID' version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UUID
unsafeDecodeUUID
                              (ByteString -> UUID)
-> (ByteString -> ByteString) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> TypeID' version) -> ByteString -> TypeID' version
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
text
  (Text
prefix, Just (Char
_, Text
suffix)) -> Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
prefix (UUID -> TypeID' version)
-> (Text -> UUID) -> Text -> TypeID' version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UUID
unsafeDecodeUUID
                              (ByteString -> UUID) -> (Text -> ByteString) -> Text -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> TypeID' version) -> Text -> TypeID' version
forall a b. (a -> b) -> a -> b
$ Text
suffix
{-# INLINE unsafeParseText #-}

-- | Parse a 'TypeID'' from its string representation as a lazy 'ByteString',
-- but crashes when parsing fails.
unsafeParseByteString :: ByteString -> TypeID' version
unsafeParseByteString :: forall (version :: UUIDVersion). ByteString -> TypeID' version
unsafeParseByteString ByteString
bs = case (ByteString -> Maybe (Word8, ByteString))
-> (ByteString, ByteString)
-> (ByteString, Maybe (Word8, ByteString))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> Maybe (Word8, ByteString)
BSL.uncons ((ByteString, ByteString)
 -> (ByteString, Maybe (Word8, ByteString)))
-> (ByteString, ByteString)
-> (ByteString, Maybe (Word8, ByteString))
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BSL.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
95) ByteString
bs of
  (ByteString
_, Maybe (Word8, ByteString)
Nothing)               -> Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' Text
"" (UUID -> TypeID' version) -> UUID -> TypeID' version
forall a b. (a -> b) -> a -> b
$ ByteString -> UUID
unsafeDecodeUUID ByteString
bs
  (ByteString
prefix, Just (Word8
_, ByteString
suffix)) -> Text -> UUID -> TypeID' version
forall (version :: UUIDVersion). Text -> UUID -> TypeID' version
TypeID' (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
prefix)
                              (UUID -> TypeID' version)
-> (ByteString -> UUID) -> ByteString -> TypeID' version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UUID
unsafeDecodeUUID (ByteString -> TypeID' version) -> ByteString -> TypeID' version
forall a b. (a -> b) -> a -> b
$ ByteString
suffix
{-# INLINE unsafeParseByteString #-}

concat5BitInts :: [Word8] -> [Word8]
concat5BitInts :: [Word8] -> [Word8]
concat5BitInts
  = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Word8]
forall {t} {a}. (Integral t, Num a, Bits t) => t -> [a]
toBytes
  (Integer -> [Word8]) -> ([Word8] -> Integer) -> [Word8] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Integer
acc :: Integer) Word8
w -> Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) Integer
0
  where
    toBytes :: t -> [a]
toBytes t
0 = []
    toBytes t
x = t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t
x t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
0xFF) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a]
toBytes (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
{-# INLINE concat5BitInts #-}

separate5BitInts :: [Word8] -> [Word8]
separate5BitInts :: [Word8] -> [Word8]
separate5BitInts
  = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Word8]
forall {t} {a}. (Integral t, Num a, Bits t) => t -> [a]
toBytes
  (Integer -> [Word8]) -> ([Word8] -> Integer) -> [Word8] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Integer
acc :: Integer) Word8
w -> Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) Integer
0
  where
    toBytes :: t -> [a]
toBytes t
0 = []
    toBytes t
x = t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t
x t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
0x1F) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a]
toBytes (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
{-# INLINE separate5BitInts #-}

-- | A helper for generating 'UUID'v1.
nextUUID :: IO UUID
nextUUID :: IO UUID
nextUUID = IO (Maybe UUID)
V1.nextUUID IO (Maybe UUID) -> (Maybe UUID -> IO UUID) -> IO UUID
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO UUID -> (UUID -> IO UUID) -> Maybe UUID -> IO UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO UUID
nextUUID UUID -> IO UUID
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE nextUUID #-}

spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd :: forall a. (a -> Bool) -> [a] -> ([a], [a])
spanEnd a -> Bool
p = ([a] -> [a]) -> ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [a] -> [a]
forall a. [a] -> [a]
reverse [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p ([a] -> ([a], [a])) -> ([a] -> [a]) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
{-# INLINE spanEnd #-}

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

suffixEncode :: ByteString -> String
suffixEncode :: ByteString -> String
suffixEncode ByteString
bs = (Array Word8 Char
alphabet Array Word8 Char -> Word8 -> Char
forall i e. Ix i => Array i e -> i -> e
!) (Word8 -> Char) -> [Word8] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. ST s [Word8]) -> [Word8]
forall a. (forall s. ST s a) -> a
runST do
  STUArray s Int Word8
dest <- (Int, Int) -> ST s (STUArray s Int Word8)
forall i. Ix i => (i, i) -> ST s (STUArray s i Word8)
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)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
224) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
248) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
7) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
192) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
62) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
1) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
240) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
128) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
124) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
3) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
5 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
224) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
5 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
248) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
7) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
7 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
192) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
7 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
62) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
7 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
1) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
240) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
9 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
128) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
9 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
124) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
9 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
3) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
10 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
224) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
10 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
11 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
248) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
11 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
7) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
12 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
192) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
12 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
62) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
12 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
1) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
13 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
240) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
13 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
14 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
128) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
14 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
124) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
14 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
3) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
15 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
224) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
15 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31
  Array Int Word8 -> [Word8]
forall i e. Array i e -> [e]
elems (Array Int Word8 -> [Word8])
-> ST s (Array Int Word8) -> ST s [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STUArray s Int Word8 -> ST s (Array Int Word8)
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 = (Word8, Word8) -> String -> Array Word8 Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Word8
0, Word8
31) String
"0123456789abcdefghjkmnpqrstvwxyz"

suffixDecode :: ByteString -> ByteString
suffixDecode :: ByteString -> ByteString
suffixDecode ByteString
bs = [Word8] -> ByteString
BSL.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (forall s. ST s [Word8]) -> [Word8]
forall a. (forall s. ST s a) -> a
runST do
  STUArray s Int Word8
dest <- (Int, Int) -> ST s (STUArray s Int Word8)
forall i. Ix i => (i, i) -> ST s (STUArray s i Word8)
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)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
0)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
1))
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
2)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
3)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
3)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
4)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
5)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
5)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
6)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
6)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
7)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
8)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
8)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
9))
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
10)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
11)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
11)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
12)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
13)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
13)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
14)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
14)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
15)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
16)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
16)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
17))
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
18)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
19)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
19)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
20)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
21)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
21)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
22)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
22)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
23)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
24)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
  STUArray s Int Word8 -> Int -> Word8 -> ST s ()
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 (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ ((Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
24)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
! (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
25))
  Array Int Word8 -> [Word8]
forall i e. Array i e -> [e]
elems (Array Int Word8 -> [Word8])
-> ST s (Array Int Word8) -> ST s [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STUArray s Int Word8 -> ST s (Array Int Word8)
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
  Bool -> Either TypeIDError () -> Either TypeIDError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int64
BSL.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
26) (Either TypeIDError () -> Either TypeIDError ())
-> Either TypeIDError () -> Either TypeIDError ()
forall a b. (a -> b) -> a -> b
$ TypeIDError -> Either TypeIDError ()
forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
  Bool -> Either TypeIDError () -> Either TypeIDError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
bs HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
`BSL.index` Int64
0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
55) (Either TypeIDError () -> Either TypeIDError ())
-> Either TypeIDError () -> Either TypeIDError ()
forall a b. (a -> b) -> a -> b
$ TypeIDError -> Either TypeIDError ()
forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
  Bool -> Either TypeIDError () -> Either TypeIDError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFF) (Word8 -> Bool) -> (Word8 -> Word8) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Word8 Word8
base32Table Array Word8 Word8 -> Word8 -> Word8
forall i e. Ix i => Array i e -> i -> e
!)) ([Word8] -> Bool) -> [Word8] -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BSL.unpack ByteString
bs) do
    TypeIDError -> Either TypeIDError ()
forall a b. a -> Either a b
Left TypeIDError
TypeIDErrorUUIDError
  UUID -> Either TypeIDError UUID
forall a. a -> Either TypeIDError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> Either TypeIDError UUID)
-> UUID -> Either TypeIDError UUID
forall a b. (a -> b) -> a -> b
$ ByteString -> UUID
unsafeDecodeUUID ByteString
bs
{-# INLINE decodeUUID #-}

unsafeDecodeUUID :: ByteString -> UUID
unsafeDecodeUUID :: ByteString -> UUID
unsafeDecodeUUID
  = (Word64 -> Word64 -> UUID) -> (Word64, Word64) -> UUID
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> UUID
UUID ((Word64, Word64) -> UUID)
-> (ByteString -> (Word64, Word64)) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get (Word64, Word64) -> ByteString -> (Word64, Word64)
forall a. Get a -> ByteString -> a
runGet ((Get Word64 -> Get Word64 -> Get (Word64, Word64))
-> Get Word64 -> Get (Word64, Word64)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Word64 -> Word64 -> (Word64, Word64))
-> Get Word64 -> Get Word64 -> Get (Word64, Word64)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)) Get Word64
getWord64be) (ByteString -> (Word64, Word64))
-> (ByteString -> ByteString) -> ByteString -> (Word64, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
suffixDecode
{-# INLINE unsafeDecodeUUID #-}

base32Table :: Array Word8 Word8
base32Table :: Array Word8 Word8
base32Table = (Word8, Word8) -> [Word8] -> Array Word8 Word8
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 ]