mmzk-typeid 0.3.1.0 → 0.4.0.0

raw patch · 23 files changed

+2139/−494 lines, 23 filesdep +randomdep +uuidPVP ok

version bump matches the API change (PVP)

Dependencies added: random, uuid

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +225/−0
• mmzk-typeid.cabal +30/−4
• src/Data/KindID.hs +6/−3
• src/Data/KindID/Class.hs +0/−1
• src/Data/KindID/Internal.hs +176/−121
• src/Data/KindID/Unsafe.hs +4/−1
• src/Data/KindID/V4.hs +178/−0
• src/Data/KindID/V4/Unsafe.hs +69/−0
• src/Data/KindID/V7.hs +208/−0
• src/Data/KindID/V7/Unsafe.hs +69/−0
• src/Data/TypeID.hs +6/−3
• src/Data/TypeID/Class.hs +30/−6
• src/Data/TypeID/Error.hs +1/−1
• src/Data/TypeID/Internal.hs +226/−146
• src/Data/TypeID/Unsafe.hs +4/−1
• src/Data/TypeID/V4.hs +146/−0
• src/Data/TypeID/V4/Unsafe.hs +59/−0
• src/Data/TypeID/V7.hs +175/−0
• src/Data/TypeID/V7/Unsafe.hs +74/−0
• src/Data/UUID/V7.hs +3/−5
• src/Data/UUID/Versions.hs +40/−0
• test/Spec.hs +391/−202

@@ -1,6 +1,25 @@ # Revision history for mmzk-typeid  +## 0.4.0.0 -- 2023-08-08++* Support `TypeID` and `KindID` with `UUID` suffixes of version 4.+  * They are exported in `Data.TypeID.V4` and `Data.KindID.V4`.+  * By default, `TypeID` and `KindID` has a `UUID` suffix of version 7.+  * The default `TypeID` and `KindID` is also exported via `Data.TypeID.V7` and+    `Data.KindID.V7`.+  * The constructor shapes have been changed, but it should not cause any+    problems since they are not exported.++* Remove deprecated `nil` functions.++* Provide some default implementations for methods of `IDConv`.++* Fix typoes in the Haddock.+  +* Tests for V4 `TypeID` and `KindID`.++ ## 0.3.1.0 -- 2023-07-23  * Add `parseStringM`, `parseTextM`, and `parseByteStringM` to `IDConv`.

@@ -0,0 +1,225 @@+# mmzk-typeid++## Introduction++A [TypeID](https://github.com/jetpack-io/typeid) implementation in Haskell. It is a "type-safe, K-sortable, globally unique identifier" extended on top of UUIDv7.++TypeIDs are canonically encoded as lowercase strings consisting of three parts:++1. A type prefix (at most 63 characters in all lowercase ASCII [a-z]);+2. An underscore '_' separator;+3. A 128-bit UUIDv7 encoded as a 26-character string using a modified base32 encoding.++For more information, please check out the [specification](https://github.com/jetpack-io/typeid/blob/main/README.md).++It also serves as a (temporary) UUIDv7 implementation in Haskell, since there are no official ones yet.++If you notice any issues or have any suggestions, please feel free to open an issue or contact me via email.++## Highlights++In addition to the features provided by [TypeID](https://github.com/jetpack-io/typeid), this implementation also supports:++1. Generating TypeIDs in a batch. They are guaranteed to have the same timestamp (up to the first 32768 ids) and of ascending order;+2. Encoding the prefix in the [type level](src/Data/KindID.hs), so that if you accidentally pass in a wrong prefix, the code won't compile, avoiding the need for runtime checks.+3. Support TypeID with other UUID versions. Currently v7 (default) and v4 are supported.++## Quick start++```Haskell+{-# LANGUAGE OverloadedStrings #-}++import           Control.Exception+import           Data.TypeID (TypeID)+import qualified Data.TypeID as TID++main :: IO ()+main = do++  -- Make a TypeID with prefix 'mmzk':+  typeID <- TID.genTypeID "mmzk"+  putStrLn $ TID.toString typeID++  -- Get components from the TypeID:+  let prefix = TID.getPrefix typeID -- "mmzk"+      uuid   = TID.getUUID typeID+      time   = TID.getTime typeID -- A 'Word64' representing the timestamp in milliseconds++  -- Make a TypeID without prefix:+  typeID' <- TID.genTypeID ""+  print typeID'++  -- Make 10 TypeIDs in a batch. They are guaranteed to have the same timestamp and of ascending order:+  typeIDs <- TID.genTypeIDs "mmzk" 10+  mapM_ print typeIDs++  -- Parse a TypeID from string:+  case TID.parseString "mmzk_01h455vb4pex5vsknk084sn02q" of+    Left err     -> throwIO err+    Right typeID -> print typeID+```++For a full list of functions on `TypeID`, see [Data.TypeID](src/Data/TypeID.hs).++## More Usages++### V4 TypeID++We also support TypeID using UUIDv4, which loses the monoticity property. To use it, simply import `Data.TypeID.V4` instead of `Data.TypeID`.++```Haskell+{-# LANGUAGE OverloadedStrings #-}++import           Control.Exception+import           Data.TypeIDV4 (TypeIDV4)+import qualified Data.TypeIDV4 as TID++main :: IO ()+main = do++  -- Make a TypeID with prefix 'mmzk':+  typeID <- TID.genTypeID "mmzk"+  putStrLn $ TID.toString typeID++  -- Get components from the TypeID:+  let prefix = TID.getPrefix typeID -- "mmzk"+      uuid   = TID.getUUID typeID++  -- Make a TypeID without prefix:+  typeID' <- TID.genTypeID ""+  print typeID'++  -- Parse a TypeID from string:+  case TID.parseString "mmzk_5hjpeh96458fct8t49fnf9farw" of+    Left err     -> throwIO err+    Right typeID -> print typeID+```++### Type-level TypeID (KindID)+When using `TypeID`, if we want to check if the type matches, we usually need to get the prefix of the `TypeID` and compare it with the desired prefix at runtime. However, with Haskell's type system, we can do this at compile time instead. We call this TypeID with compile-time prefix a KindID.++Of course, that would require the desired prefix to be known at compile time. This is actually quite common, especially when we are using one prefix for one table in the database.++For example, suppose we have a function that takes a KindID with the prefix "user", it may have a signature like this: `f :: KindID "user" -> IO ()`.++Then if we try to pass in a KindID with the prefix "post", the compiler will complain, thus removing the runtime check and the associated overhead.++All the prefixes are type-checked at compile time, so if we try to pass in invalid prefixes, the compiler (again) will complain.++```Haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++import           Control.Exception+import           Data.KindID (KindID)+import qualified Data.KindID as KID++main :: IO ()+main = do++  -- Make a KindID with prefix 'mmzk':+  kindID <- KID.genKindID @"mmzk" -- Has type `KindID "mmzk"`+  putStrLn $ KID.toString kindID++  -- Get components from the KindID:+  let prefix = KID.getPrefix kindID -- "mmzk"+      uuid   = KID.getUUID kindID+      time   = KID.getTime kindID -- A 'Word64' representing the timestamp in milliseconds++  -- Make a KindID without prefix:+  kindID' <- KID.genKindID @"" -- Has type `KindID ""`+  print kindID'++  -- Make 10 KindIDs in a batch. They are guaranteed to have the same timestamp and of ascending order:+  kindIDs <- KID.genKindIDs @"mmzk" 10+  mapM_ print kindIDs++  -- Parse a KindID from string:+  case KID.parseString @"mmzk" "mmzk_01h455vb4pex5vsknk084sn02q" of+    Left err     -> throwIO err+    Right kindID -> print kindID+```++For a full list of functions on `KindID`, see [Data.KindID](src/Data/KindID.hs).++### Functions with More General Types+`TypeID` and `KindID` shares many functions with the same name and functionality. So far, we are using qualified imports to diffentiate them (*e.g* `KID.fromString` and `TID.fromString`). Alternatively, we can use the methods of `IDConv` to use the same functions for both `TypeID` and `KindID`.++```Haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplication #-}++import           Control.Exception+import           Data.KindID+import           Data.TypeID++main :: IO ()+main = do+  -- Make a TypeID with prefix 'mmzk':+  typeID <- genID @TypeID "mmzk"+  print typeID++  -- Make a KindID with prefix 'mmzk':+  kindID <- genID @(KindID "mmzk")+  print kindID++  -- Parse a TypeID from string:+  case string2ID "mmzk_01h455vb4pex5vsknk084sn02q" :: Maybe TypeID of+    Left err     -> throwIO err+    Right typeID -> print typeID++  -- Parse a KindID from string:+  case string2ID "mmzk_01h455vb4pex5vsknk084sn02q" :: Maybe (KindID "mmzk") of+    Left err     -> throwIO err+    Right kindID -> print kindID+```++We no longer need to use qualified imports, but on the down side, we need to add explicit type annotations. Therefore it is a matter of preference.++Note that with the class methods, the type application with `Symbol` no longer works as the full type must be provided. For example, `string2ID @"mmzk" "mmzk_01h455vb4pex5vsknk084sn02q"` will not compile.++For a full list of these functions, see [Data.TypeID.Class](src/Data/TypeID/Class.hs).++### KindID with Data Kinds+Instead of using raw `Symbol`s as `KindID` prefixes, we can also define our custom data type for better semantics.++For example, suppose we have three tables for users, posts, and comments, and each table has a unique prefix, we can design the structure as following:++```Haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++import           Data.KindID+import           Data.KindID.Class++data Prefix = User | Post | Comment++instance ToPrefix 'User where+  type PrefixSymbol 'User = "user"++instance ToPrefix 'Post where+  type PrefixSymbol 'Post = "post"++instance ToPrefix 'Comment where+  type PrefixSymbol 'Comment = "comment"+```++Now we can use `Prefix` as a prefix for `KindID`s, e.g.++```Haskell+main :: IO ()+main = do+  -- ...+  userID <- genKindID @'User -- Same as genKindID @"user"+  postID <- genKindID @'Post -- Same as genKindID @"post"+  commentID <- genKindID @'Comment -- Same as genKindID @"comment"+  -- ...+```++For more information, see [Data.KindID.Class](src/Data/KindID/Class.hs).++## Note+Not explicitly exported functions are considered internal and are subjected to changes.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               mmzk-typeid-version:            0.3.1.0+version:            0.4.0.0  synopsis:           A TypeID implementation for Haskell description:@@ -27,7 +27,6 @@   .   > {-# LANGUAGE OverloadedStrings #-}   .-  For a quick "how-to-use" guide, please refer to the README.md file at https://github.com/MMZK1526/mmzk-typeid#readme.  homepage:           https://github.com/MMZK1526/mmzk-typeid bug-reports:        https://github.com/MMZK1526/mmzk-typeid/issues@@ -41,6 +40,7 @@ extra-source-files:     CHANGELOG.md     LICENSE+    README.md     test/invalid.json     test/valid.json @@ -50,11 +50,20 @@         Data.KindID,         Data.KindID.Class,         Data.KindID.Unsafe,+        Data.KindID.V4,+        Data.KindID.V4.Unsafe,+        Data.KindID.V7,+        Data.KindID.V7.Unsafe,         Data.TypeID,         Data.TypeID.Class,         Data.TypeID.Error,         Data.TypeID.Unsafe,-        Data.UUID.V7+        Data.TypeID.V4,+        Data.TypeID.V4.Unsafe,+        Data.TypeID.V7,+        Data.TypeID.V7.Unsafe,+        Data.UUID.V7,+        Data.UUID.Versions     other-modules:         Data.KindID.Internal,         Data.TypeID.Internal@@ -62,6 +71,8 @@         BlockArguments         ConstraintKinds         DataKinds+        FlexibleContexts+        FlexibleInstances         InstanceSigs         MultiWayIf         OverloadedStrings@@ -79,8 +90,10 @@         bytestring ^>= 0.11,         entropy ^>=0.4,         hashable ^>=1.4,+        random ^>=1.2,         text ^>=2.0,         time >=1.11 && <1.13,+        uuid ^>=1.3,         uuid-types ^>=1.0,     hs-source-dirs:   src     default-language: Haskell2010@@ -94,16 +107,27 @@         Data.KindID.Class,         Data.KindID.Internal,         Data.KindID.Unsafe,+        Data.KindID.V4,+        Data.KindID.V4.Unsafe,+        Data.KindID.V7,+        Data.KindID.V7.Unsafe,         Data.TypeID,         Data.TypeID.Class,         Data.TypeID.Error,         Data.TypeID.Internal,         Data.TypeID.Unsafe,-        Data.UUID.V7+        Data.TypeID.V4,+        Data.TypeID.V4.Unsafe,+        Data.TypeID.V7,+        Data.TypeID.V7.Unsafe,+        Data.UUID.V7,+        Data.UUID.Versions     default-extensions:         BlockArguments         ConstraintKinds         DataKinds+        FlexibleContexts+        FlexibleInstances         InstanceSigs         MultiWayIf         OverloadedStrings@@ -123,8 +147,10 @@         entropy,         hashable,         hspec ^>=2.11,+        random,         text,         time,+        uuid,         uuid-types,     hs-source-dirs:         src

