mmzk-typeid 0.4.0.1 → 0.5.0.0

raw patch · 12 files changed

+822/−34 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• README.md +2/−2
• mmzk-typeid.cabal +9/−1
• src/Data/KindID/Internal.hs +100/−19
• src/Data/KindID/V5.hs +169/−0
• src/Data/KindID/V5/Unsafe.hs +69/−0
• src/Data/TypeID/Class.hs +15/−6
• src/Data/TypeID/Internal.hs +70/−0
• src/Data/TypeID/V5.hs +139/−0
• src/Data/TypeID/V5/Unsafe.hs +54/−0
• src/Data/UUID/Versions.hs +1/−1
• test/Spec.hs +182/−5

@@ -1,6 +1,18 @@ # Revision history for mmzk-typeid  +## 0.5.0.0 -- 2023-08-31++* Support `TypeID` and `KindID` with `UUID` suffixes of version 5.+  * They are exported in `Data.TypeID.V5` and `Data.KindID.V5`.++* Tests for V5 `TypeID` and `KindID`.++* Change signature for `genID_` to support `UUID`v5.++* Decide against moving the `decorate` method.++ ## 0.4.0.1 -- 2023-08-19  * Support `TypeID` and `KindID` with `UUID` suffixes of version 1.

@@ -63,9 +63,9 @@  ## More Usages -### V4 TypeID+### TypeID with other UUID Versions -We also support TypeID using UUIDv4, which loses the monoticity property. To use it, simply import `Data.TypeID.V4` instead of `Data.TypeID`.+We also support TypeID using some other versions of `UUID`, including v1 and v4, which loses the monoticity property. To use it, simply import `Data.TypeID.V4` instead of `Data.TypeID`. The following is an example using v4:  ```Haskell {-# LANGUAGE OverloadedStrings #-}

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               mmzk-typeid-version:            0.4.0.1+version:            0.5.0.0  synopsis:           A TypeID implementation for Haskell description:@@ -54,6 +54,8 @@         Data.KindID.V1.Unsafe,         Data.KindID.V4,         Data.KindID.V4.Unsafe,+        Data.KindID.V5,+        Data.KindID.V5.Unsafe,         Data.KindID.V7,         Data.KindID.V7.Unsafe,         Data.TypeID,@@ -64,6 +66,8 @@         Data.TypeID.V1.Unsafe,         Data.TypeID.V4,         Data.TypeID.V4.Unsafe,+        Data.TypeID.V5,+        Data.TypeID.V5.Unsafe,         Data.TypeID.V7,         Data.TypeID.V7.Unsafe,         Data.UUID.V7,@@ -115,6 +119,8 @@         Data.KindID.V1.Unsafe,         Data.KindID.V4,         Data.KindID.V4.Unsafe,+        Data.KindID.V5,+        Data.KindID.V5.Unsafe,         Data.KindID.V7,         Data.KindID.V7.Unsafe,         Data.TypeID,@@ -126,6 +132,8 @@         Data.TypeID.V1.Unsafe,         Data.TypeID.V4,         Data.TypeID.V4.Unsafe,+        Data.TypeID.V5,+        Data.TypeID.V5.Unsafe,         Data.TypeID.V7,         Data.TypeID.V7.Unsafe,         Data.UUID.V7,

