mmzk-typeid-0.1.0.0: A TypeID implementation for Haskell
LicenseMIT
Maintainermmzk1526@outlook.com
PortabilityGHC
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.KindID

Description

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
  tid <- genKindID @"user"
  ...
Synopsis

Data types

data KindID (prefix :: Symbol) Source #

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.

Note that the Show instance is for debugging purposes only. To pretty-print a KindID, use toString, toText or toByteString.

Instances

Instances details
Show (KindID prefix) Source # 
Instance details

Defined in Data.KindID.Internal

Methods

showsPrec :: Int -> KindID prefix -> ShowS #

show :: KindID prefix -> String #

showList :: [KindID prefix] -> ShowS #

Eq (KindID prefix) Source # 
Instance details

Defined in Data.KindID.Internal

Methods

(==) :: KindID prefix -> KindID prefix -> Bool #

(/=) :: KindID prefix -> KindID prefix -> Bool #

Ord (KindID prefix) Source # 
Instance details

Defined in Data.KindID.Internal

Methods

compare :: KindID prefix -> KindID prefix -> Ordering #

(<) :: KindID prefix -> KindID prefix -> Bool #

(<=) :: KindID prefix -> KindID prefix -> Bool #

(>) :: KindID prefix -> KindID prefix -> Bool #

(>=) :: KindID prefix -> KindID prefix -> Bool #

max :: KindID prefix -> KindID prefix -> KindID prefix #

min :: KindID prefix -> KindID prefix -> KindID prefix #

ValidPrefix prefix => FromJSON (KindID prefix) Source # 
Instance details

Defined in Data.KindID

Methods

parseJSON :: Value -> Parser (KindID prefix) #

parseJSONList :: Value -> Parser [KindID prefix] #

ValidPrefix prefix => ToJSON (KindID prefix) Source # 
Instance details

Defined in Data.KindID

Methods

toJSON :: KindID prefix -> Value #

toEncoding :: KindID prefix -> Encoding #

toJSONList :: [KindID prefix] -> Value #

toEncodingList :: [KindID prefix] -> Encoding #

getPrefix :: forall prefix. ValidPrefix prefix => KindID prefix -> Text Source #

Get the prefix of the KindID.

getUUID :: forall prefix. ValidPrefix prefix => KindID prefix -> UUID Source #

Get the UUID of the KindID.

getTime :: forall prefix. ValidPrefix prefix => KindID prefix -> Word64 Source #

Get the timestamp of the KindID.

type ValidPrefix (prefix :: Symbol) = (KnownSymbol prefix, LengthSymbol prefix < 64, IsLowerSymbol prefix ~ 'True) Source #

A constraint for valid prefix Symbols.

KindID generation

genKindID :: forall prefix. ValidPrefix prefix => IO (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.

genKindIDs :: forall prefix. ValidPrefix prefix => Word16 -> IO [KindID prefix] Source #

Generate n KindIDs from a prefix.

It tries its best to generate KindIDs at the same timestamp, but it may not be possible if we are asking too many UUIDs at the same time.

It is guaranteed that the first 32768 KindIDs are generated at the same timestamp.

nil :: KindID "" Source #

The nil KindID.

decorate :: forall prefix. ValidPrefix prefix => UUID -> KindID prefix Source #

Obtain a KindID from a prefix and a UUID.

Encoding & decoding

toString :: forall prefix. ValidPrefix prefix => KindID prefix -> String Source #

Pretty-print a KindID.

toText :: forall prefix. ValidPrefix prefix => KindID prefix -> Text Source #

Pretty-print a KindID to strict Text.

toByteString :: forall prefix. ValidPrefix prefix => KindID prefix -> ByteString Source #

Pretty-print a KindID to lazy ByteString.

parseString :: forall prefix. ValidPrefix prefix => String -> Either TypeIDError (KindID prefix) Source #

Parse a KindID from its String representation.

parseText :: forall prefix. ValidPrefix prefix => Text -> Either TypeIDError (KindID prefix) Source #

Parse a KindID from its string representation as a strict Text.

parseByteString :: forall prefix. ValidPrefix prefix => ByteString -> Either TypeIDError (KindID prefix) Source #

Parse a KindID from its string representation as a lazy ByteString.

Type-level & term-level conversion

toTypeID :: forall prefix. ValidPrefix prefix => KindID prefix -> TypeID Source #

Convert a KindID to a TypeID.

fromTypeID :: forall prefix. ValidPrefix prefix => TypeID -> Maybe (KindID prefix) Source #

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.

Orphan instances

ValidPrefix prefix => FromJSON (KindID prefix) Source # 
Instance details

Methods

parseJSON :: Value -> Parser (KindID prefix) #

parseJSONList :: Value -> Parser [KindID prefix] #

ValidPrefix prefix => ToJSON (KindID prefix) Source # 
Instance details

Methods

toJSON :: KindID prefix -> Value #

toEncoding :: KindID prefix -> Encoding #

toJSONList :: [KindID prefix] -> Value #

toEncodingList :: [KindID prefix] -> Encoding #