@@ -34,15 +34,17 @@ -- >   kindID <- genKindID @"user" -- >   ... --+-- It is a re-export of "Data.KindID.V7".+-- module Data.KindID   (   -- * Data types     KindID+  , KindID'   , getPrefix   , getUUID   , getTime   -- * 'KindID' generation ('KindID'-specific)-  , nilKindID   , genKindID   , genKindID'   , genKindIDs@@ -83,6 +85,7 @@   , fromTypeID   ) where -import           Data.KindID.Internal+import           Data.KindID.Internal (KindID')+import           Data.KindID.V7 import           Data.TypeID.Class-import           Data.TypeID.Internal (TypeID)+import           Data.TypeID.V7 (TypeID)

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}  -- |

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}  -- |@@ -21,29 +20,33 @@ import qualified Data.Text as T import           Data.TypeID.Class import           Data.TypeID.Error-import           Data.TypeID.Internal (TypeID)+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.V4 as V4 import qualified Data.UUID.V7 as V7+import           Data.UUID.Versions import           Foreign import           GHC.TypeLits (symbolVal)+import           System.Random  -- | A TypeID with the prefix encoded at type level. ----- It is dubbed 'KindID' because we the prefix here is a data kind rather than--- a type.-newtype KindID prefix = KindID { _getUUID :: UUID }+-- It is dubbed 'Data.KindID.V7.KindID' because the prefix here is a data kind+-- rather than a type.+newtype KindID' (version :: UUIDVersion) prefix = KindID' UUID   deriving (Eq, Ord)  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => Show (KindID prefix) where-    show :: KindID prefix -> String+  => Show (KindID' version prefix) where+    show :: KindID' version prefix -> String     show = toString     {-# INLINE show #-}  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => Read (KindID prefix) where-    readsPrec :: Int -> String -> [(KindID prefix, String)]+  => Read (KindID' version prefix) where+    readsPrec :: Int -> String -> [(KindID' version prefix, String)]     readsPrec _ str = case TID.parseStringS str of       Left _           -> []       Right (tid, rem) -> case fromTypeID tid of@@ -52,14 +55,14 @@     {-# INLINE readsPrec #-}  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => ToJSON (KindID prefix) where-    toJSON :: KindID prefix -> Value+  => ToJSON (KindID' version prefix) where+    toJSON :: KindID' version prefix -> Value     toJSON = toJSON . toText     {-# INLINE toJSON #-}  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => FromJSON (KindID prefix) where-    parseJSON :: Value -> Parser (KindID prefix)+  => FromJSON (KindID' version prefix) where+    parseJSON :: Value -> Parser (KindID' version prefix)     parseJSON str = do       s <- parseJSON str       case parseText s of@@ -68,29 +71,29 @@     {-# INLINE parseJSON #-}  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => ToJSONKey (KindID prefix) where-    toJSONKey :: ToJSONKeyFunction (KindID prefix)+  => ToJSONKey (KindID' version prefix) where+    toJSONKey :: ToJSONKeyFunction (KindID' version prefix)     toJSONKey = toJSONKeyText toText     {-# INLINE toJSONKey #-}  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => FromJSONKey (KindID prefix) where-    fromJSONKey :: FromJSONKeyFunction (KindID prefix)+  => FromJSONKey (KindID' version prefix) where+    fromJSONKey :: FromJSONKeyFunction (KindID' version prefix)     fromJSONKey = FromJSONKeyTextParser \t -> case parseText t of       Left err  -> fail $ show err       Right kid -> pure kid     {-# INLINE fromJSONKey #-} --- | See The 'Binary' instance of 'TypeID'.+-- | See The 'Binary' instance of 'TypeID''. instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => Binary (KindID prefix) where-    put :: KindID prefix -> Put+  => Binary (KindID' version prefix) where+    put :: KindID' version prefix -> Put     put = put . toTypeID     {-# INLINE put #-} -    get :: Get (KindID prefix)+    get :: Get (KindID' version prefix)     get = do-      tid <- get :: Get TypeID+      tid <- get :: Get (TypeID' version)       case fromTypeID tid of         Nothing  -> fail "Binary: Prefix mismatch"         Just kid -> pure kid@@ -98,202 +101,246 @@  -- | Similar to the 'Binary' instance, but the 'UUID' is stored in host endian. instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => Storable (KindID prefix) where-    sizeOf :: KindID prefix -> Int+  => Storable (KindID' version prefix) where+    sizeOf :: KindID' version prefix -> Int     sizeOf = sizeOf . toTypeID     {-# INLINE sizeOf #-} -    alignment :: KindID prefix -> Int+    alignment :: KindID' version prefix -> Int     alignment = alignment . toTypeID     {-# INLINE alignment #-} -    peek :: Ptr (KindID prefix) -> IO (KindID prefix)+    peek :: Ptr (KindID' version prefix) -> IO (KindID' version prefix)     peek ptr = do-      tid <- peek $ castPtr ptr :: IO TypeID+      tid <- peek $ castPtr ptr :: IO (TypeID' version)       case fromTypeID tid of         Nothing  -> fail "Storable: Prefix mismatch"         Just kid -> pure kid     {-# INLINE peek #-} -    poke :: Ptr (KindID prefix) -> KindID prefix -> IO ()+    poke :: Ptr (KindID' version prefix) -> KindID' version prefix -> IO ()     poke ptr = poke (castPtr ptr) . toTypeID     {-# INLINE poke #-}  instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => Hashable (KindID prefix) where-    hashWithSalt :: Int -> KindID prefix -> Int+  => Hashable (KindID' version prefix) where+    hashWithSalt :: Int -> KindID' version prefix -> Int     hashWithSalt salt = hashWithSalt salt . toTypeID     {-# INLINE hashWithSalt #-} --- | Get the prefix, 'UUID', and timestamp of a 'KindID'.+-- | Get the prefix, 'UUID', and timestamp of a 'KindID''. instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => IDType (KindID prefix) where-    getPrefix :: KindID prefix -> Text+  => IDType (KindID' version prefix) where+    getPrefix :: KindID' version prefix -> Text     getPrefix _ = T.pack (symbolVal (Proxy @(PrefixSymbol prefix)))     {-# INLINE getPrefix #-} -    getUUID :: KindID prefix -> UUID-    getUUID = _getUUID+    getUUID :: KindID' version prefix -> UUID+    getUUID (KindID' uuid) = uuid     {-# INLINE getUUID #-} -    getTime :: KindID prefix -> Word64+    getTime :: KindID' version prefix -> Word64     getTime = V7.getTime . getUUID     {-# INLINE getTime #-} --- | Conversion between 'KindID' and 'String'/'Text'/'ByteString'.+-- | Conversion between 'KindID'' and 'String'/'Text'/'ByteString'. instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => IDConv (KindID prefix) where-    string2ID :: String -> Either TypeIDError (KindID prefix)+  => IDConv (KindID' version prefix) where+    string2ID :: String -> Either TypeIDError (KindID' version prefix)     string2ID = parseString     {-# INLINE string2ID #-} -    text2ID :: Text -> Either TypeIDError (KindID prefix)+    text2ID :: Text -> Either TypeIDError (KindID' version prefix)     text2ID = parseText     {-# INLINE text2ID #-} -    byteString2ID :: ByteString -> Either TypeIDError (KindID prefix)+    byteString2ID :: ByteString -> Either TypeIDError (KindID' version prefix)     byteString2ID = parseByteString     {-# INLINE byteString2ID #-} -    id2String :: KindID prefix -> String+    id2String :: KindID' version prefix -> String     id2String = toString     {-# INLINE id2String #-} -    id2Text :: KindID prefix -> Text+    id2Text :: KindID' version prefix -> Text     id2Text = toText     {-# INLINE id2Text #-} -    id2ByteString :: KindID prefix -> ByteString+    id2ByteString :: KindID' version prefix -> ByteString     id2ByteString = toByteString     {-# INLINE id2ByteString #-} -    unsafeString2ID :: String -> KindID prefix+    unsafeString2ID :: String -> KindID' version prefix     unsafeString2ID = unsafeParseString     {-# INLINE unsafeString2ID #-} -    unsafeText2ID :: Text -> KindID prefix+    unsafeText2ID :: Text -> KindID' version prefix     unsafeText2ID = unsafeParseText     {-# INLINE unsafeText2ID #-} -    unsafeByteString2ID :: ByteString -> KindID prefix+    unsafeByteString2ID :: ByteString -> KindID' version prefix     unsafeByteString2ID = unsafeParseByteString     {-# INLINE unsafeByteString2ID #-} --- | Generate 'KindID's.+-- | Generate 'Data.KindID.V7.KindID's. instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-  => IDGen (KindID prefix) where-    type IDGenPrefix (KindID prefix) = 'Nothing+  => IDGen (KindID' 'V7 prefix) where+    type IDGenPrefix (KindID' 'V7 prefix) = 'Nothing -    genID_ :: MonadIO m => Proxy (KindID prefix) -> m (KindID prefix)+    genID_ :: MonadIO m => Proxy (KindID' 'V7 prefix) -> m (KindID' 'V7 prefix)     genID_ _ = genKindID     {-# INLINE genID_ #-} -    genID'_ :: MonadIO m => Proxy (KindID prefix) -> m (KindID prefix)+    genID'_ :: MonadIO m => Proxy (KindID' 'V7 prefix) -> m (KindID' 'V7 prefix)     genID'_ _ = genKindID'     {-# INLINE genID'_ #-} -    genIDs_ :: MonadIO m => Proxy (KindID prefix) -> Word16 -> m [KindID prefix]+    genIDs_ :: MonadIO m+            => Proxy (KindID' 'V7 prefix) -> Word16 -> m [KindID' 'V7 prefix]     genIDs_ _ = genKindIDs     {-# INLINE genIDs_ #-} -    decorate_ :: Proxy (KindID prefix) -> UUID -> KindID prefix+    decorate_ :: Proxy (KindID' 'V7 prefix) -> UUID -> KindID' 'V7 prefix     decorate_ _ = decorateKindID     {-# INLINE decorate_ #-} -    checkID_ :: Proxy (KindID prefix) -> KindID prefix -> Maybe TypeIDError+    checkID_ :: Proxy (KindID' 'V7 prefix)+             -> KindID' 'V7 prefix+             -> Maybe TypeIDError     checkID_ _ = checkKindID     {-# INLINE checkID_ #-}      checkIDWithEnv_ :: MonadIO m-                    => Proxy (KindID prefix)-                    -> KindID prefix+                    => Proxy (KindID' 'V7 prefix)+                    -> KindID' 'V7 prefix                     -> m (Maybe TypeIDError)     checkIDWithEnv_ _ = checkKindIDWithEnv     {-# INLINE checkIDWithEnv_ #-} --- | Generate a new 'KindID' from a prefix.+-- | Generate 'KindID'' ''V4's.+instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+  => IDGen (KindID' 'V4 prefix) where+    type IDGenPrefix (KindID' 'V4 prefix) = 'Nothing++    genID_ :: MonadIO m => Proxy (KindID' 'V4 prefix) -> m (KindID' 'V4 prefix)+    genID_ _ = genKindIDV4+    {-# INLINE genID_ #-}++    genID'_ :: MonadIO m => Proxy (KindID' 'V4 prefix) -> m (KindID' 'V4 prefix)+    genID'_ _ = genKindIDV4'+    {-# INLINE genID'_ #-}++    genIDs_ :: MonadIO m+            => Proxy (KindID' 'V4 prefix) -> Word16 -> m [KindID' 'V4 prefix]+    genIDs_ _ n+      = fmap KindID' <$> replicateM (fromIntegral n) (liftIO V4.nextRandom)+    {-# INLINE genIDs_ #-}++    decorate_ :: Proxy (KindID' 'V4 prefix) -> UUID -> KindID' 'V4 prefix+    decorate_ _ = decorateKindID+    {-# INLINE decorate_ #-}++    checkID_ :: Proxy (KindID' 'V4 prefix)+             -> KindID' 'V4 prefix+             -> Maybe TypeIDError+    checkID_ _ = checkKindIDV4+    {-# 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)-          => m (KindID prefix)-genKindID = KindID <$> V7.genUUID+          => m (KindID' 'V7 prefix)+genKindID = KindID' <$> V7.genUUID {-# INLINE genKindID #-} --- | Generate a new 'KindID' from a prefix based on statelesss 'UUID'v7.+-- | 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)-           => m (KindID prefix)-genKindID' = KindID <$> V7.genUUID'+           => m (KindID' 'V7 prefix)+genKindID' = KindID' <$> V7.genUUID' {-# INLINE genKindID' #-} --- | Generate a list of 'KindID's from a prefix.+-- | Generate a list of 'Data.KindID.V7.KindID's from a prefix. ----- It tries its best to generate 'KindID's at the same timestamp, but it may not--- be possible if we are asking too many 'UUID's at the same time.+-- It tries its best to generate 'Data.KindID.V7.KindID'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 'KindID's are generated at the same--- timestamp.+-- 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)-           => Word16 -> m [KindID prefix]-genKindIDs n = fmap KindID <$> V7.genUUIDs n+           => Word16 -> m [KindID' 'V7 prefix]+genKindIDs n = fmap KindID' <$> V7.genUUIDs n {-# INLINE genKindIDs #-} --- | The nil 'KindID'.-nilKindID :: KindID ""-nilKindID = KindID V7.nil-{-# INLINE nilKindID #-}-{-# DEPRECATED nilKindID "Will be removed in the next major release." #-}+-- | Generate a new 'KindID'' ''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.+genKindIDV4 :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+            => m (KindID' 'V4 prefix)+genKindIDV4 = KindID' <$> liftIO V4.nextRandom+{-# INLINE genKindIDV4 #-} --- | Obtain a 'KindID' from a prefix and a 'UUID'.+-- | Generate a new 'KindID'' ''V4' from a prefix with insecure 'UUID'v4.+genKindIDV4' :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+             => m (KindID' 'V4 prefix)+genKindIDV4' = KindID' <$> liftIO randomIO+{-# INLINE genKindIDV4' #-}++-- | Obtain a 'KindID'' from a prefix and a 'UUID'. decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-               => UUID -> KindID prefix-decorateKindID = KindID+               => UUID -> KindID' version prefix+decorateKindID = KindID' {-# INLINE decorateKindID #-} --- | Convert a 'KindID' to a 'TypeID'.+-- | Convert a 'KindID'' to a 'TypeID''. toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-         => KindID prefix -> TypeID-toTypeID kid = TID.TypeID (getPrefix kid) (getUUID kid)+         => KindID' version prefix -> TypeID' version+toTypeID kid = TID.TypeID' (getPrefix kid) (getUUID kid) {-# INLINE toTypeID #-} --- | Convert a 'TypeID' to a 'KindID'. If the actual prefix does not match+-- | Convert a 'TypeID'' to a 'KindID''. If the actual prefix does not match -- with the expected one as defined by the type, it returns @Nothing@.-fromTypeID :: forall prefix+fromTypeID :: forall version prefix             . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-           => TypeID -> Maybe (KindID prefix)+           => TypeID' version -> Maybe (KindID' version prefix) fromTypeID tid = do   guard (T.pack (symbolVal (Proxy @(PrefixSymbol prefix))) == getPrefix tid)-  pure $ KindID (getUUID tid)+  pure $ KindID' (getUUID tid) {-# INLINE fromTypeID #-} --- | Pretty-print a 'KindID'. It is 'id2String' with concrete type.+-- | Pretty-print a 'KindID''. It is 'id2String' with concrete type. toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-         => KindID prefix -> String+         => KindID' version prefix -> String toString = TID.toString . toTypeID {-# INLINE toString #-} --- | Pretty-print a 'KindID' to strict 'Text'. It is 'id2Text' with concrete+-- | Pretty-print a 'KindID'' to strict 'Text'. It is 'id2Text' with concrete -- type. toText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-       => KindID prefix -> Text+       => KindID' version prefix -> Text toText = TID.toText . toTypeID {-# INLINE toText #-} --- | Pretty-print a 'KindID' to lazy 'ByteString'. It is 'id2ByteString' with+-- | Pretty-print a 'KindID'' to lazy 'ByteString'. It is 'id2ByteString' with -- concrete type. toByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-             => KindID prefix -> ByteString+             => KindID' version prefix -> ByteString toByteString = TID.toByteString . toTypeID {-# INLINE toByteString #-} --- | Parse a 'KindID' from its 'String' representation. It is 'parseString'+-- | Parse a 'KindID'' from its 'String' representation. It is 'parseString' -- with concrete type.-parseString :: forall prefix+parseString :: forall version prefix              . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-            => String -> Either TypeIDError (KindID prefix)+            => String -> Either TypeIDError (KindID' version prefix) parseString str = do   tid <- TID.parseString str   case fromTypeID tid of@@ -303,10 +350,11 @@     Just kid -> pure kid {-# INLINE parseString #-} --- | Parse a 'KindID' from its string representation as a strict 'Text'. It is+-- | Parse a 'KindID'' 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 (KindID prefix)+parseText :: forall version prefix+           . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+          => Text -> Either TypeIDError (KindID' version prefix) parseText str = do   tid <- TID.parseText str   case fromTypeID tid of@@ -316,11 +364,11 @@     Just kid -> pure kid {-# INLINE parseText #-} --- | Parse a 'KindID' from its string representation as a lazy 'ByteString'. It+-- | Parse a 'KindID'' from its string representation as a lazy 'ByteString'. It -- is 'parseByteString' with concrete type.-parseByteString :: forall prefix+parseByteString :: forall version prefix                  . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-                => ByteString -> Either TypeIDError (KindID prefix)+                => ByteString -> Either TypeIDError (KindID' version prefix) parseByteString str = do   tid <- TID.parseByteString str   case fromTypeID tid of@@ -330,36 +378,36 @@     Just kid -> pure kid {-# INLINE parseByteString #-} --- | Parse a 'KindID' from its 'String' representation, throwing an error when+-- | Parse a 'KindID'' 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 (KindID prefix)+             => String -> m (KindID' version prefix) parseStringM = string2IDM {-# INLINE parseStringM #-} --- | Parse a 'KindID' from its string representation as a strict 'Text',+-- | Parse a 'KindID'' from its string representation as a strict 'Text', -- throwing an error when the parsing fails. It is 'text2IDM' with concrete -- type. parseTextM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)-           => Text -> m (KindID prefix)+           => Text -> m (KindID' version prefix) parseTextM = text2IDM {-# INLINE parseTextM #-} --- | Parse a 'KindID' from its string representation as a lazy 'ByteString',+-- | Parse a 'KindID'' from its string representation as a lazy 'ByteString', -- throwing an error when the parsing fails. It is 'byteString2IDM' with -- concrete type. parseByteStringM :: ( ToPrefix prefix                     , ValidPrefix (PrefixSymbol prefix)                     , MonadIO m )                  => ByteString-                 -> m (KindID prefix)+                 -> m (KindID' version prefix) parseByteStringM = byteString2IDM {-# INLINE parseByteStringM #-}  -- | Check if the prefix is valid and the suffix 'UUID' has the correct v7 -- version and variant. checkKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-            => KindID prefix -> Maybe TypeIDError+            => KindID' 'V7 prefix -> Maybe TypeIDError checkKindID = TID.checkTypeID . toTypeID {-# INLINE checkKindID #-} @@ -368,44 +416,51 @@ checkKindIDWithEnv :: ( ToPrefix prefix                       , ValidPrefix (PrefixSymbol prefix)                       , MonadIO m )-                   => KindID prefix -> m (Maybe TypeIDError)+                   => KindID' 'V7 prefix -> m (Maybe TypeIDError) checkKindIDWithEnv = TID.checkTypeIDWithEnv . toTypeID {-# INLINE checkKindIDWithEnv #-} --- | Convert a 'TypeID' to a 'KindID'. If the actual prefix does not match+-- | Check if the prefix is valid and the suffix 'UUID' has the correct v4+-- version and variant.+checkKindIDV4 :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+              => KindID' 'V4 prefix -> Maybe TypeIDError+checkKindIDV4 = TID.checkTypeIDV4 . toTypeID+{-# INLINE checkKindIDV4 #-}++-- | 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--- produces a wrong 'KindID'.+-- produces a wrong 'KindID''. unsafeFromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-                 => TypeID -> KindID prefix-unsafeFromTypeID tid = KindID (getUUID tid)+                 => TypeID' version -> KindID' version prefix+unsafeFromTypeID tid = KindID' (getUUID tid) {-# INLINE unsafeFromTypeID #-} --- | Parse a 'KindID' from its 'String' representation, but does not behave+-- | Parse a 'KindID'' 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 'KindID'. If there are other parse errors, it will crash.+-- produce the wrong 'KindID''. If there are other parse errors, it will crash. unsafeParseString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-                  => String -> KindID prefix+                  => String -> KindID' version prefix unsafeParseString = unsafeFromTypeID . TID.unsafeParseString {-# INLINE unsafeParseString #-} --- | Parse a 'KindID' from its string representation as a strict 'Text', but+-- | Parse a 'KindID'' 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 'KindID'. If there are other parse errors, it will crash.+-- produce the wrong 'KindID''. If there are other parse errors, it will crash. unsafeParseText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-                => Text -> KindID prefix+                => Text -> KindID' version prefix unsafeParseText = unsafeFromTypeID . TID.unsafeParseText {-# INLINE unsafeParseText #-} --- | Parse a 'KindID' from its string representation as a lazy 'ByteString', but+-- | Parse a 'KindID'' 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 'KindID'. If there are other parse errors, it will crash.+-- produce the wrong 'KindID''. If there are other parse errors, it will crash. unsafeParseByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))-                      => ByteString -> KindID prefix+                      => ByteString -> KindID' version prefix unsafeParseByteString = unsafeFromTypeID . TID.unsafeParseByteString {-# INLINE unsafeParseByteString #-}

@@ -6,6 +6,8 @@ -- -- Unsafe 'KindID' functions. --+-- It is a re-export of "Data.TypeID.V7.Unsafe".+-- module Data.KindID.Unsafe   (   -- * Unsafe 'KindID' decoding ('KindID'-specific)@@ -20,5 +22,6 @@   , unsafeFromTypeID   ) where -import           Data.KindID.Internal+import           Data.KindID.V7 (KindID)+import           Data.KindID.V7.Unsafe import           Data.TypeID.Class

@@ -0,0 +1,178 @@+-- |+-- Module      : Data.KindID.V4+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- 'Data.KindID.V7.KindID' with 'UUID'v4.+--+module Data.KindID.V4+  (+  -- * Data types+    KindIDV4+  , getPrefix+  , getUUID+  , getTime+  -- * 'KindIDV4' generation ('KindIDV4'-specific)+  , genKindID+  , genKindID'+  , decorateKindID+  -- * 'KindIDV4' generation (class methods)+  , genID+  , genID'+  , decorate+  -- * Validation ('KindIDV4'-specific)+  , checkKindID+  -- * Validation (class methods)+  , checkID+  -- * Encoding & decoding ('KindIDV4'-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.V4 (TypeIDV4)+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'v4.+type KindIDV4 = KID.KindID' 'V4++-- | Generate a new 'KindIDV4' 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)+          => m (KindIDV4 prefix)+genKindID = KID.genKindIDV4+{-# INLINE genKindID #-}++-- | Generate a new 'KindIDV4' from a prefix based on insecure 'UUID'v4.+genKindID' :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+           => m (KindIDV4 prefix)+genKindID' = KID.genKindIDV4'+{-# INLINE genKindID' #-}++-- | Obtain a 'KindIDV4' from a prefix and a 'UUID'.+decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+               => UUID -> KindIDV4 prefix+decorateKindID = KID.decorateKindID+{-# INLINE decorateKindID #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v4+-- version and variant.+checkKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+            => KindIDV4 prefix -> Maybe TypeIDError+checkKindID = KID.checkKindIDV4+{-# INLINE checkKindID #-}+++-- | Pretty-print a 'KindIDV4'. It is 'id2String' with concrete type.+toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+         => KindIDV4 prefix -> String+toString = KID.toString+{-# INLINE toString #-}++-- | Pretty-print a 'KindIDV4' to strict 'Text'. It is 'id2Text' with concrete+-- type.+toText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+       => KindIDV4 prefix -> Text+toText = KID.toText+{-# INLINE toText #-}++-- | Pretty-print a 'KindIDV4' to lazy 'ByteString'. It is 'id2ByteString' with+-- concrete type.+toByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+             => KindIDV4 prefix -> ByteString+toByteString = KID.toByteString+{-# INLINE toByteString #-}++-- | Parse a 'KindIDV4' from its 'String' representation. It is 'parseString'+-- with concrete type.+parseString :: forall prefix+             . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+            => String -> Either TypeIDError (KindIDV4 prefix)+parseString = KID.parseString+{-# INLINE parseString #-}++-- | Parse a 'KindIDV4' 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 (KindIDV4 prefix)+parseText = KID.parseText+{-# INLINE parseText #-}++-- | Parse a 'KindIDV4' 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 (KindIDV4 prefix)+parseByteString = KID.parseByteString++-- | Parse a 'KindIDV4' 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 (KindIDV4 prefix)+parseStringM = KID.parseStringM+{-# INLINE parseStringM #-}++-- | Parse a 'KindIDV4' 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 (KindIDV4 prefix)+parseTextM = KID.parseTextM+{-# INLINE parseTextM #-}++-- | Parse a 'KindIDV4' 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 (KindIDV4 prefix)+parseByteStringM = KID.parseByteStringM+{-# INLINE parseByteStringM #-}++-- | Convert a 'KindIDV4' to a 'Data.TypeID.V4.TypeIDV4'.+toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+         => KindIDV4 prefix -> TypeIDV4+toTypeID = KID.toTypeID+{-# INLINE toTypeID #-}++-- | Convert a 'TypeIDV4' to a 'KindIDV4'.+fromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+           => TypeIDV4 -> Maybe (KindIDV4 prefix)+fromTypeID = KID.fromTypeID+{-# INLINE fromTypeID #-}

@@ -0,0 +1,69 @@+-- |+-- Module      : Data.KindID.V4.Unsafe+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Unsafe 'KindIDV4' functions.+--+module Data.KindID.V4.Unsafe+  (+  -- * Unsafe 'KindIDV4' decoding ('KindIDV4'-specific)+    unsafeParseString+  , unsafeParseText+  , unsafeParseByteString+  -- * Unsafe 'KindIDV4' 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.V4 (KindIDV4)+import           Data.TypeID.Internal (TypeID')+import           Data.TypeID.V4 (TypeIDV4)+import           Data.Text (Text)+import           Data.TypeID.Class++-- | Parse a 'KindIDV4' 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 'KindIDV4'. If there are other parse errors, it will crash.+unsafeParseString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                  => String -> KindIDV4 prefix+unsafeParseString = KID.unsafeParseString+{-# INLINE unsafeParseString #-}++-- | Parse a 'KindIDV4' 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 'KindIDV4'. If there are other parse errors, it will crash.+unsafeParseText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                => Text -> KindIDV4 prefix+unsafeParseText = KID.unsafeParseText+{-# INLINE unsafeParseText #-}++-- | Parse a 'KindIDV4' 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 'KindIDV4'. If there are other parse errors, it will crash.+unsafeParseByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                      => ByteString -> KindIDV4 prefix+unsafeParseByteString = KID.unsafeParseByteString+{-# INLINE unsafeParseByteString #-}++-- | Convert a 'TypeIDV4' to a 'KindIDV4'. If the actual prefix does not match+-- with the expected one as defined by the type, it does not complain and+-- produces a wrong 'KindIDV4'.+unsafeFromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                 => TypeIDV4 -> KindIDV4 prefix+unsafeFromTypeID = KID.unsafeFromTypeID+{-# INLINE unsafeFromTypeID #-}

@@ -0,0 +1,208 @@+-- |+-- Module      : Data.KindID.V7+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Similar to "Data.TypeID", but the type is statically determined in the type+-- level.+--+module Data.KindID.V7+  (+  -- * Data types+    KindID+  , KindIDV7+  , getPrefix+  , getUUID+  , getTime+  -- * 'KindID' generation ('KindID'-specific)+  , genKindID+  , genKindID'+  , genKindIDs+  , decorateKindID+  -- * 'KindID' generation (class methods)+  , genID+  , genID'+  , genIDs+  , decorate+  -- * Validation ('KindID'-specific)+  , checkKindID+  , checkKindIDWithEnv+  -- * Validation (class methods)+  , checkID+  , checkIDWithEnv+  -- * Encoding & decoding ('KindID'-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.V7 (TypeID)+import           Data.UUID.Types.Internal (UUID)+import           Data.UUID.Versions+import           Data.Word++-- | A type alias for the default 'KindID' implementation with 'UUID'v7.+type KindID = KID.KindID' 'V7++-- | A type alias for 'KindID'.+type KindIDV7 = KindID++-- | Generate a new '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)+          => m (KindID prefix)+genKindID = KID.genKindID+{-# INLINE genKindID #-}++-- | Generate a new '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)+           => m (KindID prefix)+genKindID' = KID.genKindID'+{-# INLINE genKindID' #-}++-- | Generate a list of 'KindID's from a prefix.+--+-- It tries its best to generate 'KindID'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 'KindID's are generated at the same+-- timestamp.+genKindIDs :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)+           => Word16 -> m [KindID prefix]+genKindIDs = KID.genKindIDs+{-# INLINE genKindIDs #-}++-- | Obtain a 'KindID' from a prefix and a 'UUID'.+decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+               => UUID -> KindID prefix+decorateKindID = KID.decorateKindID+{-# INLINE decorateKindID #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v7+-- version and variant.+checkKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+            => KindID prefix -> Maybe TypeIDError+checkKindID = KID.checkKindID+{-# INLINE checkKindID #-}++-- | Similar to 'checkKindID', but also checks if the suffix 'UUID' is+-- generated in the past.+checkKindIDWithEnv :: ( ToPrefix prefix+                      , ValidPrefix (PrefixSymbol prefix)+                      , MonadIO m )+                   => KindID' 'V7 prefix -> m (Maybe TypeIDError)+checkKindIDWithEnv = KID.checkKindIDWithEnv+{-# INLINE checkKindIDWithEnv #-}++-- | Pretty-print a 'KindID'. It is 'id2String' with concrete type.+toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+         => KindID prefix -> String+toString = KID.toString+{-# INLINE toString #-}++-- | Pretty-print a 'KindID' to strict 'Text'. It is 'id2Text' with concrete+-- type.+toText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+       => KindID prefix -> Text+toText = KID.toText+{-# INLINE toText #-}++-- | Pretty-print a 'KindID' to lazy 'ByteString'. It is 'id2ByteString' with+-- concrete type.+toByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+             => KindID prefix -> ByteString+toByteString = KID.toByteString+{-# INLINE toByteString #-}++-- | Parse a 'KindID' from its 'String' representation. It is 'parseString'+-- with concrete type.+parseString :: forall prefix+             . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+            => String -> Either TypeIDError (KindID prefix)+parseString = KID.parseString+{-# INLINE parseString #-}++-- | Parse a 'KindID' 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 (KindID prefix)+parseText = KID.parseText+{-# INLINE parseText #-}++-- | Parse a 'KindID' 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 (KindID prefix)+parseByteString = KID.parseByteString++-- | Parse a 'KindID' 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 (KindID prefix)+parseStringM = KID.parseStringM+{-# INLINE parseStringM #-}++-- | Parse a 'KindID' 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 (KindID prefix)+parseTextM = KID.parseTextM+{-# INLINE parseTextM #-}++-- | Parse a 'KindID' 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 (KindID prefix)+parseByteStringM = KID.parseByteStringM+{-# INLINE parseByteStringM #-}++-- | Convert a 'KindID' to a 'TypeID'.+toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+         => KindID prefix -> TypeID+toTypeID = KID.toTypeID+{-# INLINE toTypeID #-}++-- | Convert a 'TypeID' to a 'KindID'.+fromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+           => TypeID -> Maybe (KindID prefix)+fromTypeID = KID.fromTypeID+{-# INLINE fromTypeID #-}

@@ -0,0 +1,69 @@+-- |+-- Module      : Data.KindID.V7.Unsafe+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Unsafe 'KindID' functions.+--+module Data.KindID.V7.Unsafe+  (+  -- * Unsafe 'KindID' decoding ('KindID'-specific)+    unsafeParseString+  , unsafeParseText+  , unsafeParseByteString+  -- * Unsafe 'KindID' 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.V7 (KindID)+import           Data.TypeID.Internal (TypeID')+import           Data.TypeID.V7 (TypeID)+import           Data.Text (Text)+import           Data.TypeID.Class++-- | Parse a 'KindID' 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 'KindID'. If there are other parse errors, it will crash.+unsafeParseString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                  => String -> KindID prefix+unsafeParseString = KID.unsafeParseString+{-# INLINE unsafeParseString #-}++-- | Parse a 'KindID' 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 'KindID'. If there are other parse errors, it will crash.+unsafeParseText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                => Text -> KindID prefix+unsafeParseText = KID.unsafeParseText+{-# INLINE unsafeParseText #-}++-- | Parse a 'KindID' 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 'KindID'. If there are other parse errors, it will crash.+unsafeParseByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                      => ByteString -> KindID prefix+unsafeParseByteString = KID.unsafeParseByteString+{-# INLINE unsafeParseByteString #-}++-- | 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+-- produces a wrong 'KindID''.+unsafeFromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))+                 => TypeID -> KindID prefix+unsafeFromTypeID = KID.unsafeFromTypeID+{-# INLINE unsafeFromTypeID #-}

@@ -1,5 +1,5 @@ -- |--- Module      : Data.KindID+-- Module      : Data.TypeID -- License     : MIT -- Maintainer  : mmzk1526@outlook.com -- Portability : GHC@@ -7,15 +7,17 @@ -- An implementation of the TypeID specification: -- https://github.com/jetpack-io/typeid. --+-- It is a re-export of "Data.TypeID.V7".+-- module Data.TypeID   (   -- * Data types     TypeID+  , TypeID'   , getPrefix   , getUUID   , getTime   -- * 'TypeID' generation ('TypeID'-specific)-  , nilTypeID   , genTypeID   , genTypeID'   , genTypeIDs@@ -55,4 +57,5 @@   ) where  import           Data.TypeID.Class-import           Data.TypeID.Internal+import           Data.TypeID.Internal (TypeID')+import           Data.TypeID.V7

@@ -6,7 +6,7 @@ -- Maintainer  : mmzk1526@outlook.com -- Portability : GHC ----- A module with the APIs for any 'Data.TypeID.TypeID'-ish identifier type.+-- A module with the APIs for any 'Data.TypeID.V7.TypeID'-ish identifier type. -- -- These type classes are useful to define custom TypeID-ish identifier types. -- For example, if one wishes to remove the constraints on prefix, or use a@@ -33,18 +33,21 @@ import           Control.Exception import           Control.Monad.IO.Class import           Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BSL import           Data.Kind (Type) import           Data.Proxy import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Text.Encoding import           Data.TypeID.Error import           Data.UUID.V7 (UUID) import           Data.Word --- | A constraint synonym for a 'Data.TypeID.TypeID'-ish identifier type that+-- | A constraint synonym for a 'Data.TypeID.V7.TypeID'-ish identifier type that -- supports ID generation and string conversion. type TypeIDLike a = (IDType a, IDConv a, IDGen a) --- | A type class for a 'Data.TypeID.TypeID'-ish identifier type, which has a+-- | A type class for a 'Data.TypeID.V7.TypeID'-ish identifier type, which has a -- 'Text' prefix and a 'UUID' suffix. class IDType a where   -- | Get the prefix of the identifier.@@ -57,27 +60,39 @@   -- timestamp-based.   getTime :: a -> Word64 --- | A type class for converting between a 'Data.TypeID.TypeID'-ish identifier--- type and some string representations.+-- | A type class for converting between a 'Data.TypeID.V7.TypeID'-ish+-- identifier type and some string representations. class IDConv a where   -- | Parse the identifier from its 'String' representation.   string2ID :: String -> Either TypeIDError a+  string2ID = text2ID . T.pack+  {-# INLINE string2ID #-}    -- | Parse the identifier from its string representation as a strict 'Text'.   text2ID :: Text -> Either TypeIDError a+  text2ID = byteString2ID . BSL.fromStrict . encodeUtf8+  {-# INLINE text2ID #-}    -- | Parse the identifier from its string representation as a lazy   -- 'ByteString'.   byteString2ID :: ByteString -> Either TypeIDError a+  byteString2ID = string2ID . T.unpack . decodeUtf8 . BSL.toStrict+  {-# INLINE byteString2ID #-}    -- | Pretty-print the identifier to a 'String'.   id2String :: a -> String+  id2String = T.unpack . id2Text+  {-# INLINE id2String #-}    -- | Pretty-print the identifier to a strict 'Text'.   id2Text :: a -> Text+  id2Text = decodeUtf8 . BSL.toStrict . id2ByteString+  {-# INLINE id2Text #-}    -- | Pretty-print the identifier to a lazy 'ByteString'.   id2ByteString :: a -> ByteString+  id2ByteString = BSL.fromStrict . encodeUtf8 . T.pack . id2String+  {-# INLINE id2ByteString #-}    -- | Parse the identifier from its 'String' representation, throwing an error   -- when the parsing fails.@@ -114,6 +129,15 @@   unsafeByteString2ID :: ByteString -> a   unsafeByteString2ID = either (error . show) id . byteString2ID   {-# INLINE unsafeByteString2ID #-}+  {-# MINIMAL string2ID, id2String+            | string2ID, id2Text+            | string2ID, id2ByteString+            | text2ID, id2String+            | text2ID, id2Text+            | text2ID, id2ByteString+            | byteString2ID, id2String+            | byteString2ID, id2Text+            | byteString2ID, id2ByteString #-}  -- | Generate a new identifier with the given prefix. genID :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (m a)@@ -151,7 +175,7 @@ checkIDWithEnv = checkIDWithEnv_ @a @m Proxy {-# INLINE checkIDWithEnv #-} --- | A type class for generating 'Data.TypeID.TypeID'-ish identifiers.+-- | A type class for generating 'Data.TypeID.V7.TypeID'-ish identifiers. -- -- The methods in this type class are not directly used since each of them has -- a dummy 'Proxy' in order to compile. We implement the methods here and use

@@ -26,7 +26,7 @@     -- | From a `Data.KindID.KindID` conversion. The prefix doesn't match with     -- the expected.   | TypeIDErrorPrefixMismatch Text Text-    -- | The 'Data.UUID.V7.UUID' suffix has errors.+    -- | The 'Data.UUID.Types.Internal.UUID' suffix has errors.   | TypeIDErrorUUIDError   deriving (Eq, Ord) 

@@ -33,34 +33,39 @@ import           Data.TypeID.Error import           Data.UUID.Types.Internal (UUID(..)) import qualified Data.UUID.Types.Internal as UUID+import qualified Data.UUID.V4 as V4 import qualified Data.UUID.V7 as V7+import           Data.UUID.Versions+import           System.Random import           Foreign --- | The constructor is not exposed to the public API to prevent generating--- invalid @TypeID@s.-data TypeID = TypeID { _getPrefix :: Text-                     , _getUUID   :: UUID }+-- | 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 (Eq, Ord) -instance Show TypeID where-  show :: TypeID -> String+instance Show (TypeID' version) where+  show :: TypeID' version -> String   show = toString   {-# INLINE show #-} -instance Read TypeID where-  readsPrec :: Int -> String -> [(TypeID, String)]+instance Read (TypeID' version) where+  readsPrec :: Int -> String -> [(TypeID' version, String)]   readsPrec _ str = case parseStringS str of-    Left _      -> []-    Right (x,y) -> [(x, y)]+    Left _       -> []+    Right (x, y) -> [(x, y)]   {-# INLINE readsPrec #-} -instance ToJSON TypeID where-  toJSON :: TypeID -> Value+instance ToJSON (TypeID' version) where+  toJSON :: TypeID' version -> Value   toJSON = toJSON . toText   {-# INLINE toJSON #-} -instance FromJSON TypeID where-  parseJSON :: Value -> Parser TypeID+instance FromJSON (TypeID' version) where+  parseJSON :: Value -> Parser (TypeID' version)   parseJSON str = do     s <- parseJSON str     case parseText s of@@ -68,13 +73,13 @@       Right tid -> pure tid   {-# INLINE parseJSON #-} -instance ToJSONKey TypeID where-  toJSONKey :: ToJSONKeyFunction TypeID+instance ToJSONKey (TypeID' version) where+  toJSONKey :: ToJSONKeyFunction (TypeID' version)   toJSONKey = toJSONKeyText toText   {-# INLINE toJSONKey #-} -instance FromJSONKey TypeID where-  fromJSONKey :: FromJSONKeyFunction TypeID+instance FromJSONKey (TypeID' version) where+  fromJSONKey :: FromJSONKeyFunction (TypeID' version)   fromJSONKey = FromJSONKeyTextParser \t -> case parseText t of     Left err  -> fail $ show err     Right tid -> pure tid@@ -93,9 +98,9 @@ -- 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 where-  put :: TypeID -> Put-  put (TypeID prefix uuid) = do+instance Binary (TypeID' version) where+  put :: TypeID' version -> Put+  put (TypeID' prefix uuid) = do     put uuid     let encodedPrefix = concat5BitInts . fmap (subtract 96) . BS.unpack                       $ encodeUtf8 prefix@@ -103,7 +108,7 @@     forM_ encodedPrefix putWord8   {-# INLINE put #-} -  get :: Get TypeID+  get :: Get (TypeID' version)   get = do     uuid          <- get     len           <- getWord8@@ -111,20 +116,20 @@     when (length encodedPrefix > 63) $ fail "Binary: Prefix too long"     when (any (liftM2 (&&) (< 1) (> 25)) encodedPrefix)          (fail "Binary: Invalid prefix")-    pure $ TypeID (decodeUtf8 . BS.pack $ fmap (+ 96) encodedPrefix) uuid+    pure $ TypeID' (decodeUtf8 . BS.pack $ fmap (+ 96) encodedPrefix) uuid   {-# INLINE get #-}  -- | Similar to the 'Binary' instance, but the 'UUID' is stored in host endian.-instance Storable TypeID where-  sizeOf :: TypeID -> Int+instance Storable (TypeID' version) where+  sizeOf :: TypeID' version -> Int   sizeOf _ = 60   {-# INLINE sizeOf #-} -  alignment :: TypeID -> Int+  alignment :: TypeID' version -> Int   alignment _ = 4   {-# INLINE alignment #-} -  peek :: Ptr TypeID -> IO TypeID+  peek :: Ptr (TypeID' version) -> IO (TypeID' version)   peek ptr = do     uuid          <- peek (castPtr ptr :: Ptr UUID)     len           <- fromIntegral <$> (peekByteOff ptr 16 :: IO Word8)@@ -133,11 +138,11 @@     when (length encodedPrefix > 63) $ fail "Storable: Prefix too long"     when (any (liftM2 (&&) (< 1) (> 25)) encodedPrefix)          (fail "Storable: Invalid prefix")-    pure $ TypeID (decodeUtf8 . BS.pack $ fmap (+ 96) encodedPrefix) uuid+    pure $ TypeID' (decodeUtf8 . BS.pack $ fmap (+ 96) encodedPrefix) uuid   {-# INLINE peek #-} -  poke :: Ptr TypeID -> TypeID -> IO ()-  poke ptr (TypeID prefix uuid) = do+  poke :: Ptr (TypeID' version) -> TypeID' version -> IO ()+  poke ptr (TypeID' prefix uuid) = do     poke (castPtr ptr) uuid     let encodedPrefix = concat5BitInts . fmap (subtract 96) . BS.unpack                       $ encodeUtf8 prefix@@ -145,257 +150,287 @@     zipWithM_ (pokeByteOff ptr . (+ 16)) [1..] encodedPrefix   {-# INLINE poke #-} -instance Hashable TypeID where-  hashWithSalt :: Int -> TypeID -> Int-  hashWithSalt salt (TypeID prefix uuid)+instance Hashable (TypeID' version) where+  hashWithSalt :: Int -> TypeID' version -> Int+  hashWithSalt salt (TypeID' prefix uuid)     = salt `hashWithSalt` prefix `hashWithSalt` uuid   {-# INLINE hashWithSalt #-} --- | Get the prefix, 'UUID', and timestamp of a 'TypeID'.-instance IDType TypeID where-  getPrefix :: TypeID -> Text-  getPrefix = _getPrefix+-- | Get the prefix, 'UUID', and timestamp of a 'TypeID''.+instance IDType (TypeID' version) where+  getPrefix :: TypeID' version -> Text+  getPrefix (TypeID' prefix _) = prefix   {-# INLINE getPrefix #-} -  getUUID :: TypeID -> UUID-  getUUID = _getUUID+  getUUID :: TypeID' version -> UUID+  getUUID (TypeID' _ uuid) = uuid   {-# INLINE getUUID #-} -  getTime :: TypeID -> Word64+  getTime :: TypeID' version -> Word64   getTime = V7.getTime . getUUID   {-# INLINE getTime #-} --- | Conversion between 'TypeID' and 'String'/'Text'/'ByteString'.-instance IDConv TypeID where-  string2ID :: String -> Either TypeIDError TypeID+-- | Conversion between 'TypeID'' and 'String'/'Text'/'ByteString'.+instance IDConv (TypeID' version) where+  string2ID :: String -> Either TypeIDError (TypeID' version)   string2ID = parseString   {-# INLINE string2ID #-} -  text2ID :: Text -> Either TypeIDError TypeID+  text2ID :: Text -> Either TypeIDError (TypeID' version)   text2ID = parseText   {-# INLINE text2ID #-} -  byteString2ID :: ByteString -> Either TypeIDError TypeID+  byteString2ID :: ByteString -> Either TypeIDError (TypeID' version)   byteString2ID = parseByteString   {-# INLINE byteString2ID #-} -  id2String :: TypeID -> String+  id2String :: TypeID' version -> String   id2String = toString   {-# INLINE id2String #-} -  id2Text :: TypeID -> Text+  id2Text :: TypeID' version -> Text   id2Text = toText   {-# INLINE id2Text #-} -  id2ByteString :: TypeID -> ByteString+  id2ByteString :: TypeID' version -> ByteString   id2ByteString = toByteString   {-# INLINE id2ByteString #-} -  unsafeString2ID :: String -> TypeID+  unsafeString2ID :: String -> TypeID' version   unsafeString2ID = unsafeParseString   {-# INLINE unsafeString2ID #-} -  unsafeText2ID :: Text -> TypeID+  unsafeText2ID :: Text -> TypeID' version   unsafeText2ID = unsafeParseText   {-# INLINE unsafeText2ID #-} -  unsafeByteString2ID :: ByteString -> TypeID+  unsafeByteString2ID :: ByteString -> TypeID' version   unsafeByteString2ID = unsafeParseByteString   {-# INLINE unsafeByteString2ID #-} --- | Generate 'TypeID's.-instance IDGen TypeID where-  type IDGenPrefix TypeID = 'Just Text+-- | Generate 'Data.TypeIDs.V7.TypeIDs'.+instance IDGen (TypeID' 'V7) where+  type IDGenPrefix (TypeID' 'V7) = 'Just Text -  genID_ :: MonadIO m => Proxy TypeID -> Text -> m TypeID+  genID_ :: MonadIO m => Proxy (TypeID' 'V7) -> Text -> m (TypeID' 'V7)   genID_ _ = genTypeID   {-# INLINE genID_ #-} -  genID'_ :: MonadIO m => Proxy TypeID -> Text -> m TypeID+  genID'_ :: MonadIO m => Proxy (TypeID' 'V7) -> Text -> m (TypeID' 'V7)   genID'_ _ = genTypeID'   {-# INLINE genID'_ #-} -  genIDs_ :: MonadIO m => Proxy TypeID -> Text -> Word16 -> m [TypeID]+  genIDs_ :: MonadIO m+          => Proxy (TypeID' 'V7)+          -> Text+          -> Word16+          -> m [TypeID' 'V7]   genIDs_ _ = genTypeIDs   {-# INLINE genIDs_ #-} -  decorate_ :: Proxy TypeID -> Text -> UUID -> Either TypeIDError TypeID+  decorate_ :: Proxy (TypeID' 'V7)+            -> Text+            -> UUID+            -> Either TypeIDError (TypeID' 'V7)   decorate_ _ = decorateTypeID   {-# INLINE decorate_ #-} -  checkID_ :: Proxy TypeID -> TypeID -> Maybe TypeIDError+  checkID_ :: Proxy (TypeID' 'V7) -> TypeID' 'V7 -> Maybe TypeIDError   checkID_ _ = checkTypeID   {-# INLINE checkID_ #-}    checkIDWithEnv_ :: MonadIO m-                  => Proxy TypeID -> TypeID -> m (Maybe TypeIDError)+                  => Proxy (TypeID' 'V7)+                  -> TypeID' 'V7+                  -> m (Maybe TypeIDError)   checkIDWithEnv_ _ = checkTypeIDWithEnv   {-# INLINE checkIDWithEnv_ #-} --- | Generate a new 'TypeID' from a prefix.+instance IDGen (TypeID' 'V4) where+  type IDGenPrefix (TypeID' 'V4) = 'Just Text++  genID_ :: MonadIO m => Proxy (TypeID' 'V4) -> Text -> m (TypeID' 'V4)+  genID_ _ = genTypeIDV4+  {-# INLINE genID_ #-}++  genID'_ :: MonadIO m => Proxy (TypeID' 'V4) -> Text -> m (TypeID' 'V4)+  genID'_ _ = genTypeIDV4'+  {-# INLINE genID'_ #-}++  genIDs_ :: MonadIO m+          => Proxy (TypeID' 'V4)+          -> Text+          -> Word16+          -> m [TypeID' 'V4]+  genIDs_ _ prefix n = case checkPrefix prefix of+    Nothing  -> map (TypeID' prefix) <$> replicateM (fromIntegral n) randomIO+    Just err -> liftIO $ throwIO err+  {-# INLINE genIDs_ #-}++  decorate_ :: Proxy (TypeID' 'V4)+            -> Text+            -> UUID+            -> Either TypeIDError (TypeID' 'V4)+  decorate_ _ = decorateTypeID+  {-# INLINE decorate_ #-}++  checkID_ :: Proxy (TypeID' 'V4) -> TypeID' 'V4 -> Maybe TypeIDError+  checkID_ _ = checkTypeIDV4+  {-# 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+genTypeID :: MonadIO m => Text -> m (TypeID' 'V7) genTypeID = fmap head . (`genTypeIDs` 1) {-# INLINE genTypeID #-} --- | Generate a new 'TypeID' from a prefix based on statelesss 'UUID'v7.+-- | 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+genTypeID' :: MonadIO m => Text -> m (TypeID' 'V7) genTypeID' prefix = case checkPrefix prefix of   Nothing  -> unsafeGenTypeID' prefix   Just err -> liftIO $ throwIO err {-# INLINE genTypeID' #-} --- | Generate a list of 'TypeID's from a prefix.+-- | Generate a list of 'Data.TypeID.V7.TypeID's from a prefix. ----- It tries its best to generate 'TypeID's at the same timestamp, but it may not--- be possible if we are asking too many 'UUID's at the same time.+-- It 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 'TypeID's are generated at the same--- timestamp.-genTypeIDs :: MonadIO m => Text -> Word16 -> m [TypeID]+-- 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 prefix n = case checkPrefix prefix of   Nothing  -> unsafeGenTypeIDs prefix n   Just err -> liftIO $ throwIO err {-# INLINE genTypeIDs #-} --- | Generate a new 'TypeID' from a prefix, but without checking if the prefix--- is valid.-unsafeGenTypeID :: MonadIO m => Text -> m TypeID-unsafeGenTypeID = fmap head . (`unsafeGenTypeIDs` 1)-{-# INLINE unsafeGenTypeID #-}---- | Generate a new 'TypeID' from a prefix based on statelesss 'UUID'v7, but--- without checking if the prefix is valid.-unsafeGenTypeID' :: MonadIO m => Text -> m TypeID-unsafeGenTypeID' prefix = TypeID prefix <$> V7.genUUID'-{-# INLINE unsafeGenTypeID' #-}---- | Generate n 'TypeID's from a prefix, but without checking if the prefix is--- valid.------ It tries its best to generate 'TypeID's at the same timestamp, but it may not--- be possible if we are asking too many 'UUID's at the same time.+-- | Generate a new 'TypeID'' ''V4' from a prefix. ----- It is guaranteed that the first 32768 'TypeID's are generated at the same--- timestamp.-unsafeGenTypeIDs :: MonadIO m => Text -> Word16 -> m [TypeID]-unsafeGenTypeIDs prefix n = map (TypeID prefix) <$> V7.genUUIDs n-{-# INLINE unsafeGenTypeIDs #-}+-- 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 prefix = case checkPrefix prefix of+  Nothing  -> unsafeGenTypeIDV4 prefix+  Just err -> liftIO $ throwIO err+{-# INLINE genTypeIDV4 #-} --- | The nil 'TypeID'.-nilTypeID :: TypeID-nilTypeID = TypeID "" UUID.nil-{-# INLINE nilTypeID #-}-{-# DEPRECATED nilTypeID "Will be removed in the next major release." #-}+-- | Generate a new 'TypeID'' ''V4' from a prefix based on insecure 'UUID'v4.+genTypeIDV4' :: MonadIO m => Text -> m (TypeID' 'V4)+genTypeIDV4' prefix = case checkPrefix prefix of+  Nothing  -> unsafeGenTypeIDV4' prefix+  Just err -> liftIO $ throwIO err+{-# INLINE genTypeIDV4' #-} --- | Obtain a 'TypeID' from a prefix and a 'UUID'.-decorateTypeID :: Text -> UUID -> Either TypeIDError TypeID+-- | Obtain a 'TypeID'' from a prefix and a 'UUID'.+decorateTypeID :: Text -> UUID -> Either TypeIDError (TypeID' version) decorateTypeID prefix uuid = case checkPrefix prefix of-  Nothing  -> Right $ TypeID prefix uuid+  Nothing  -> Right $ TypeID' prefix uuid   Just err -> Left err {-# INLINE decorateTypeID #-} --- | Pretty-print a 'TypeID'. It is 'id2String' with concrete type.-toString :: TypeID -> String-toString (TypeID prefix (UUID w1 w2)) = if T.null prefix+-- | Pretty-print a 'TypeID''. It is 'id2String' with concrete type.+toString :: TypeID' version -> String+toString (TypeID' prefix (UUID w1 w2)) = if T.null prefix   then suffixEncode bs   else T.unpack prefix ++ "_" ++ suffixEncode bs   where     bs = runPut $ mapM_ putWord64be [w1, w2] {-# INLINE toString #-} --- | Pretty-print a 'TypeID' to strict 'Text'. It is 'id2Text' with concrete+-- | Pretty-print a 'TypeID'' to strict 'Text'. It is 'id2Text' with concrete -- type.-toText :: TypeID -> Text-toText (TypeID prefix (UUID w1 w2)) = if T.null prefix+toText :: TypeID' version -> Text+toText (TypeID' prefix (UUID w1 w2)) = if T.null prefix   then T.pack (suffixEncode bs)   else prefix <> "_" <> T.pack (suffixEncode bs)   where     bs = runPut $ mapM_ putWord64be [w1, w2] {-# INLINE toText #-} --- | Pretty-print a 'TypeID' to lazy 'ByteString'. It is 'id2ByteString' with+-- | Pretty-print a 'TypeID'' to lazy 'ByteString'. It is 'id2ByteString' with -- concrete type.-toByteString :: TypeID -> ByteString+toByteString :: TypeID' version -> ByteString toByteString = fromString . toString {-# INLINE toByteString #-} --- | Parse a 'TypeID' from its 'String' representation. It is 'string2ID' with+-- | Parse a 'TypeID'' from its 'String' representation. It is 'string2ID' with -- concrete type.-parseString :: String -> Either TypeIDError TypeID+parseString :: String -> Either TypeIDError (TypeID' version) parseString str = case parseStringS str of   Left err        -> Left err   Right (tid, "") -> Right tid   _               -> Left TypeIDErrorUUIDError {-# INLINE parseString #-} -parseStringS :: String -> Either TypeIDError (TypeID, String)+parseStringS :: String -> Either TypeIDError (TypeID' version, String) parseStringS str = case span (/= '_') str of   ("", _)              -> Left TypeIDExtraSeparator   (_, "")              -> do     let (uuid, rem) = splitAt 26 str         bs          = fromString uuid-    (, rem) . TypeID "" <$> decodeUUID bs+    (, rem) . TypeID' "" <$> decodeUUID bs   (prefix, _ : suffix) -> do     let prefix'     = T.pack prefix         (uuid, rem) = splitAt 26 suffix         bs          = fromString uuid     case checkPrefix prefix' of-      Nothing  -> (, rem) . TypeID prefix' <$> decodeUUID bs+      Nothing  -> (, rem) . TypeID' prefix' <$> decodeUUID bs       Just err -> Left err --- | Parse a 'TypeID' from its string representation as a strict 'Text'. It is+-- | Parse a 'TypeID'' from its string representation as a strict 'Text'. It is -- 'text2ID' with concrete type.-parseText :: Text -> Either TypeIDError TypeID+parseText :: Text -> Either TypeIDError (TypeID' version) parseText text = case second T.uncons $ T.span (/= '_') text of   ("", _)                    -> Left TypeIDExtraSeparator-  (_, Nothing)               -> TypeID "" <$> decodeUUID bs+  (_, Nothing)               -> TypeID' ""+                            <$> decodeUUID (BSL.fromStrict $ encodeUtf8 text)   (prefix, Just (_, suffix)) -> do     case checkPrefix prefix of-      Nothing  -> TypeID prefix+      Nothing  -> TypeID' prefix               <$> decodeUUID (BSL.fromStrict $ encodeUtf8 suffix)       Just err -> Left err-  where-    bs = BSL.fromStrict $ encodeUtf8 text --- | Parse a 'TypeID' from its string representation as a lazy 'ByteString'. It+-- | Parse a 'TypeID'' from its string representation as a lazy 'ByteString'. It -- is 'byteString2ID' with concrete type.-parseByteString :: ByteString -> Either TypeIDError TypeID+parseByteString :: ByteString -> Either TypeIDError (TypeID' version) parseByteString bs = case second BSL.uncons $ BSL.span (/= 95) bs of   ("", _)                    -> Left TypeIDExtraSeparator-  (_, Nothing)               -> TypeID "" <$> decodeUUID bs+  (_, Nothing)               -> TypeID' "" <$> decodeUUID bs   (prefix, Just (_, suffix)) -> do     let prefix' = decodeUtf8 $ BSL.toStrict prefix     case checkPrefix prefix' of-      Nothing  -> TypeID prefix' <$> decodeUUID suffix+      Nothing  -> TypeID' prefix' <$> decodeUUID suffix       Just err -> Left err --- | Parse a 'TypeID' from its 'String' representation, throwing an error when+-- | 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+parseStringM :: MonadIO m => String -> m (TypeID' version) parseStringM = string2IDM {-# INLINE parseStringM #-} --- | Parse a 'TypeID' from its string representation as a strict 'Text',+-- | 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+parseTextM :: MonadIO m => Text -> m (TypeID' version) parseTextM = text2IDM {-# INLINE parseTextM #-} --- | Parse a 'TypeID' from its string representation as a lazy 'ByteString',+-- | 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+parseByteStringM :: MonadIO m => ByteString -> m (TypeID' version) parseByteStringM = byteString2IDM {-# INLINE parseByteStringM #-} --- | Check if the given prefix is a valid TypeID prefix.+-- | Check if the given prefix is a valid 'TypeID'' prefix. checkPrefix :: Text -> Maybe TypeIDError checkPrefix prefix   | T.length prefix > 63 = Just $ TypeIDErrorPrefixTooLong (T.length prefix)@@ -407,45 +442,90 @@  -- | Check if the prefix is valid and the suffix 'UUID' has the correct v7 -- version and variant.-checkTypeID :: TypeID -> Maybe TypeIDError-checkTypeID (TypeID prefix uuid)+checkTypeID :: TypeID' 'V7 -> Maybe TypeIDError+checkTypeID (TypeID' prefix uuid)   = msum [ checkPrefix prefix          , TypeIDErrorUUIDError <$ guard (not $ V7.validate uuid) ] {-# INLINE checkTypeID #-} +-- | Check if the prefix is valid and the suffix 'UUID' has the correct v4+-- version and variant.+checkTypeIDV4 :: TypeID' 'V4 -> Maybe TypeIDError+checkTypeIDV4 (TypeID' prefix uuid)+  = msum [ checkPrefix prefix+         , TypeIDErrorUUIDError <$ guard (not $ validateWithVersion uuid V4) ]+{-# INLINE checkTypeIDV4 #-}+ -- | Similar to 'checkTypeID', but also checks if the suffix 'UUID' is -- generated in the past.-checkTypeIDWithEnv :: MonadIO m => TypeID -> m (Maybe TypeIDError)-checkTypeIDWithEnv tid@(TypeID _ uuid)+checkTypeIDWithEnv :: MonadIO m => TypeID' 'V7 -> m (Maybe TypeIDError)+checkTypeIDWithEnv tid@(TypeID' _ uuid)   = fmap (checkTypeID tid `mplus`)          ((TypeIDErrorUUIDError <$) . guard . not <$> V7.validateWithTime uuid) {-# INLINE checkTypeIDWithEnv #-} --- | Parse a 'TypeID' from its 'String' representation, but crashes when+-- | 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 = fmap head . (`unsafeGenTypeIDs` 1)+{-# INLINE unsafeGenTypeID #-}++-- | Generate a new 'TypeID'' ''V4' from a prefix, but without checking if the+-- prefix is valid.+unsafeGenTypeIDV4 :: MonadIO m => Text -> m (TypeID' 'V4)+unsafeGenTypeIDV4 prefix = TypeID' prefix <$> liftIO V4.nextRandom+{-# INLINE unsafeGenTypeIDV4 #-}++-- | 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' prefix = TypeID' prefix <$> 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' prefix = TypeID' prefix <$> liftIO 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 prefix n = map (TypeID' prefix) <$> V7.genUUIDs n+{-# INLINE unsafeGenTypeIDs #-}++-- | Parse a 'TypeID'' from its 'String' representation, but crashes when -- parsing fails.-unsafeParseString :: String -> TypeID+unsafeParseString :: String -> TypeID' version unsafeParseString str = case span (/= '_') str of-  (_, "")              -> TypeID "" . unsafeDecodeUUID $ fromString str-  (prefix, _ : suffix) -> TypeID (T.pack prefix)+  (_, "")              -> TypeID' "" . unsafeDecodeUUID $ fromString str+  (prefix, _ : suffix) -> TypeID' (T.pack prefix)                         . unsafeDecodeUUID $ fromString suffix {-# INLINE unsafeParseString #-} --- | Parse a 'TypeID' from its string representation as a strict 'Text', but+-- | Parse a 'TypeID'' from its string representation as a strict 'Text', but -- crashes when parsing fails.-unsafeParseText :: Text -> TypeID+unsafeParseText :: Text -> TypeID' version unsafeParseText text = case second T.uncons $ T.span (/= '_') text of-  (_, Nothing)               -> TypeID "" . unsafeDecodeUUID+  (_, Nothing)               -> TypeID' "" . unsafeDecodeUUID                               . BSL.fromStrict $ encodeUtf8 text-  (prefix, Just (_, suffix)) -> TypeID prefix . unsafeDecodeUUID+  (prefix, Just (_, suffix)) -> TypeID' prefix . unsafeDecodeUUID                               . BSL.fromStrict . encodeUtf8 $ suffix {-# INLINE unsafeParseText #-} --- | Parse a 'TypeID' from its string representation as a lazy 'ByteString',+-- | Parse a 'TypeID'' from its string representation as a lazy 'ByteString', -- but crashes when parsing fails.-unsafeParseByteString :: ByteString -> TypeID+unsafeParseByteString :: ByteString -> TypeID' version unsafeParseByteString bs = case second BSL.uncons $ BSL.span (/= 95) bs of-  (_, Nothing)               -> TypeID "" $ unsafeDecodeUUID bs-  (prefix, Just (_, suffix)) -> TypeID (decodeUtf8 $ BSL.toStrict prefix)+  (_, Nothing)               -> TypeID' "" $ unsafeDecodeUUID bs+  (prefix, Just (_, suffix)) -> TypeID' (decodeUtf8 $ BSL.toStrict prefix)                               . unsafeDecodeUUID $ suffix {-# INLINE unsafeParseByteString #-} 

@@ -6,6 +6,8 @@ -- -- Unsafe 'TypeID' functions. --+-- It is a re-export of "Data.TypeID.V7.Unsafe".+-- module Data.TypeID.Unsafe   (   -- * Unsafe 'TypeID' generation@@ -23,4 +25,5 @@   ) where  import           Data.TypeID.Class-import           Data.TypeID.Internal+import           Data.TypeID.V7 (TypeID)+import           Data.TypeID.V7.Unsafe

@@ -0,0 +1,146 @@+-- |+-- Module      : Data.TypeID.V4+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- 'Data.TypeID.V7.TypeID' with 'UUID'v4.+--+module Data.TypeID.V4+  (+  -- * Data types+    TypeIDV4+  , getPrefix+  , getUUID+  -- * 'TypeIDV4' generation ('TypeIDV4'-specific)+  , genTypeID+  , genTypeID'+  , decorateTypeID+  -- * 'TypeIDV4' generation (class methods)+  , genID+  , genID'+  , decorate+  -- * Validation ('TypeIDV4'-specific)+  , checkPrefix+  , checkTypeID+  -- * Validation (class methods)+  , checkID+  -- * Encoding & decoding ('TypeIDV4'-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'v4.+type TypeIDV4 = TID.TypeID' 'V4++-- | Generate a new 'TypeIDV4' 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 TypeIDV4+genTypeID = TID.genTypeIDV4+{-# INLINE genTypeID #-}++-- | Generate a new 'TypeIDV4' from a prefix based on insecure 'UUID'v4.+genTypeID' :: MonadIO m => Text -> m TypeIDV4+genTypeID' = TID.genTypeIDV4'+{-# INLINE genTypeID' #-}++-- | Obtain a 'TypeIDV4' from a prefix and a 'UUID'.+decorateTypeID :: Text -> UUID -> Either TypeIDError TypeIDV4+decorateTypeID = TID.decorateTypeID+{-# INLINE decorateTypeID #-}++-- | Check if the given prefix is a valid 'TypeIDV4' prefix.+checkPrefix :: Text -> Maybe TypeIDError+checkPrefix = TID.checkPrefix+{-# INLINE checkPrefix #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v4+-- version and variant.+checkTypeID :: TypeIDV4 -> Maybe TypeIDError+checkTypeID = TID.checkTypeIDV4+{-# INLINE checkTypeID #-}++-- | Pretty-print a 'TypeIDV4'. It is 'id2String' with concrete type.+toString :: TypeIDV4 -> String+toString = TID.toString+{-# INLINE toString #-}++-- | Pretty-print a 'TypeIDV4' to strict 'Text'. It is 'id2Text' with concrete+-- type.+toText :: TypeIDV4 -> Text+toText = TID.toText+{-# INLINE toText #-}++-- | Pretty-print a 'TypeIDV4' to lazy 'ByteString'. It is 'id2ByteString'+-- with concrete type.+toByteString :: TypeIDV4 -> ByteString+toByteString = TID.toByteString+{-# INLINE toByteString #-}++-- | Parse a 'TypeIDV4' from its 'String' representation. It is 'string2ID' with+-- concrete type.+parseString :: String -> Either TypeIDError TypeIDV4+parseString = TID.parseString+{-# INLINE parseString #-}++-- | Parse a 'TypeIDV4' from its string representation as a strict 'Text'. It+-- is 'text2ID' with concrete type.+parseText :: Text -> Either TypeIDError TypeIDV4+parseText = TID.parseText+{-# INLINE parseText #-}++-- | Parse a 'TypeIDV4' from its string representation as a lazy 'ByteString'.+-- It is 'byteString2ID' with concrete type.+parseByteString :: ByteString -> Either TypeIDError TypeIDV4+parseByteString = TID.parseByteString+{-# INLINE parseByteString #-}++-- | Parse a 'TypeIDV4' from its 'String' representation, throwing an error when+-- the parsing fails. It is 'string2IDM' with concrete type.+parseStringM :: MonadIO m => String -> m TypeIDV4+parseStringM = TID.parseStringM+{-# INLINE parseStringM #-}++-- | Parse a 'TypeIDV4' 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 TypeIDV4+parseTextM = TID.parseTextM+{-# INLINE parseTextM #-}++-- | Parse a 'TypeIDV4' 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 TypeIDV4+parseByteStringM = TID.parseByteStringM+{-# INLINE parseByteStringM #-}

@@ -0,0 +1,59 @@+-- |+-- Module      : Data.TypeID.V4.Unsafe+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Unsafe 'TypeIDV4' functions.+--+module Data.TypeID.V4.Unsafe+  (+  -- * Unsafe 'TypeIDV4' generation+    unsafeGenTypeID+  , unsafeGenTypeID'+  -- * Unsafe decoding ('TypeIDV4'-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.V4 (TypeIDV4)+import           Data.UUID.Types.Internal (UUID)++-- | Generate a new 'TypeIDV4' from a prefix, but without checking if the prefix+-- is valid.+unsafeGenTypeID :: MonadIO m => Text -> m TypeIDV4+unsafeGenTypeID = TID.unsafeGenTypeIDV4+{-# INLINE unsafeGenTypeID #-}++-- | Generate a new 'TypeIDV4' from a prefix based on insecure 'UUID'v4.+unsafeGenTypeID' :: MonadIO m => Text -> m TypeIDV4+unsafeGenTypeID' = TID.unsafeGenTypeIDV4'+{-# INLINE unsafeGenTypeID' #-}++-- | Parse a 'TypeIDV4' from its 'String' representation, but crashes when+-- parsing fails.+unsafeParseString :: String -> TypeIDV4+unsafeParseString = TID.unsafeParseString+{-# INLINE unsafeParseString #-}++-- | Parse a 'TypeIDV4' from its string representation as a strict 'Text', but+-- crashes when parsing fails.+unsafeParseText :: Text -> TypeIDV4+unsafeParseText = TID.unsafeParseText+{-# INLINE unsafeParseText #-}++-- | Parse a 'TypeIDV4' from its string representation as a lazy 'ByteString',+-- but crashes when parsing fails.+unsafeParseByteString :: ByteString -> TypeIDV4+unsafeParseByteString = TID.unsafeParseByteString+{-# INLINE unsafeParseByteString #-}

@@ -0,0 +1,175 @@+-- |+-- Module      : Data.TypeID.V7+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- An implementation of the 'TypeID' specification:+-- https://github.com/jetpack-io/typeid.+--+module Data.TypeID.V7+  (+  -- * Data types+    TypeID+  , TypeIDV7+  , getPrefix+  , getUUID+  , getTime+  -- * 'TypeID' generation ('TypeID'-specific)+  , genTypeID+  , genTypeID'+  , genTypeIDs+  , decorateTypeID+  -- * 'TypeID' generation (class methods)+  , genID+  , genID'+  , genIDs+  , decorate+  -- * Validation ('TypeID'-specific)+  , checkPrefix+  , checkTypeID+  , checkTypeIDWithEnv+  -- * Validation (class methods)+  , checkID+  , checkIDWithEnv+  -- * Encoding & decoding ('TypeID'-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++-- | A type alias for the default 'TypeID' implementation with 'UUID'v7.+type TypeID = TID.TypeID' 'V7++-- | A type alias for 'TypeID'.+type TypeIDV7 = TypeID++-- | Generate a new 'TypeID' from a prefix.+--+-- It throws a 'TypeIDError' if the prefix does not match the specification,+-- namely if it's longer than 63 characters or if it contains characters other+-- than lowercase latin letters.+genTypeID :: MonadIO m => Text -> m TypeID+genTypeID = TID.genTypeID+{-# INLINE genTypeID #-}++-- | Generate a new 'TypeID' from a prefix based on stateless 'UUID'v7.+--+-- See the documentation of 'V7.genUUID'' for more information.+genTypeID' :: MonadIO m => Text -> m TypeID+genTypeID' = TID.genTypeID'+{-# INLINE genTypeID' #-}++-- | Generate a list of 'TypeID's from a prefix.+--+-- It tries its best to generate 'TypeID's at the same timestamp, but it may not+-- be possible if we are asking too many 'UUID's at the same time.+--+-- It is guaranteed that the first 32768 'TypeID's are generated at the same+-- timestamp.+genTypeIDs :: MonadIO m => Text -> Word16 -> m [TypeID]+genTypeIDs = TID.genTypeIDs+{-# INLINE genTypeIDs #-}++-- | Obtain a 'TypeID' from a prefix and a 'UUID'.+decorateTypeID :: Text -> UUID -> Either TypeIDError TypeID+decorateTypeID = TID.decorateTypeID+{-# INLINE decorateTypeID #-}++-- | Check if the given prefix is a valid 'TypeID' prefix.+checkPrefix :: Text -> Maybe TypeIDError+checkPrefix = TID.checkPrefix+{-# INLINE checkPrefix #-}++-- | Check if the prefix is valid and the suffix 'UUID' has the correct v7+-- version and variant.+checkTypeID :: TypeID -> Maybe TypeIDError+checkTypeID = TID.checkTypeID+{-# INLINE checkTypeID #-}++-- | Similar to 'checkTypeID', but also checks if the suffix 'UUID' is+-- generated in the past.+checkTypeIDWithEnv :: MonadIO m => TypeID -> m (Maybe TypeIDError)+checkTypeIDWithEnv = TID.checkTypeIDWithEnv+{-# INLINE checkTypeIDWithEnv #-}++-- | Pretty-print a 'TypeID'. It is 'id2String' with concrete type.+toString :: TypeID -> String+toString = TID.toString+{-# INLINE toString #-}++-- | Pretty-print a 'TypeID' to strict 'Text'. It is 'id2Text' with concrete+-- type.+toText :: TypeID -> Text+toText = TID.toText+{-# INLINE toText #-}++-- | Pretty-print a 'TypeID' to lazy 'ByteString'. It is 'id2ByteString' with+-- concrete type.+toByteString :: TypeID -> ByteString+toByteString = TID.toByteString+{-# INLINE toByteString #-}++-- | Parse a 'TypeID' from its 'String' representation. It is 'string2ID' with+-- concrete type.+parseString :: String -> Either TypeIDError TypeID+parseString = TID.parseString+{-# INLINE parseString #-}++-- | Parse a 'TypeID' from its string representation as a strict 'Text'. It is+-- 'text2ID' with concrete type.+parseText :: Text -> Either TypeIDError TypeID+parseText = TID.parseText+{-# INLINE parseText #-}++-- | Parse a 'TypeID' from its string representation as a lazy 'ByteString'. It+-- is 'byteString2ID' with concrete type.+parseByteString :: ByteString -> Either TypeIDError TypeID+parseByteString = TID.parseByteString+{-# INLINE parseByteString #-}++-- | 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+parseStringM = TID.parseStringM+{-# 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+parseTextM = TID.parseTextM+{-# 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+parseByteStringM = TID.parseByteStringM+{-# INLINE parseByteStringM #-}

@@ -0,0 +1,74 @@+-- |+-- Module      : Data.TypeID.V7.Unsafe+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Unsafe 'TypeID' functions.+--+module Data.TypeID.V7.Unsafe+  (+  -- * Unsafe 'TypeID' generation+    unsafeGenTypeID+  , unsafeGenTypeID'+  , unsafeGenTypeIDs+  -- * Unsafe decoding ('TypeID'-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.V7 (TypeID)+import           Data.UUID.Types.Internal (UUID)+import           Data.Word++-- | Generate a new 'TypeID' from a prefix, but without checking if the prefix+-- is valid.+unsafeGenTypeID :: MonadIO m => Text -> m TypeID+unsafeGenTypeID = TID.unsafeGenTypeID+{-# INLINE unsafeGenTypeID #-}++-- | Generate a new 'TypeID' from a prefix based on stateless 'UUID'v7, but+-- without checking if the prefix is valid.+unsafeGenTypeID' :: MonadIO m => Text -> m TypeID+unsafeGenTypeID' = TID.unsafeGenTypeID'+{-# INLINE unsafeGenTypeID' #-}++-- | Generate n 'TypeID's from a prefix, but without checking if the prefix is+-- valid.+--+-- It tries its best to generate 'TypeID's at the same timestamp, but it may not+-- be possible if we are asking too many 'UUID's at the same time.+--+-- It is guaranteed that the first 32768 'TypeID's are generated at the same+-- timestamp.+unsafeGenTypeIDs :: MonadIO m => Text -> Word16 -> m [TypeID]+unsafeGenTypeIDs = TID.unsafeGenTypeIDs+{-# INLINE unsafeGenTypeIDs #-}++-- | Parse a 'TypeID' from its 'String' representation, but crashes when+-- parsing fails.+unsafeParseString :: String -> TypeID+unsafeParseString = TID.unsafeParseString+{-# INLINE unsafeParseString #-}++-- | Parse a 'TypeID' from its string representation as a strict 'Text', but+-- crashes when parsing fails.+unsafeParseText :: Text -> TypeID+unsafeParseText = TID.unsafeParseText+{-# INLINE unsafeParseText #-}++-- | Parse a 'TypeID' from its string representation as a lazy 'ByteString',+-- but crashes when parsing fails.+unsafeParseByteString :: ByteString -> TypeID+unsafeParseByteString = TID.unsafeParseByteString+{-# INLINE unsafeParseByteString #-}

@@ -13,14 +13,11 @@ -- implementation may change in the future according to the potential -- adjustments in the specification. ----- WARNING: The 'nil' re-export will be removed in the next major version.--- module Data.UUID.V7   (   -- * Data type     UUID   -- * 'UUID'v7 generation-  , nil   , genUUID   , genUUID'   , genUUIDs@@ -42,6 +39,8 @@ import           Data.IORef import           Data.Time.Clock.POSIX import           Data.UUID.Types.Internal++import           Data.UUID.Versions import           System.Entropy import           System.IO.Unsafe (unsafePerformIO) @@ -112,8 +111,7 @@  -- | Validate the version and variant of the 'UUID'v7. validate :: UUID -> Bool-validate (UUID w1 w2)-  = (w1 `shiftR` 12) .&. 0xF == 0x7 && (w2 `shiftR` 62) .&. 0x3 == 0x2+validate = flip validateWithVersion V7 {-# INLINE validate #-}  -- | Validate the version and variant of the 'UUID'v7 as well as its timestamp

@@ -0,0 +1,40 @@+-- |+-- Module      : Data.UUID.Versions+-- License     : MIT+-- Maintainer  : mmzk1526@outlook.com+-- Portability : GHC+--+-- Supported 'UUID' versions for 'Data.TypeID.TypeID''.+--+module Data.UUID.Versions+ (+  -- * Supported 'UUID' versions+    UUIDVersion(..)+  -- * Validation+  , validateWithVersion+ ) where++import           Data.Bits+import           Data.UUID.Types.Internal++-- | The supported 'UUID' versions. These constructors are used as type-level+-- tags for 'Data.TypeID.TypeID''.+--+-- 'V1' and 'V5' are not supported yet.+data UUIDVersion = V1 | V4 | V5 | V7+  deriving (Eq, Ord, Bounded, Enum, Show)++toInt :: Num a => UUIDVersion -> a+toInt V1 = 1+toInt V4 = 4+toInt V5 = 5+toInt V7 = 7+{-# INLINE toInt #-}++-- | Validate the given 'UUID' with the given 'UUIDVersion'.+--+-- The variant is supposed to be 0x2.+validateWithVersion :: UUID -> UUIDVersion -> Bool+validateWithVersion (UUID w1 w2) version+  = (w1 `shiftR` 12) .&. 0xF == toInt version && (w2 `shiftR` 62) .&. 0x3 == 0x2+{-# INLINE validateWithVersion #-}

@@ -8,6 +8,7 @@ import           Data.Binary.Get import           Data.Binary.Put import qualified Data.ByteString.Lazy as BSL+import           Data.KindID.V4 (KindIDV4) import           Data.KindID import           Data.KindID.Class import           Data.Map (Map)@@ -16,8 +17,10 @@ import           Data.Text (Text) import qualified Data.Text as T import           Data.TypeID+import           Data.TypeID.V4 (TypeIDV4) import           Data.TypeID.Class import           Data.TypeID.Error+import           Data.UUID.Types (nil) import           Data.UUID.V7 (UUID) import qualified Data.UUID.V7 as V7 import           Foreign@@ -30,10 +33,10 @@                          , uuid   :: Maybe String }   deriving (Generic, FromJSON, ToJSON) -data TestDataUUID = TestDataUUID { name   :: String-                                 , typeid :: TypeID-                                 , prefix :: Text-                                 , uuid   :: UUID }+data TestDataUUID tid = TestDataUUID { name   :: String+                                     , typeid :: tid+                                     , prefix :: Text+                                     , uuid   :: UUID }   deriving (Generic, FromJSON, ToJSON)  data Prefix = User | Post | Comment@@ -69,218 +72,404 @@     Nothing -> pure tids  main :: IO ()-main = do-  invalid   <- BSL.readFile "test/invalid.json" >>= throwDecode :: IO [TestData]-  valid     <- BSL.readFile "test/valid.json" >>= throwDecode :: IO [TestData]-  validUUID <- BSL.readFile "test/valid.json" >>= throwDecode :: IO [TestDataUUID]--  hspec do-    describe "Generate TypeID" do-      it "can generate TypeID with prefix" do-        start <- V7.getEpochMilli-        tid   <- withCheck $ genID @TypeID "mmzk"-        getPrefix tid `shouldBe` "mmzk"-        getTime tid `shouldSatisfy` \t -> t >= start-      it "can generate TypeID without prefix" do-        start <- V7.getEpochMilli-        tid   <- withCheck $ genID @TypeID ""-        getPrefix tid `shouldBe` ""-        getTime tid `shouldSatisfy` \t -> t >= start-      it "can generate TypeID with stateless UUIDv7" do-        start <- V7.getEpochMilli-        tid   <- withCheck $ genID' @TypeID "mmzk"-        getPrefix tid `shouldBe` "mmzk"-        getTime tid `shouldSatisfy` \t -> t >= start-      it "can generate in batch with same timestamp and in ascending order" do-        start <- V7.getEpochMilli-        tids  <- withChecks $ genIDs @TypeID "mmzk" 1526-        all ((== "mmzk") . getPrefix) tids `shouldBe` True-        let timestamp = getTime $ head tids-        all ((== timestamp) . getTime) tids `shouldBe` True-        all (uncurry (<)) (zip tids $ tail tids) `shouldBe` True-        timestamp `shouldSatisfy` \t -> t >= start-      it "can parse TypeID from String" do-        case string2ID @TypeID "mmzk_00041061050r3gg28a1c60t3gf" of-          Left err  -> expectationFailure $ "Parse error: " ++ show err-          Right tid -> getPrefix tid `shouldBe` "mmzk"+main = hspec do+  v7Test+  v4Test -    describe "Parse TypeID" 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 @TypeID prefix `shouldThrow` anyTypeIDError-          case decorate @TypeID prefix V7.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 @TypeID suffix of-            Left _    -> pure ()-            Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid+v7Test :: Spec+v7Test = 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 TypeID])+  describe "Generate TypeID" do+    it "can generate TypeID with prefix" do+      start <- V7.getEpochMilli+      tid   <- withCheck $ genID @TypeID "mmzk"+      getPrefix tid `shouldBe` "mmzk"+      getTime tid `shouldSatisfy` \t -> t >= start+    it "can generate TypeID without prefix" do+      start <- V7.getEpochMilli+      tid   <- withCheck $ genID @TypeID ""+      getPrefix tid `shouldBe` ""+      getTime tid `shouldSatisfy` \t -> t >= start+    it "can generate TypeID with stateless UUIDv7" do+      start <- V7.getEpochMilli+      tid   <- withCheck $ genID' @TypeID "mmzk"+      getPrefix tid `shouldBe` "mmzk"+      getTime tid `shouldSatisfy` \t -> t >= start+    it "can generate in batch with same timestamp and in ascending order" do+      start <- V7.getEpochMilli+      tids  <- withChecks $ genIDs @TypeID "mmzk" 1526+      all ((== "mmzk") . getPrefix) tids `shouldBe` True+      let timestamp = getTime $ head tids+      all ((== timestamp) . getTime) tids `shouldBe` True+      all (uncurry (<)) (zip tids $ tail tids) `shouldBe` True+      timestamp `shouldSatisfy` \t -> t >= start+    it "can parse TypeID from String" do+      case string2ID @TypeID "mmzk_00041061050r3gg28a1c60t3gf" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> getPrefix tid `shouldBe` "mmzk" -    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 @TypeID tid of-          Left err  -> expectationFailure $ "Parse error: " ++ show err-          Right tid -> show (getUUID tid) `shouldBe` uuid+  describe "Parse TypeID" 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 @TypeID prefix `shouldThrow` anyTypeIDError+        case decorate @TypeID 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 @TypeID suffix of+          Left _    -> pure ()+          Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid -    describe "TypeID valid JSON instances" do-      it "Decode and then encode should be identity" do-        tid  <- genID @TypeID "mmzk"-        tid' <- genID @TypeID "foo"-        let mapping = M.fromList [(tid, tid')]-        let json    = encode mapping-        decode json `shouldBe` Just mapping-        fmap encode (decode @(Map TypeID TypeID) json) `shouldBe` Just json-      describe "Valid JSON value" do-        forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do-          case decode @TypeID (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 TypeID 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 "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 @TypeID tid of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> show (getUUID tid) `shouldBe` uuid -    describe "TypeID invalid JSON instances" do-      describe "Invalid JSON value" do-        forM_ invalid \(TestData name tid _ _) -> it name do-          case decode @TypeID (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 TypeID Int) (fromString $ "{" ++ show tid ++ ":" ++ "114514" ++ "}") of-            Nothing  -> pure ()-            Just tid -> expectationFailure "Invalid TypeID key shouldn't be parsed!"+  describe "TypeID valid JSON instances" do+    it "Decode and then encode should be identity" do+      tid  <- genID @TypeID "mmzk"+      tid' <- genID @TypeID "foo"+      let mapping = M.fromList [(tid, tid')]+      let json    = encode mapping+      decode json `shouldBe` Just mapping+      fmap encode (decode @(Map TypeID TypeID) json) `shouldBe` Just json+    describe "Valid JSON value" do+      forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do+        case decode @TypeID (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 TypeID 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 "Test invalid.json" do+  describe "TypeID invalid JSON instances" do+    describe "Invalid JSON value" do       forM_ invalid \(TestData name tid _ _) -> it name do-        case string2ID @TypeID tid of+        case decode @TypeID (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 TypeID 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 @TypeID tid of+        Left _    -> pure ()+        Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid++  describe "Test valid.json (TypeID as literal)" do+    forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do+      case string2ID @TypeID 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 (TypeID as JSON)" do+    forM_ validUUID \(TestDataUUID name tid prefix uuid) -> it name do+      getPrefix tid `shouldBe` prefix+      getUUID tid `shouldBe` uuid++  describe "Generate KindID with 'Symbol' prefixes" do+    it "can generate KindID with prefix" do+      start <- V7.getEpochMilli+      kid   <- withCheck $ genID @(KindID "mmzk")+      getPrefix kid `shouldBe` "mmzk"+      getTime kid `shouldSatisfy` \t -> start <= t+    it "can generate KindID without prefix" do+      start <- V7.getEpochMilli+      kid   <- withCheck $ genID @(KindID "")+      getPrefix kid `shouldBe` ""+      getTime kid `shouldSatisfy` \t -> start <= t+    it "can generate KindID with stateless UUID v7" do+      start <- V7.getEpochMilli+      kid   <- withCheck $ genID' @(KindID "mmzk")+      getPrefix kid `shouldBe` "mmzk"+      getTime kid `shouldSatisfy` \t -> start <= t+    it "can generate in batch with same timestamp and in ascending order" do+      start <- V7.getEpochMilli+      kids  <- withChecks $ genIDs @(KindID "mmzk") 1526+      all ((== "mmzk") . getPrefix) kids `shouldBe` True+      let timestamp = getTime $ head kids+      all ((== timestamp) . getTime) kids `shouldBe` True+      all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True+      timestamp `shouldSatisfy` \t -> start <= t+    it "can parse KindID from String" do+      case string2ID @(KindID "mmzk") "mmzk_00041061050r3gg28a1c60t3gf" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right kid -> getPrefix kid `shouldBe` "mmzk"+    it "cannot parse KindID into wrong prefix" do+      case string2ID @(KindID "foo") "mmzk_00041061050r3gg28a1c60t3gf" of+        Left err  -> pure ()+        Right kid -> expectationFailure $ "Parsed TypeID: " ++ show kid++  describe "Generate KindID with custom data kind prefixes" do+    it "can generate KindID with prefix" do+        kid <- withCheck $ genID @(KindID 'Post)+        getPrefix kid `shouldBe` "post"+    it "can parse KindID from String" do+      case string2ID @(KindID 'User) "user_00041061050r3gg28a1c60t3gf" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right kid -> getPrefix kid `shouldBe` "user"+    it "cannot parse KindID into wrong prefix" do+      case string2ID @(KindID 'Comment) "user_00041061050r3gg28a1c60t3gf" of+        Left err  -> pure ()+        Right kid -> expectationFailure $ "Parsed KindID: " ++ show kid+    it "can generate in batch with same timestamp and in ascending order" do+      kids <- withChecks $ genIDs @(KindID 'Comment) 1526+      all ((== "comment") . getPrefix) kids `shouldBe` True+      let timestamp = getTime $ head kids+      all ((== timestamp) . getTime) kids `shouldBe` True+      all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True++  describe "Binary instance for TypeID and KindID" do+    it "has correct binary instance for TypeID" do+      tids <- withChecks $ genIDs @TypeID "abcdefghijklmnopqrstuvwxyz" 114+      forM_ tids \tid -> do+        let bytes = runPut (put tid)+        let tid'  = runGet get bytes+        tid' `shouldBe` tid+    it "has correct binary instance for KindID" do+      kids <- withChecks $ genIDs @(KindID "abcdefghijklmnopqrstuvwxyz") 114+      forM_ kids \kid -> do+        let bytes = runPut (put kid)+        let kid'  = runGet get bytes+        kid' `shouldBe` kid++  describe "Storable instance for TypeID and KindID" do+    it "has correct Storable instance for TypeID" do+      tids <- withChecks $ genIDs @TypeID "abcdefghijklmnopqrstuvwxyz" 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 KindID" do+      kids <- withChecks $ genIDs @(KindID "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+++v4Test :: Spec+v4Test = 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 TypeIDV4])+  describe "Generate TypeIDV4" do+    it "can generate TypeIDV4 with prefix" do+      tid <- withCheck $ genID @TypeIDV4 "mmzk"+      getPrefix tid `shouldBe` "mmzk"+    it "can generate TypeIDV4 without prefix" do+      tid <- withCheck $ genID @TypeIDV4 ""+      getPrefix tid `shouldBe` ""+    it "can generate TypeIDV4 with insecure UUIDv4" do+      start <- V7.getEpochMilli+      tid   <- withCheck $ genID' @TypeIDV4 "mmzk"+      getPrefix tid `shouldBe` "mmzk"+    it "can parse TypeIDV4 from String" do+      case string2ID @TypeIDV4 "mmzk_5hjpeh96458fct8t49fnf9farw" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> getPrefix tid `shouldBe` "mmzk"++  describe "Parse TypeIDV4" 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 @TypeIDV4 prefix `shouldThrow` anyTypeIDError+        case decorate @TypeIDV4 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 @TypeIDV4 suffix of           Left _    -> pure ()           Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid -    describe "Test valid.json (TypeID as literal)" do+  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 @TypeIDV4 tid of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> show (getUUID tid) `shouldBe` uuid++  describe "TypeIDV4 valid JSON instances" do+    it "Decode and then encode should be identity" do+      tid  <- genID @TypeIDV4 "mmzk"+      tid' <- genID @TypeIDV4 "foo"+      let mapping = M.fromList [(tid, tid')]+      let json    = encode mapping+      decode json `shouldBe` Just mapping+      fmap encode (decode @(Map TypeIDV4 TypeIDV4) json) `shouldBe` Just json+    describe "Valid JSON value" do       forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do-        case string2ID @TypeID tid of-          Left err  -> expectationFailure $ "Parse error: " ++ show err-          Right tid -> do+        case decode @TypeIDV4 (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 TypeIDV4 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 "Test valid.json (TypeID as JSON)" do-      forM_ validUUID \(TestDataUUID name tid prefix uuid) -> it name do-        getPrefix tid `shouldBe` prefix-        getUUID tid `shouldBe` uuid+  describe "TypeIDV4 invalid JSON instances" do+    describe "Invalid JSON value" do+      forM_ invalid \(TestData name tid _ _) -> it name do+        case decode @TypeIDV4 (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 TypeIDV4 Int) (fromString $ "{" ++ show tid ++ ":" ++ "114514" ++ "}") of+          Nothing  -> pure ()+          Just tid -> expectationFailure "Invalid TypeID key shouldn't be parsed!" -    describe "Generate type-level TypeID (KindID) with 'Symbol' prefixes" do-      it "can generate KindID with prefix" do-        start <- V7.getEpochMilli-        kid   <- withCheck $ genID @(KindID "mmzk")-        getPrefix kid `shouldBe` "mmzk"-        getTime kid `shouldSatisfy` \t -> start <= t-      it "can generate KindID without prefix" do-        start <- V7.getEpochMilli-        kid   <- withCheck $ genID @(KindID "")-        getPrefix kid `shouldBe` ""-        getTime kid `shouldSatisfy` \t -> start <= t-      it "can generate KindID with stateless UUID v7" do-        start <- V7.getEpochMilli-        kid   <- withCheck $ genID' @(KindID "mmzk")-        getPrefix kid `shouldBe` "mmzk"-        getTime kid `shouldSatisfy` \t -> start <= t-      it "can generate in batch with same timestamp and in ascending order" do-        start <- V7.getEpochMilli-        kids  <- withChecks $ genIDs @(KindID "mmzk") 1526-        all ((== "mmzk") . getPrefix) kids `shouldBe` True-        let timestamp = getTime $ head kids-        all ((== timestamp) . getTime) kids `shouldBe` True-        all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True-        timestamp `shouldSatisfy` \t -> start <= t-      it "can parse KindID from String" do-        case string2ID @(KindID "mmzk") "mmzk_00041061050r3gg28a1c60t3gf" of-          Left err  -> expectationFailure $ "Parse error: " ++ show err-          Right kid -> getPrefix kid `shouldBe` "mmzk"-      it "cannot parse KindID into wrong prefix" do-        case string2ID @(KindID "foo") "mmzk_00041061050r3gg28a1c60t3gf" of-          Left err  -> pure ()-          Right kid -> expectationFailure $ "Parsed TypeID: " ++ show kid+  describe "Test invalid.json" do+    forM_ invalid \(TestData name tid _ _) -> it name do+      case string2ID @TypeIDV4 tid of+        Left _    -> pure ()+        Right tid -> expectationFailure $ "Parsed TypeID: " ++ show tid -    describe "Generate type-level TypeID with custom data kind prefixes" do-      it "can generate TypeID with prefix" do-          kid <- withCheck $ genID @(KindID 'Post)-          getPrefix kid `shouldBe` "post"-      it "can parse TypeID from String" do-        case string2ID @(KindID User) "user_00041061050r3gg28a1c60t3gf" of-          Left err  -> expectationFailure $ "Parse error: " ++ show err-          Right kid -> getPrefix kid `shouldBe` "user"-      it "cannot parse TypeID into wrong prefix" do-        case string2ID @(KindID Comment) "user_00041061050r3gg28a1c60t3gf" of-          Left err  -> pure ()-          Right kid -> expectationFailure $ "Parsed TypeID: " ++ show kid-      it "can generate in batch with same timestamp and in ascending order" do-        kids <- withChecks $ genIDs @(KindID 'Comment) 1526-        all ((== "comment") . getPrefix) kids `shouldBe` True-        let timestamp = getTime $ head kids-        all ((== timestamp) . getTime) kids `shouldBe` True-        all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True+  describe "Test valid.json (TypeIDV4 as literal)" do+    forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do+      case string2ID @TypeIDV4 tid of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right tid -> do+          getPrefix tid `shouldBe` prefix+          show (getUUID tid) `shouldBe` uuid -    describe "Binary instance for TypeID and KindID" do-      it "has correct binary instance for TypeID" do-        tids <- withChecks $ genIDs @TypeID "abcdefghijklmnopqrstuvwxyz" 114-        forM_ tids \tid -> do-          let bytes = runPut (put tid)-          let tid'  = runGet get bytes-          tid' `shouldBe` tid-      it "has correct binary instance for KindID" do-        kids <- withChecks $ genIDs @(KindID "abcdefghijklmnopqrstuvwxyz") 114-        forM_ kids \kid -> do-          let bytes = runPut (put kid)-          let kid'  = runGet get bytes-          kid' `shouldBe` kid+  describe "Test valid.json (TypeIDV4 as JSON)" do+    forM_ validUUID \(TestDataUUID name tid prefix uuid) -> it name do+      getPrefix tid `shouldBe` prefix+      getUUID tid `shouldBe` uuid -    describe "Storable instance for TypeID and KindID" do-      it "has correct Storable instance for TypeID" do-        tids <- withChecks $ genIDs @TypeID "abcdefghijklmnopqrstuvwxyz" 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 KindID" do-        kids <- withChecks $ genIDs @(KindID "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+  describe "Generate KindIDV4 with 'Symbol' prefixes" do+    it "can generate KindIDV4 with prefix" do+      kid <- withCheck $ genID @(KindIDV4 "mmzk")+      getPrefix kid `shouldBe` "mmzk"+    it "can generate KindIDV4 without prefix" do+      kid <- withCheck $ genID @(KindIDV4 "")+      getPrefix kid `shouldBe` ""+    it "can generate KindIDV4 with stateless UUID v7" do+      kid <- withCheck $ genID' @(KindIDV4 "mmzk")+      getPrefix kid `shouldBe` "mmzk"+    it "can parse KindID from String" do+      case string2ID @(KindIDV4 "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 @(KindIDV4 "foo") "mmzk_5hjpeh96458fct8t49fnf9farw" of+        Left err  -> pure ()+        Right kid -> expectationFailure $ "Parsed TypeID: " ++ show kid++  describe "Generate KindIDV4 with custom data kind prefixes" do+    it "can generate KindIDV4 with prefix" do+        kid <- withCheck $ genID @(KindID 'Post)+        getPrefix kid `shouldBe` "post"+    it "can parse KindIDV4 from String" do+      case string2ID @(KindIDV4 'User) "user_00041061050r3gg28a1c60t3gf" of+        Left err  -> expectationFailure $ "Parse error: " ++ show err+        Right kid -> getPrefix kid `shouldBe` "user"+    it "cannot parse KindIDV4 into wrong prefix" do+      case string2ID @(KindIDV4 'Comment) "user_00041061050r3gg28a1c60t3gf" of+        Left err  -> pure ()+        Right kid -> expectationFailure $ "Parsed KindIDV4: " ++ show kid++  describe "Binary instance for TypeIDV4 and KindIDV4" do+    it "has correct binary instance for TypeIDV4" do+      tids <- withChecks $ genIDs @TypeIDV4 "abcdefghijklmnopqrstuvwxyz" 114+      forM_ tids \tid -> do+        let bytes = runPut (put tid)+        let tid'  = runGet get bytes+        tid' `shouldBe` tid+    it "has correct binary instance for KindIDV4" do+      kids <- withChecks $ genIDs @(KindIDV4 "abcdefghijklmnopqrstuvwxyz") 114+      forM_ kids \kid -> do+        let bytes = runPut (put kid)+        let kid'  = runGet get bytes+        kid' `shouldBe` kid++  describe "Storable instance for TypeIDV4 and KindIDV4" do+    it "has correct Storable instance for TypeIDV4" do+      tids <- withChecks $ genIDs @TypeIDV4 "abcdefghijklmnopqrstuvwxyz" 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 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