License | MIT |
---|---|
Maintainer | mmzk1526@outlook.com |
Portability | GHC |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Similar to Data.TypeID, but the type is statically determined in the type level.
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.
This module contains functions to generate and parse these type-level TypeIDs as well as conversion functions to and from the usual term-level TypeIDs. These functions are usually used with a type application, e.g.
do kindID <- genKindID @"user" ...
It is a re-export of Data.KindID.V7.
Synopsis
- type KindID = KindID' 'V7
- data KindID' (version :: UUIDVersion) prefix
- getPrefix :: IDType a => a -> Text
- getUUID :: IDType a => a -> UUID
- getTime :: IDType a => a -> Word64
- genKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => m (KindID prefix)
- genKindID' :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => m (KindID prefix)
- genKindIDs :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => Word16 -> m [KindID prefix]
- decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => UUID -> KindID prefix
- genID :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (IDGenReq a (m a))
- genID' :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (IDGenReq a (m a))
- genIDs :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (IDGenReq a (Word16 -> m [a]))
- decorate :: forall a. IDGen a => GenFunc (IDGenPrefix a) (UUID -> ResWithErr (IDGenPrefix a) a)
- checkKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> Maybe TypeIDError
- checkKindIDWithEnv :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => KindID' 'V7 prefix -> m (Maybe TypeIDError)
- checkID :: forall a. IDGen a => a -> Maybe TypeIDError
- checkIDWithEnv :: forall a m. (IDGen a, MonadIO m) => a -> m (Maybe TypeIDError)
- toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> String
- toText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> Text
- toByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> ByteString
- parseString :: forall prefix. (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => String -> Either TypeIDError (KindID prefix)
- parseText :: forall prefix. (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Text -> Either TypeIDError (KindID prefix)
- parseByteString :: forall prefix. (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => ByteString -> Either TypeIDError (KindID prefix)
- parseStringM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => String -> m (KindID prefix)
- parseTextM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => Text -> m (KindID prefix)
- parseByteStringM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => ByteString -> m (KindID prefix)
- id2String :: IDConv a => a -> String
- id2Text :: IDConv a => a -> Text
- id2ByteString :: IDConv a => a -> ByteString
- string2ID :: IDConv a => String -> Either TypeIDError a
- text2ID :: IDConv a => Text -> Either TypeIDError a
- byteString2ID :: IDConv a => ByteString -> Either TypeIDError a
- string2IDM :: (IDConv a, MonadIO m) => String -> m a
- text2IDM :: (IDConv a, MonadIO m) => Text -> m a
- byteString2IDM :: (IDConv a, MonadIO m) => ByteString -> m a
- toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> TypeID
- fromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => TypeID -> Maybe (KindID prefix)
Data types
data KindID' (version :: UUIDVersion) prefix Source #
A TypeID with the prefix encoded at type level.
It is dubbed KindID
because the prefix here is a data kind
rather than a type.
Instances
(Typeable prefix, Typeable k, Typeable version) => Data (KindID' version prefix) Source # | |
Defined in Data.KindID.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> KindID' version prefix -> c (KindID' version prefix) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (KindID' version prefix) # toConstr :: KindID' version prefix -> Constr # dataTypeOf :: KindID' version prefix -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (KindID' version prefix)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (KindID' version prefix)) # gmapT :: (forall b. Data b => b -> b) -> KindID' version prefix -> KindID' version prefix # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KindID' version prefix -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KindID' version prefix -> r # gmapQ :: (forall d. Data d => d -> u) -> KindID' version prefix -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> KindID' version prefix -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> KindID' version prefix -> m (KindID' version prefix) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> KindID' version prefix -> m (KindID' version prefix) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> KindID' version prefix -> m (KindID' version prefix) # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Storable (KindID' version prefix) Source # | Similar to the |
Defined in Data.KindID.Internal sizeOf :: KindID' version prefix -> Int # alignment :: KindID' version prefix -> Int # peekElemOff :: Ptr (KindID' version prefix) -> Int -> IO (KindID' version prefix) # pokeElemOff :: Ptr (KindID' version prefix) -> Int -> KindID' version prefix -> IO () # peekByteOff :: Ptr b -> Int -> IO (KindID' version prefix) # pokeByteOff :: Ptr b -> Int -> KindID' version prefix -> IO () # peek :: Ptr (KindID' version prefix) -> IO (KindID' version prefix) # poke :: Ptr (KindID' version prefix) -> KindID' version prefix -> IO () # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Read (KindID' version prefix) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Show (KindID' version prefix) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Binary (KindID' version prefix) Source # | |
Eq (KindID' version prefix) Source # | |
Ord (KindID' version prefix) Source # | |
Defined in Data.KindID.Internal compare :: KindID' version prefix -> KindID' version prefix -> Ordering # (<) :: KindID' version prefix -> KindID' version prefix -> Bool # (<=) :: KindID' version prefix -> KindID' version prefix -> Bool # (>) :: KindID' version prefix -> KindID' version prefix -> Bool # (>=) :: KindID' version prefix -> KindID' version prefix -> Bool # max :: KindID' version prefix -> KindID' version prefix -> KindID' version prefix # min :: KindID' version prefix -> KindID' version prefix -> KindID' version prefix # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Hashable (KindID' version prefix) Source # | |
Defined in Data.KindID.Internal | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => IDConv (KindID' version prefix) Source # | Conversion between |
Defined in Data.KindID.Internal string2ID :: String -> Either TypeIDError (KindID' version prefix) Source # text2ID :: Text -> Either TypeIDError (KindID' version prefix) Source # byteString2ID :: ByteString -> Either TypeIDError (KindID' version prefix) Source # id2String :: KindID' version prefix -> String Source # id2Text :: KindID' version prefix -> Text Source # id2ByteString :: KindID' version prefix -> ByteString Source # string2IDM :: MonadIO m => String -> m (KindID' version prefix) Source # text2IDM :: MonadIO m => Text -> m (KindID' version prefix) Source # byteString2IDM :: MonadIO m => ByteString -> m (KindID' version prefix) Source # unsafeString2ID :: String -> KindID' version prefix Source # unsafeText2ID :: Text -> KindID' version prefix Source # unsafeByteString2ID :: ByteString -> KindID' version prefix Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => IDGen (KindID' 'V1 prefix) Source # | |
Defined in Data.KindID.Internal genID_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V1 prefix) -> GenFunc (IDGenPrefix (KindID' 'V1 prefix)) (IDGenReq (KindID' 'V1 prefix) (m (KindID' 'V1 prefix))) Source # genID'_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V1 prefix) -> GenFunc (IDGenPrefix (KindID' 'V1 prefix)) (IDGenReq (KindID' 'V1 prefix) (m (KindID' 'V1 prefix))) Source # genIDs_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V1 prefix) -> GenFunc (IDGenPrefix (KindID' 'V1 prefix)) (IDGenReq (KindID' 'V1 prefix) (Word16 -> m [KindID' 'V1 prefix])) Source # decorate_ :: Proxy (KindID' 'V1 prefix) -> GenFunc (IDGenPrefix (KindID' 'V1 prefix)) (UUID -> ResWithErr (IDGenPrefix (KindID' 'V1 prefix)) (KindID' 'V1 prefix)) Source # checkID_ :: Proxy (KindID' 'V1 prefix) -> KindID' 'V1 prefix -> Maybe TypeIDError Source # checkIDWithEnv_ :: MonadIO m => Proxy (KindID' 'V1 prefix) -> KindID' 'V1 prefix -> m (Maybe TypeIDError) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => IDGen (KindID' 'V4 prefix) Source # | |
Defined in Data.KindID.Internal genID_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V4 prefix) -> GenFunc (IDGenPrefix (KindID' 'V4 prefix)) (IDGenReq (KindID' 'V4 prefix) (m (KindID' 'V4 prefix))) Source # genID'_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V4 prefix) -> GenFunc (IDGenPrefix (KindID' 'V4 prefix)) (IDGenReq (KindID' 'V4 prefix) (m (KindID' 'V4 prefix))) Source # genIDs_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V4 prefix) -> GenFunc (IDGenPrefix (KindID' 'V4 prefix)) (IDGenReq (KindID' 'V4 prefix) (Word16 -> m [KindID' 'V4 prefix])) Source # decorate_ :: Proxy (KindID' 'V4 prefix) -> GenFunc (IDGenPrefix (KindID' 'V4 prefix)) (UUID -> ResWithErr (IDGenPrefix (KindID' 'V4 prefix)) (KindID' 'V4 prefix)) Source # checkID_ :: Proxy (KindID' 'V4 prefix) -> KindID' 'V4 prefix -> Maybe TypeIDError Source # checkIDWithEnv_ :: MonadIO m => Proxy (KindID' 'V4 prefix) -> KindID' 'V4 prefix -> m (Maybe TypeIDError) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => IDGen (KindID' 'V5 prefix) Source # | |
Defined in Data.KindID.Internal genID_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V5 prefix) -> GenFunc (IDGenPrefix (KindID' 'V5 prefix)) (IDGenReq (KindID' 'V5 prefix) (m (KindID' 'V5 prefix))) Source # genID'_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V5 prefix) -> GenFunc (IDGenPrefix (KindID' 'V5 prefix)) (IDGenReq (KindID' 'V5 prefix) (m (KindID' 'V5 prefix))) Source # genIDs_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V5 prefix) -> GenFunc (IDGenPrefix (KindID' 'V5 prefix)) (IDGenReq (KindID' 'V5 prefix) (Word16 -> m [KindID' 'V5 prefix])) Source # decorate_ :: Proxy (KindID' 'V5 prefix) -> GenFunc (IDGenPrefix (KindID' 'V5 prefix)) (UUID -> ResWithErr (IDGenPrefix (KindID' 'V5 prefix)) (KindID' 'V5 prefix)) Source # checkID_ :: Proxy (KindID' 'V5 prefix) -> KindID' 'V5 prefix -> Maybe TypeIDError Source # checkIDWithEnv_ :: MonadIO m => Proxy (KindID' 'V5 prefix) -> KindID' 'V5 prefix -> m (Maybe TypeIDError) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => IDGen (KindID' 'V7 prefix) Source # | Generate |
Defined in Data.KindID.Internal genID_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V7 prefix) -> GenFunc (IDGenPrefix (KindID' 'V7 prefix)) (IDGenReq (KindID' 'V7 prefix) (m (KindID' 'V7 prefix))) Source # genID'_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V7 prefix) -> GenFunc (IDGenPrefix (KindID' 'V7 prefix)) (IDGenReq (KindID' 'V7 prefix) (m (KindID' 'V7 prefix))) Source # genIDs_ :: forall (m :: Type -> Type). MonadIO m => Proxy (KindID' 'V7 prefix) -> GenFunc (IDGenPrefix (KindID' 'V7 prefix)) (IDGenReq (KindID' 'V7 prefix) (Word16 -> m [KindID' 'V7 prefix])) Source # decorate_ :: Proxy (KindID' 'V7 prefix) -> GenFunc (IDGenPrefix (KindID' 'V7 prefix)) (UUID -> ResWithErr (IDGenPrefix (KindID' 'V7 prefix)) (KindID' 'V7 prefix)) Source # checkID_ :: Proxy (KindID' 'V7 prefix) -> KindID' 'V7 prefix -> Maybe TypeIDError Source # checkIDWithEnv_ :: MonadIO m => Proxy (KindID' 'V7 prefix) -> KindID' 'V7 prefix -> m (Maybe TypeIDError) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => IDType (KindID' version prefix) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => FromJSON (KindID' version prefix) Source # | |
Defined in Data.KindID.Internal | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => FromJSONKey (KindID' version prefix) Source # | |
Defined in Data.KindID.Internal fromJSONKey :: FromJSONKeyFunction (KindID' version prefix) # fromJSONKeyList :: FromJSONKeyFunction [KindID' version prefix] # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => ToJSON (KindID' version prefix) Source # | |
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => ToJSONKey (KindID' version prefix) Source # | |
Defined in Data.KindID.Internal toJSONKey :: ToJSONKeyFunction (KindID' version prefix) # toJSONKeyList :: ToJSONKeyFunction [KindID' version prefix] # | |
type IDGenPrefix (KindID' 'V1 prefix) Source # | |
Defined in Data.KindID.Internal | |
type IDGenPrefix (KindID' 'V4 prefix) Source # | |
Defined in Data.KindID.Internal | |
type IDGenPrefix (KindID' 'V5 prefix) Source # | |
Defined in Data.KindID.Internal | |
type IDGenPrefix (KindID' 'V7 prefix) Source # | |
Defined in Data.KindID.Internal | |
type IDGenReq (KindID' 'V1 prefix) r Source # | |
Defined in Data.KindID.Internal | |
type IDGenReq (KindID' 'V4 prefix) r Source # | |
Defined in Data.KindID.Internal | |
type IDGenReq (KindID' 'V5 prefix) r Source # | |
type IDGenReq (KindID' 'V7 prefix) r Source # | |
Defined in Data.KindID.Internal |
getTime :: IDType a => a -> Word64 Source #
Get the timestamp of the identifier. Returns 0 if the identifier is not timestamp-based.
KindID
generation (KindID
-specific)
genKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => m (KindID prefix) Source #
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) Source #
genKindIDs :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => Word16 -> m [KindID prefix] Source #
decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => UUID -> KindID prefix Source #
KindID
generation (class methods)
genID :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (IDGenReq a (m a)) Source #
Generate a new identifier with the given prefix.
genIDs :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (IDGenReq a (Word16 -> m [a])) Source #
Generate a list of identifiers with the given prefix.
decorate :: forall a. IDGen a => GenFunc (IDGenPrefix a) (UUID -> ResWithErr (IDGenPrefix a) a) Source #
Generate a new identifier with the given prefix and UUID
suffix.
Validation (KindID
-specific)
checkKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> Maybe TypeIDError Source #
Check if the prefix is valid and the suffix UUID
has the correct v7
version and variant.
checkKindIDWithEnv :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => KindID' 'V7 prefix -> m (Maybe TypeIDError) Source #
Similar to checkKindID
, but also checks if the suffix UUID
is
generated in the past.
Validation (class methods)
checkID :: forall a. IDGen a => a -> Maybe TypeIDError Source #
Check the validity of the identifier.
checkIDWithEnv :: forall a m. (IDGen a, MonadIO m) => a -> m (Maybe TypeIDError) Source #
Check the validity of the identifier, potentially with impure criteria.
Encoding & decoding (KindID
-specific)
toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> String Source #
toText :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> Text Source #
toByteString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> ByteString Source #
Pretty-print a KindID
to lazy ByteString
. It is id2ByteString
with
concrete type.
parseString :: forall prefix. (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => String -> Either TypeIDError (KindID prefix) Source #
parseText :: forall prefix. (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Text -> Either TypeIDError (KindID prefix) Source #
parseByteString :: forall prefix. (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => ByteString -> Either TypeIDError (KindID prefix) Source #
Parse a KindID
from its string representation as a lazy ByteString
. It
is byteString2ID
with concrete type.
parseStringM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => String -> m (KindID prefix) Source #
Parse a KindID
from its String
representation, throwing an error when
the parsing fails. It is string2IDM
with concrete type.
parseTextM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => Text -> m (KindID prefix) Source #
parseByteStringM :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) => ByteString -> m (KindID prefix) Source #
Parse a KindID
from its string representation as a lazy ByteString
,
throwing an error when the parsing fails. It is byteString2IDM
with
concrete type.
Encoding & decoding (class methods)
id2ByteString :: IDConv a => a -> ByteString Source #
Pretty-print the identifier to a lazy ByteString
.
string2ID :: IDConv a => String -> Either TypeIDError a Source #
Parse the identifier from its String
representation.
text2ID :: IDConv a => Text -> Either TypeIDError a Source #
Parse the identifier from its string representation as a strict Text
.
byteString2ID :: IDConv a => ByteString -> Either TypeIDError a Source #
Parse the identifier from its string representation as a lazy
ByteString
.
string2IDM :: (IDConv a, MonadIO m) => String -> m a Source #
Parse the identifier from its String
representation, throwing an error
when the parsing fails.
text2IDM :: (IDConv a, MonadIO m) => Text -> m a Source #
Parse the identifier from its string representation as a strict Text
,
throwing an error when the parsing fails.
byteString2IDM :: (IDConv a, MonadIO m) => ByteString -> m a Source #
Parse the identifier from its string representation as a lazy
ByteString
, throwing an error when the parsing fails.
Type-level & term-level conversion
toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => KindID prefix -> TypeID Source #
fromTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => TypeID -> Maybe (KindID prefix) Source #