@@ -23,9 +23,10 @@ import           Data.TypeID.Internal (TypeID'(..)) import qualified Data.TypeID.Internal as TID import           Data.UUID.Types.Internal (UUID(..))-import           Data.TypeID.V7 (TypeID)-import qualified Data.UUID.V1 as V1-import qualified Data.UUID.V4 as V4+import qualified Data.TypeID.V1.Unsafe as V1+import qualified Data.TypeID.V4.Unsafe as V4+import qualified Data.TypeID.V5.Unsafe as V5+import qualified Data.TypeID.V7.Unsafe as V7 import qualified Data.UUID.V7 as V7 import           Data.UUID.Versions import           Foreign@@ -188,6 +189,8 @@   => IDGen (KindID' 'V7 prefix) where     type IDGenPrefix (KindID' 'V7 prefix) = 'Nothing +    type IDGenReq (KindID' 'V7 prefix) r = r+     genID_ :: MonadIO m => Proxy (KindID' 'V7 prefix) -> m (KindID' 'V7 prefix)     genID_ _ = genKindID     {-# INLINE genID_ #-}@@ -218,12 +221,13 @@     checkIDWithEnv_ _ = checkKindIDWithEnv     {-# INLINE checkIDWithEnv_ #-} - -- | Generate 'KindID'' ''V1's. instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))   => IDGen (KindID' 'V1 prefix) where     type IDGenPrefix (KindID' 'V1 prefix) = 'Nothing +    type IDGenReq (KindID' 'V1 prefix) r = r+     genID_ :: MonadIO m => Proxy (KindID' 'V1 prefix) -> m (KindID' 'V1 prefix)     genID_ _ = genKindIDV1     {-# INLINE genID_ #-}@@ -249,6 +253,8 @@   => IDGen (KindID' 'V4 prefix) where     type IDGenPrefix (KindID' 'V4 prefix) = 'Nothing +    type IDGenReq (KindID' 'V4 prefix) r = r+     genID_ :: MonadIO m => Proxy (KindID' 'V4 prefix) -> m (KindID' 'V4 prefix)     genID_ _ = genKindIDV4     {-# INLINE genID_ #-}@@ -259,8 +265,7 @@      genIDs_ :: MonadIO m             => Proxy (KindID' 'V4 prefix) -> Word16 -> m [KindID' 'V4 prefix]-    genIDs_ _ n-      = fmap KindID' <$> replicateM (fromIntegral n) (liftIO V4.nextRandom)+    genIDs_ p n = replicateM (fromIntegral n) (genID_ p)     {-# INLINE genIDs_ #-}      decorate_ :: Proxy (KindID' 'V4 prefix) -> UUID -> KindID' 'V4 prefix@@ -273,23 +278,65 @@     checkID_ _ = checkKindIDV4     {-# INLINE checkID_ #-} +-- | Generate 'KindID'' ''V5's.+instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+  => IDGen (KindID' 'V5 prefix) where+    type IDGenPrefix (KindID' 'V5 prefix) = 'Nothing++    type IDGenReq (KindID' 'V5 prefix) r = UUID -> [Word8] -> r++    genID_ :: MonadIO m+           => Proxy (KindID' 'V5 prefix)+           -> UUID+           -> [Word8]+           -> m (KindID' 'V5 prefix)+    genID_ _ = (pure .) . genKindIDV5+    {-# INLINE genID_ #-}++    genIDs_ :: MonadIO m+            => Proxy (KindID' 'V5 prefix)+            -> UUID+            -> [Word8]+            -> Word16+            -> m [KindID' 'V5 prefix]+    genIDs_ p ns obj n = replicateM (fromIntegral n) (genID_ p ns obj)+    {-# INLINE genIDs_ #-}++    decorate_ :: Proxy (KindID' 'V5 prefix) -> UUID -> KindID' 'V5 prefix+    decorate_ _ = decorateKindID+    {-# INLINE decorate_ #-}++    checkID_ :: Proxy (KindID' 'V5 prefix)+             -> KindID' 'V5 prefix+             -> Maybe TypeIDError+    checkID_ _ = checkKindIDV5+    {-# INLINE checkID_ #-}+ -- | Generate a new 'Data.KindID.V7.KindID' 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.-genKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+genKindID :: forall prefix m+           . ( ToPrefix prefix+             , ValidPrefix (PrefixSymbol prefix)+             , MonadIO m )           => m (KindID' 'V7 prefix)-genKindID = KindID' <$> V7.genUUID+genKindID = unsafeFromTypeID+        <$> V7.unsafeGenTypeID (T.pack $ symbolVal @(PrefixSymbol prefix) Proxy) {-# INLINE genKindID #-}  -- | Generate a new 'Data.KindID.V7.KindID' from a prefix based on stateless -- 'UUID'v7. -- -- See the documentation of 'V7.genUUID'' for more information.-genKindID' :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+genKindID' :: forall prefix m+            . ( ToPrefix prefix+              , ValidPrefix (PrefixSymbol prefix)+              , MonadIO m )            => m (KindID' 'V7 prefix)-genKindID' = KindID' <$> V7.genUUID'+genKindID' = fmap unsafeFromTypeID . V7.unsafeGenTypeID' . T.pack+           $ symbolVal @(PrefixSymbol prefix) Proxy {-# INLINE genKindID' #-}  -- | Generate a list of 'Data.KindID.V7.KindID's from a prefix.@@ -300,9 +347,13 @@ -- -- It is guaranteed that the first 32768 'Data.KindID.V7.KindID's are generated -- at the same timestamp.-genKindIDs :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+genKindIDs :: forall prefix m+            . ( ToPrefix prefix+              , ValidPrefix (PrefixSymbol prefix)+              , MonadIO m )            => Word16 -> m [KindID' 'V7 prefix]-genKindIDs n = fmap KindID' <$> V7.genUUIDs n+genKindIDs n = fmap (unsafeFromTypeID <$>) . flip V7.unsafeGenTypeIDs n . T.pack+             $ symbolVal @(PrefixSymbol prefix) Proxy {-# INLINE genKindIDs #-}  -- | Generate a new 'KindID'' ''V1' from a prefix.@@ -310,9 +361,13 @@ -- 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.-genKindIDV1 :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)-            => m (KindID' 'V1 prefix)-genKindIDV1 = KindID' <$> liftIO TID.nextUUID+genKindIDV1 :: forall prefix m+           . ( ToPrefix prefix+             , ValidPrefix (PrefixSymbol prefix)+             , MonadIO m )+          => m (KindID' 'V1 prefix)+genKindIDV1 = fmap unsafeFromTypeID . V1.unsafeGenTypeID . T.pack+            $ symbolVal @(PrefixSymbol prefix) Proxy {-# INLINE genKindIDV1 #-}  -- | Generate a new 'KindID'' ''V4' from a prefix.@@ -320,17 +375,37 @@ -- 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.-genKindIDV4 :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+genKindIDV4 :: forall prefix m+             . ( ToPrefix prefix+             , ValidPrefix (PrefixSymbol prefix)+             , MonadIO m )             => m (KindID' 'V4 prefix)-genKindIDV4 = KindID' <$> liftIO V4.nextRandom+genKindIDV4 = fmap unsafeFromTypeID . V4.unsafeGenTypeID . T.pack+            $ symbolVal @(PrefixSymbol prefix) Proxy {-# INLINE genKindIDV4 #-}  -- | Generate a new 'KindID'' ''V4' from a prefix with insecure 'UUID'v4.-genKindIDV4' :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+genKindIDV4' :: forall prefix m+              . ( ToPrefix prefix+                , ValidPrefix (PrefixSymbol prefix)+                , MonadIO m )              => m (KindID' 'V4 prefix)-genKindIDV4' = KindID' <$> liftIO randomIO+genKindIDV4' = fmap unsafeFromTypeID . V4.unsafeGenTypeID' . T.pack+             $ symbolVal @(PrefixSymbol prefix) Proxy {-# INLINE genKindIDV4' #-} +-- | Generate a new 'KindID'' ''V5' from a namespace and an object.+genKindIDV5 :: forall prefix+             . ( ToPrefix prefix+               , ValidPrefix (PrefixSymbol prefix))+            => UUID+            -> [Word8]+            -> KindID' 'V5 prefix+genKindIDV5 ns obj+  = unsafeFromTypeID . flip (`V5.unsafeGenTypeID` ns) obj . T.pack+  $ symbolVal @(PrefixSymbol prefix) Proxy+{-# INLINE genKindIDV5 #-}+ -- | Obtain a 'KindID'' from a prefix and a 'UUID'. decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))                => UUID -> KindID' version prefix@@ -470,6 +545,12 @@               => KindID' 'V4 prefix -> Maybe TypeIDError checkKindIDV4 = TID.checkTypeIDV4 . toTypeID {-# INLINE checkKindIDV4 #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v5+-- version and variant.+checkKindIDV5 :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+              => KindID' 'V5 prefix -> Maybe TypeIDError+checkKindIDV5 = TID.checkTypeIDV5 . toTypeID  -- | Convert a 'TypeID'' to a 'KindID''. If the actual prefix does not match -- with the expected one as defined by the type, it does not complain and

@@ -0,0 +1,169 @@+-- |+-- Module      : Data.KindID.V5+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- 'Data.KindID.V7.KindID' with 'UUID'v5.+--+module Data.KindID.V5+  (+  -- * Data types+    KindIDV5+  , getPrefix+  , getUUID+  , getTime+  -- * 'KindIDV5' generation ('KindIDV5'-specific)+  , genKindID+  , decorateKindID+  -- * 'KindIDV5' generation (class methods)+  , genID+  , decorate+  -- * Validation ('KindIDV5'-specific)+  , checkKindID+  -- * Validation (class methods)+  , checkID+  -- * Encoding & decoding ('KindIDV5'-specific)+  , toString+  , toText+  , toByteString+  , parseString+  , parseText+  , parseByteString+  , parseStringM+  , parseTextM+  , parseByteStringM+  -- * Encoding & decoding (class methods)+  , id2String+  , id2Text+  , id2ByteString+  , string2ID+  , text2ID+  , byteString2ID+  , string2IDM+  , text2IDM+  , byteString2IDM+  -- * Type-level & term-level conversion+  , toTypeID+  , fromTypeID+  ) where++import           Control.Monad.IO.Class+import           Data.ByteString.Lazy (ByteString)+import           Data.KindID.Class+import           Data.KindID.Internal (KindID'(..))+import qualified Data.KindID.Internal as KID+import           Data.Text (Text)+import           Data.TypeID.Class+import           Data.TypeID.Error+import           Data.TypeID.V5 (TypeIDV5)+import           Data.TypeID.V7 (TypeID)+import           Data.UUID.Types.Internal (UUID)+import           Data.UUID.Versions+import           Data.Word++-- | Similar to 'Data.KindID.V7.KindID', but uses 'UUID'v5.+type KindIDV5 = KID.KindID' 'V5++-- | Generate a new 'KindIDV5' 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.+genKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+          => UUID -> [Word8] -> KindIDV5 prefix+genKindID = KID.genKindIDV5+{-# INLINE genKindID #-}++-- | Obtain a 'KindIDV5' from a prefix and a 'UUID'.+decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+               => UUID -> KindIDV5 prefix+decorateKindID = KID.decorateKindID+{-# INLINE decorateKindID #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v5+-- version and variant.+checkKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+            => KindIDV5 prefix -> Maybe TypeIDError+checkKindID = KID.checkKindIDV5+{-# INLINE checkKindID #-}++-- | Pretty-print a 'KindIDV5'. It is 'id2String' with concrete type.+toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+         => KindIDV5 prefix -> String+toString = KID.toString+{-# INLINE toString #-}++-- | Pretty-print a 'KindIDV5' to strict 'Text'. It is 'id2Text' with concrete+-- type.+toText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+       => KindIDV5 prefix -> Text+toText = KID.toText+{-# INLINE toText #-}++-- | Pretty-print a 'KindIDV5' to lazy 'ByteString'. It is 'id2ByteString' with+-- concrete type.+toByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+             => KindIDV5 prefix -> ByteString+toByteString = KID.toByteString+{-# INLINE toByteString #-}++-- | Parse a 'KindIDV5' from its 'String' representation. It is 'parseString'+-- with concrete type.+parseString :: forall prefix+             . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+            => String -> Either TypeIDError (KindIDV5 prefix)+parseString = KID.parseString+{-# INLINE parseString #-}++-- | Parse a 'KindIDV5' from its string representation as a strict 'Text'. It is+-- 'parseText' with concrete type.+parseText :: forall prefix+           . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+          => Text -> Either TypeIDError (KindIDV5 prefix)+parseText = KID.parseText+{-# INLINE parseText #-}++-- | Parse a 'KindIDV5' from its string representation as a lazy 'ByteString'.+-- It is 'parseByteString' with concrete type.+parseByteString :: forall prefix+                 . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                => ByteString -> Either TypeIDError (KindIDV5 prefix)+parseByteString = KID.parseByteString++-- | Parse a 'KindIDV5' from its 'String' representation, throwing an error when+-- the parsing fails. It is 'string2IDM' with concrete type.+parseStringM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+             => String -> m (KindIDV5 prefix)+parseStringM = KID.parseStringM+{-# INLINE parseStringM #-}++-- | Parse a 'KindIDV5' from its string representation as a strict 'Text',+-- throwing an error when the parsing fails. It is 'text2IDM' with concrete+-- type. It is 'parseTextM' with concrete type.+parseTextM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+           => Text -> m (KindIDV5 prefix)+parseTextM = KID.parseTextM+{-# INLINE parseTextM #-}++-- | Parse a 'KindIDV5' from its string representation as a lazy 'ByteString',+-- throwing an error when the parsing fails. It is 'byteString2IDM' with+-- concrete type. It is 'parseByteStringM' with concrete type.+parseByteStringM :: ( ToPrefix prefix+                    , ValidPrefix (PrefixSymbol prefix)+                    , MonadIO m )+                 => ByteString -> m (KindIDV5 prefix)+parseByteStringM = KID.parseByteStringM+{-# INLINE parseByteStringM #-}++-- | Convert a 'KindIDV5' to a 'Data.TypeID.V4.TypeIDV5'.+toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+         => KindIDV5 prefix -> TypeIDV5+toTypeID = KID.toTypeID+{-# INLINE toTypeID #-}++-- | Convert a 'TypeIDV5' to a 'KindIDV5'.+fromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+           => TypeIDV5 -> Maybe (KindIDV5 prefix)+fromTypeID = KID.fromTypeID+{-# INLINE fromTypeID #-}

@@ -0,0 +1,69 @@+-- |+-- Module      : Data.KindID.V5.Unsafe+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Unsafe 'KindIDV5' functions.+--+module Data.KindID.V5.Unsafe+  (+  -- * Unsafe 'KindIDV5' decoding ('KindIDV5'-specific)+    unsafeParseString+  , unsafeParseText+  , unsafeParseByteString+  -- * Unsafe 'KindIDV5' decoding (class methods)+  , unsafeString2ID+  , unsafeText2ID+  , unsafeByteString2ID+  -- * Unsafe conversion+  , unsafeFromTypeID+  ) where++import           Data.ByteString.Lazy (ByteString)+import           Data.KindID.Class+import           Data.KindID.Internal (KindID')+import qualified Data.KindID.Internal as KID+import           Data.KindID.V5 (KindIDV5)+import           Data.TypeID.Internal (TypeID')+import           Data.TypeID.V5 (TypeIDV5)+import           Data.Text (Text)+import           Data.TypeID.Class++-- | Parse a 'KindIDV5' from its 'String' representation, but does not behave+-- correctly when parsing fails.+--+-- More specifically, if the prefix does not match, it will not complain and+-- produce the wrong 'KindIDV5'. If there are other parse errors, it will crash.+unsafeParseString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                  => String -> KindIDV5 prefix+unsafeParseString = KID.unsafeParseString+{-# INLINE unsafeParseString #-}++-- | Parse a 'KindIDV5' from its string representation as a strict 'Text', but+-- does not behave correctly when parsing fails.+--+-- More specifically, if the prefix does not match, it will not complain and+-- produce the wrong 'KindIDV5'. If there are other parse errors, it will crash.+unsafeParseText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                => Text -> KindIDV5 prefix+unsafeParseText = KID.unsafeParseText+{-# INLINE unsafeParseText #-}++-- | Parse a 'KindIDV5' from its string representation as a lazy 'ByteString',+-- but does not behave correctly when parsing fails.+--+-- More specifically, if the prefix does not match, it will not complain and+-- produce the wrong 'KindIDV5'. If there are other parse errors, it will crash.+unsafeParseByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                      => ByteString -> KindIDV5 prefix+unsafeParseByteString = KID.unsafeParseByteString+{-# INLINE unsafeParseByteString #-}++-- | Convert a 'TypeIDV5' to a 'KindIDV5'. If the actual prefix does not match+-- with the expected one as defined by the type, it does not complain and+-- produces a wrong 'KindIDV5'.+unsafeFromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                 => TypeIDV5 -> KindIDV5 prefix+unsafeFromTypeID = KID.unsafeFromTypeID+{-# INLINE unsafeFromTypeID #-}

@@ -140,7 +140,8 @@             | byteString2ID, id2ByteString #-}  -- | Generate a new identifier with the given prefix.-genID :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (m a)+genID :: forall a m. (IDGen a, MonadIO m)+      => GenFunc (IDGenPrefix a) (IDGenReq a (m a)) genID = genID_ @a @m Proxy {-# INLINE genID #-} @@ -149,13 +150,14 @@ -- monotonically increasing for 'UUID'v7-based identifiers. -- -- The default implementation is the same as 'genID'.-genID' :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (m a)+genID' :: forall a m. (IDGen a, MonadIO m)+       => GenFunc (IDGenPrefix a) (IDGenReq a (m a)) genID' = genID'_ @a @m Proxy {-# INLINE genID' #-}  -- | Generate a list of identifiers with the given prefix. genIDs :: forall a m. (IDGen a, MonadIO m)-       => GenFunc (IDGenPrefix a) (Word16 -> m [a])+       => GenFunc (IDGenPrefix a) (IDGenReq a (Word16 -> m [a])) genIDs = genIDs_ @a @m Proxy {-# INLINE genIDs #-} @@ -186,21 +188,28 @@   -- type of the prefix (e.g. 'Text').   type IDGenPrefix a :: Maybe Type +  -- | If the identifier's generation requires additional information (such as+  -- 'UUID' version 5), this type corresponds to how to generate @r@ from the+  -- required information. Otherwise it should be simply+  -- @ type IDGenReq a r = r @.+  type IDGenReq a r :: Type+   -- | Generate an identifier with the given prefix.-  genID_ :: MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (m a)+  genID_ :: MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq a (m a))    -- | Similar to 'genID'_, but stateless. It can be a faster implementation   -- than 'genID'_, but it does not guarantee any stateful property, such as   -- monotonically increasing for 'UUID'v7-based identifiers.   --   -- The default implementation is the same as 'genID'_.-  genID'_ :: forall m. MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (m a)+  genID'_ :: forall m. MonadIO m+          => Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq a (m a))   genID'_ = genID_ @_ @m   {-# INLINE genID'_ #-}    -- | Generate a list of identifiers with the given prefix.   genIDs_ :: forall m. MonadIO m-          => Proxy a -> GenFunc (IDGenPrefix a) (Word16 -> m [a])+          => Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq a (Word16 -> m [a]))    -- | Generate a new identifier with the given prefix and 'UUID' suffix.   decorate_ :: Proxy a

@@ -35,6 +35,7 @@ import qualified Data.UUID.Types.Internal as 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           System.Random@@ -213,6 +214,8 @@ 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_ _ = genTypeID   {-# INLINE genID_ #-}@@ -247,9 +250,12 @@   checkIDWithEnv_ _ = 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_ _ = genTypeIDV1   {-# INLINE genID_ #-}@@ -276,9 +282,12 @@   checkID_ _ = 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_ _ = genTypeIDV4   {-# INLINE genID_ #-}@@ -309,6 +318,42 @@   checkID_ _ = 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_ _ = genTypeIDV5+  {-# INLINE genID_ #-}++  genIDs_ :: MonadIO m+          => Proxy (TypeID' 'V5)+          -> Text+          -> UUID+          -> [Word8]+          -> Word16+          -> m [TypeID' 'V5]+  -- Apparently this function is useless...+  genIDs_ _ prefix ns obj n = case checkPrefix prefix of+    Nothing  -> replicateM (fromIntegral n)+              $ pure (TypeID' prefix $ V5.generateNamed ns obj)+    Just err -> liftIO $ throwIO err+  {-# INLINE genIDs_ #-}++  decorate_ :: Proxy (TypeID' 'V5)+            -> Text+            -> UUID+            -> Either TypeIDError (TypeID' 'V5)+  decorate_ _ = decorateTypeID+  {-# INLINE decorate_ #-}++  checkID_ :: Proxy (TypeID' 'V5) -> TypeID' 'V5 -> Maybe TypeIDError+  checkID_ _ = 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,@@ -371,6 +416,17 @@   Just err -> liftIO $ throwIO 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 prefix ns obj = case checkPrefix prefix of+  Nothing  -> pure $ unsafeGenTypeIDV5 prefix ns obj+  Just err -> throw err+{-# INLINE genTypeIDV5 #-}+ -- | Obtain a 'TypeID'' from a prefix and a 'UUID'. decorateTypeID :: Text -> UUID -> Either TypeIDError (TypeID' version) decorateTypeID prefix uuid = case checkPrefix prefix of@@ -506,6 +562,14 @@          , TypeIDErrorUUIDError <$ guard (not $ validateWithVersion uuid 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' prefix uuid)+  = msum [ checkPrefix prefix+         , TypeIDErrorUUIDError <$ guard (not $ validateWithVersion uuid 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)@@ -531,6 +595,12 @@ unsafeGenTypeIDV4 :: MonadIO m => Text -> m (TypeID' 'V4) unsafeGenTypeIDV4 prefix = TypeID' prefix <$> liftIO 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 prefix ns obj = TypeID' prefix (V5.generateNamed ns 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.

@@ -0,0 +1,139 @@+-- |+-- Module      : Data.TypeID.V5+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- 'Data.TypeID.V7.TypeID' with 'UUID'v5.+--+module Data.TypeID.V5+  (+  -- * Data types+    TypeIDV5+  , getPrefix+  , getUUID+  -- * 'TypeIDV5' generation ('TypeIDV5'-specific)+  , genTypeID+  , decorateTypeID+  -- * 'TypeIDV5' generation (class methods)+  , genID+  , decorate+  -- * Validation ('TypeIDV5'-specific)+  , checkPrefix+  , checkTypeID+  -- * Validation (class methods)+  , checkID+  -- * Encoding & decoding ('TypeIDV5'-specific)+  , toString+  , toText+  , toByteString+  , parseString+  , parseText+  , parseByteString+  , parseStringM+  , parseTextM+  , parseByteStringM+  -- * Encoding & decoding (class methods)+  , id2String+  , id2Text+  , id2ByteString+  , string2ID+  , text2ID+  , byteString2ID+  , string2IDM+  , text2IDM+  , byteString2IDM+  ) where++import           Control.Monad.IO.Class+import           Data.ByteString.Lazy (ByteString)+import           Data.Text (Text)+import           Data.TypeID.Class+import           Data.TypeID.Error+import qualified Data.TypeID.Internal as TID+import           Data.UUID.Types (UUID)+import           Data.UUID.Versions+import           Data.Word++-- | Similar to 'Data.TypeID.V7.TypeID', but uses 'UUID'v5.+type TypeIDV5 = TID.TypeID' 'V5++-- | Generate a new 'TypeIDV5' 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 -> UUID -> [Word8] -> m TypeIDV5+genTypeID = TID.genTypeIDV5+{-# INLINE genTypeID #-}++-- | Obtain a 'TypeIDV5' from a prefix and a 'UUID'.+decorateTypeID :: Text -> UUID -> Either TypeIDError TypeIDV5+decorateTypeID = TID.decorateTypeID+{-# INLINE decorateTypeID #-}++-- | Check if the given prefix is a valid 'TypeIDV5' prefix.+checkPrefix :: Text -> Maybe TypeIDError+checkPrefix = TID.checkPrefix+{-# INLINE checkPrefix #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v5+-- version and variant.+checkTypeID :: TypeIDV5 -> Maybe TypeIDError+checkTypeID = TID.checkTypeIDV5+{-# INLINE checkTypeID #-}++-- | Pretty-print a 'TypeIDV5'. It is 'id2String' with concrete type.+toString :: TypeIDV5 -> String+toString = TID.toString+{-# INLINE toString #-}++-- | Pretty-print a 'TypeIDV5' to strict 'Text'. It is 'id2Text' with concrete+-- type.+toText :: TypeIDV5 -> Text+toText = TID.toText+{-# INLINE toText #-}++-- | Pretty-print a 'TypeIDV5' to lazy 'ByteString'. It is 'id2ByteString'+-- with concrete type.+toByteString :: TypeIDV5 -> ByteString+toByteString = TID.toByteString+{-# INLINE toByteString #-}++-- | Parse a 'TypeIDV5' from its 'String' representation. It is 'string2ID' with+-- concrete type.+parseString :: String -> Either TypeIDError TypeIDV5+parseString = TID.parseString+{-# INLINE parseString #-}++-- | Parse a 'TypeIDV5' from its string representation as a strict 'Text'. It+-- is 'text2ID' with concrete type.+parseText :: Text -> Either TypeIDError TypeIDV5+parseText = TID.parseText+{-# INLINE parseText #-}++-- | Parse a 'TypeIDV5' from its string representation as a lazy 'ByteString'.+-- It is 'byteString2ID' with concrete type.+parseByteString :: ByteString -> Either TypeIDError TypeIDV5+parseByteString = TID.parseByteString+{-# INLINE parseByteString #-}++-- | Parse a 'TypeIDV5' from its 'String' representation, throwing an error when+-- the parsing fails. It is 'string2IDM' with concrete type.+parseStringM :: MonadIO m => String -> m TypeIDV5+parseStringM = TID.parseStringM+{-# INLINE parseStringM #-}++-- | Parse a 'TypeIDV5' 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 TypeIDV5+parseTextM = TID.parseTextM+{-# INLINE parseTextM #-}++-- | Parse a 'TypeIDV5' 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 TypeIDV5+parseByteStringM = TID.parseByteStringM+{-# INLINE parseByteStringM #-}

@@ -0,0 +1,54 @@+-- |+-- Module      : Data.TypeID.V5.Unsafe+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Unsafe 'TypeIDV5' functions.+--+module Data.TypeID.V5.Unsafe+  (+  -- * Unsafe 'TypeIDV5' generation+    unsafeGenTypeID+  -- * Unsafe decoding ('TypeIDV5'-specific)+  , unsafeParseString+  , unsafeParseText+  , unsafeParseByteString+  -- * Unsafe decoding (class methods)+  , unsafeString2ID+  , unsafeText2ID+  , unsafeByteString2ID+  ) where++import           Control.Monad.IO.Class+import           Data.ByteString.Lazy (ByteString)+import           Data.Text (Text)+import           Data.TypeID.Class+import qualified Data.TypeID.Internal as TID+import           Data.TypeID.V5 (TypeIDV5)+import           Data.UUID.Types.Internal (UUID)+import           Data.Word++-- | Generate a new 'TypeIDV5' from a prefix, but without checking if the prefix+-- is valid.+unsafeGenTypeID :: Text -> UUID -> [Word8] -> TypeIDV5+unsafeGenTypeID = TID.unsafeGenTypeIDV5+{-# INLINE unsafeGenTypeID #-}++-- | Parse a 'TypeIDV5' from its 'String' representation, but crashes when+-- parsing fails.+unsafeParseString :: String -> TypeIDV5+unsafeParseString = TID.unsafeParseString+{-# INLINE unsafeParseString #-}++-- | Parse a 'TypeIDV5' from its string representation as a strict 'Text', but+-- crashes when parsing fails.+unsafeParseText :: Text -> TypeIDV5+unsafeParseText = TID.unsafeParseText+{-# INLINE unsafeParseText #-}++-- | Parse a 'TypeIDV5' from its string representation as a lazy 'ByteString',+-- but crashes when parsing fails.+unsafeParseByteString :: ByteString -> TypeIDV5+unsafeParseByteString = TID.unsafeParseByteString+{-# INLINE unsafeParseByteString #-}

@@ -20,7 +20,7 @@ -- | The supported 'UUID' versions. These constructors are used as type-level -- tags for 'Data.TypeID.TypeID''. ----- 'V5' are not supported yet.+-- 'V5' is not supported yet. data UUIDVersion = V1 | V4 | V5 | V7   deriving (Eq, Ord, Bounded, Enum, Show) 

@@ -10,6 +10,7 @@ import qualified Data.ByteString.Lazy as BSL import           Data.KindID.V1 (KindIDV1) import           Data.KindID.V4 (KindIDV4)+import           Data.KindID.V5 (KindIDV5) import           Data.KindID import           Data.KindID.Class import           Data.Map (Map)@@ -20,9 +21,11 @@ import           Data.TypeID import           Data.TypeID.V1 (TypeIDV1) import           Data.TypeID.V4 (TypeIDV4)+import           Data.TypeID.V5 (TypeIDV5) import           Data.TypeID.Class import           Data.TypeID.Error import           Data.UUID.Types (nil)+import           Data.UUID.V4 (nextRandom) import           Data.UUID.V7 (UUID) import qualified Data.UUID.V7 as V7 import           Foreign@@ -78,6 +81,7 @@   v7Test   v1Test   v4Test+  v5Test  v7Test :: Spec v7Test = do@@ -217,7 +221,7 @@       kid   <- withCheck $ genID @(KindID "")       getPrefix kid `shouldBe` ""       getTime kid `shouldSatisfy` \t -> start <= t-    it "can generate KindID with stateless UUID v7" do+    it "can generate KindID with stateless UUIDv7" do       start <- V7.getEpochMilli       kid   <- withCheck $ genID' @(KindID "mmzk")       getPrefix kid `shouldBe` "mmzk"@@ -415,9 +419,6 @@     it "can generate KindIDV1 without prefix" do       kid <- withCheck $ genID @(KindIDV1 "")       getPrefix kid `shouldBe` ""-    it "can generate KindIDV1 with stateless UUID v7" do-      kid <- withCheck $ genID' @(KindIDV1 "mmzk")-      getPrefix kid `shouldBe` "mmzk"     it "can parse KindID from String" do       case string2ID @(KindIDV1 "mmzk") "mmzk_5hjpeh96458fct8t49fnf9farw" of         Left err  -> expectationFailure $ "Parse error: " ++ show err@@ -597,7 +598,7 @@     it "can generate KindIDV4 without prefix" do       kid <- withCheck $ genID @(KindIDV4 "")       getPrefix kid `shouldBe` ""-    it "can generate KindIDV4 with stateless UUID v7" do+    it "can generate KindIDV4 with insecure UUIDv4" do       kid <- withCheck $ genID' @(KindIDV4 "mmzk")       getPrefix kid `shouldBe` "mmzk"     it "can parse KindID from String" do@@ -649,6 +650,182 @@         free ptr     it "has correct Storable instance for KindIDV4" do       kids <- withChecks $ genIDs @(KindIDV4 "abcdefghijklmnopqrstuvwxyz") 114+      forM_ kids \kid -> do+        ptr   <- new kid+        kid'  <- peek ptr+        kid' `shouldBe` kid+        poke ptr kid'+        kid'' <- peek ptr+        kid'' `shouldBe` kid'+        free ptr++v5Test :: Spec+v5Test = do+  invalid   <- runIO (BSL.readFile "test/invalid.json" >>= throwDecode :: IO [TestData])+  valid     <- runIO (BSL.readFile "test/valid.json" >>= throwDecode :: IO [TestData])+  validUUID <- runIO (BSL.readFile "test/valid.json" >>= throwDecode :: IO [TestDataUUID TypeIDV5])+  uuid      <- runIO nextRandom+  describe "Generate TypeIDV5" do+    it "can generate TypeIDV5 with prefix" do+      tid <- withCheck $ genID @TypeIDV5 "mmzk" uuid [11, 45, 14]+      getPrefix tid `shouldBe` "mmzk"+    it "can generate TypeIDV5 without prefix" do+      tid <- withCheck $ genID @TypeIDV5 "" uuid [11, 45, 14]+      getPrefix tid `shouldBe` ""+    it "can parse TypeIDV5 from String" do+      case string2ID @TypeIDV5 "mmzk_5hjpeh96458fct8t49fnf9farw" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> getPrefix tid `shouldBe` "mmzk"++  describe "Parse TypeIDV5" do+    let invalidPrefixes = [ ("caps", "PREFIX")+                          , ("numeric", "12323")+                          , ("symbols", "pre.fix")+                          , ("spaces", "  ")+                          , ("long", "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")+                          , ("ascii", "château") ]+    describe "can detect invalid prefix" do+      forM_ invalidPrefixes \(reason, prefix) -> it reason do+        genID @TypeIDV5 prefix  uuid [11, 45, 14] `shouldThrow` anyTypeIDError+        case decorate @TypeIDV5 prefix nil of+          Left _  -> pure ()+          Right _ -> expectationFailure "Should not be able to decorate with invalid prefix"+    let invalidSuffixes = [ ("spaces", " ")+                          , ("short", "01234")+                          , ("long", "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789")+                          , ("caps", "00041061050R3GG28A1C60T3GF") -- Would be valid in lowercase+                          , ("hyphens", "00041061050-3gg28a1-60t3gf")+                          , ("crockford_ambiguous", "ooo41o61o5or3gg28a1c6ot3gi") -- Would be valid if we followed Crockford's substitution rules+                          , ("symbols", "00041061050.3gg28a1_60t3gf")+                          , ("wrong_alphabet", "ooooooiiiiiiuuuuuuulllllll") ]+    describe "can detect invalid suffix" do+      forM_ invalidSuffixes \(reason, suffix) -> it reason do+        case string2ID @TypeIDV5 suffix of+          Left _    -> pure ()+          Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid++  describe "Parse special values" do+    let specialValues = [ ("nil", "00000000000000000000000000", "00000000-0000-0000-0000-000000000000")+                        , ("one", "00000000000000000000000001", "00000000-0000-0000-0000-000000000001")+                        , ("ten", "0000000000000000000000000a", "00000000-0000-0000-0000-00000000000a")+                        , ("sixteen", "0000000000000000000000000g", "00000000-0000-0000-0000-000000000010")+                        , ("thirty-two", "00000000000000000000000010", "00000000-0000-0000-0000-000000000020") ]+    forM_ specialValues \(reason, tid, uuid) -> it reason do+      case string2ID @TypeIDV5 tid of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> show (getUUID tid) `shouldBe` uuid++  describe "TypeIDV5 valid JSON instances" do+    it "Decode and then encode should be identity" do+      tid  <- genID @TypeIDV5 "mmzk" uuid [11, 45, 14]+      tid' <- genID @TypeIDV5 "foo" uuid [11, 45, 14]+      let mapping = M.fromList [(tid, tid')]+      let json    = encode mapping+      decode json `shouldBe` Just mapping+      fmap encode (decode @(Map TypeIDV5 TypeIDV5) json) `shouldBe` Just json+    describe "Valid JSON value" do+      forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do+        case decode @TypeIDV5 (fromString $ show tid) of+          Nothing  -> expectationFailure "Parse JSON failed!"+          Just tid -> do+            getPrefix tid `shouldBe` prefix+            show (getUUID tid) `shouldBe` uuid+    describe "Valid JSON key" do+      forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do+        case decode @(Map TypeIDV5 Int) (fromString $ "{" ++ show tid ++ ":" ++ "114514" ++ "}") of+          Nothing      -> expectationFailure "Parse JSON failed!"+          Just mapping -> do+            let (tid, _) = M.elemAt 0 mapping+            getPrefix tid `shouldBe` prefix+            show (getUUID tid) `shouldBe` uuid++  describe "TypeIDV5 invalid JSON instances" do+    describe "Invalid JSON value" do+      forM_ invalid \(TestData name tid _ _) -> it name do+        case decode @TypeIDV5 (fromString $ show tid) of+          Nothing  -> pure ()+          Just tid -> expectationFailure $ "Parsed TypeID: " ++ show tid+    describe "Invalid JSON key" do+      forM_ invalid \(TestData name tid _ _) -> it name do+        case decode @(Map TypeIDV5 Int) (fromString $ "{" ++ show tid ++ ":" ++ "114514" ++ "}") of+          Nothing  -> pure ()+          Just tid -> expectationFailure "Invalid TypeID key shouldn't be parsed!"++  describe "Test invalid.json" do+    forM_ invalid \(TestData name tid _ _) -> it name do+      case string2ID @TypeIDV5 tid of+        Left _    -> pure ()+        Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid++  describe "Test valid.json (TypeIDV5 as literal)" do+    forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do+      case string2ID @TypeIDV5 tid of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> do+          getPrefix tid `shouldBe` prefix+          show (getUUID tid) `shouldBe` uuid++  describe "Test valid.json (TypeIDV5 as JSON)" do+    forM_ validUUID \(TestDataUUID name tid prefix uuid) -> it name do+      getPrefix tid `shouldBe` prefix+      getUUID tid `shouldBe` uuid++  describe "Generate KindIDV5 with 'Symbol' prefixes" do+    it "can generate KindIDV5 with prefix" do+      kid <- withCheck $ genID @(KindIDV5 "mmzk") uuid [11, 45, 14]+      getPrefix kid `shouldBe` "mmzk"+    it "can generate KindIDV5 without prefix" do+      kid <- withCheck $ genID @(KindIDV5 "") uuid [11, 45, 14]+      getPrefix kid `shouldBe` ""+    it "can parse KindID from String" do+      case string2ID @(KindIDV5 "mmzk") "mmzk_5hjpeh96458fct8t49fnf9farw" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right kid -> getPrefix kid `shouldBe` "mmzk"+    it "cannot parse KindID into wrong prefix" do+      case string2ID @(KindIDV5 "foo") "mmzk_5hjpeh96458fct8t49fnf9farw" of+        Left err  -> pure ()+        Right kid -> expectationFailure $ "Parsed TypeID: " ++ show kid++  describe "Generate KindIDV5 with custom data kind prefixes" do+    it "can generate KindIDV5 with prefix" do+        kid <- withCheck $ genID @(KindID 'Post)+        getPrefix kid `shouldBe` "post"+    it "can parse KindIDV5 from String" do+      case string2ID @(KindIDV5 'User) "user_00041061050r3gg28a1c60t3gf" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right kid -> getPrefix kid `shouldBe` "user"+    it "cannot parse KindIDV5 into wrong prefix" do+      case string2ID @(KindIDV5 'Comment) "user_00041061050r3gg28a1c60t3gf" of+        Left err  -> pure ()+        Right kid -> expectationFailure $ "Parsed KindIDV5: " ++ show kid++  describe "Binary instance for TypeIDV5 and KindIDV5" do+    it "has correct binary instance for TypeIDV5" do+      tids <- withChecks $ genIDs @TypeIDV5 "abcdefghijklmnopqrstuvwxyz" uuid [11, 45, 14] 114+      forM_ tids \tid -> do+        let bytes = runPut (put tid)+        let tid'  = runGet get bytes+        tid' `shouldBe` tid+    it "has correct binary instance for KindIDV5" do+      kids <- withChecks $ genIDs @(KindIDV5 "abcdefghijklmnopqrstuvwxyz") uuid [11, 45, 14] 114+      forM_ kids \kid -> do+        let bytes = runPut (put kid)+        let kid'  = runGet get bytes+        kid' `shouldBe` kid++  describe "Storable instance for TypeIDV5 and KindIDV5" do+    it "has correct Storable instance for TypeIDV5" do+      tids <- withChecks $ genIDs @TypeIDV5 "abcdefghijklmnopqrstuvwxyz" uuid [11, 45, 14] 114+      forM_ tids \tid -> do+        ptr   <- new tid+        tid'  <- peek ptr+        tid' `shouldBe` tid+        poke ptr tid'+        tid'' <- peek ptr+        tid'' `shouldBe` tid'+        free ptr+    it "has correct Storable instance for KindIDV5" do+      kids <- withChecks $ genIDs @(KindIDV5 "abcdefghijklmnopqrstuvwxyz") uuid [11, 45, 14] 114       forM_ kids \kid -> do         ptr   <- new kid         kid'  <- peek ptr