{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

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

import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Aeson.Types hiding (String)
import           Data.ByteString.Lazy (ByteString)
import           Data.Hashable
import           Data.Proxy
import           Data.KindID.Class
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.TypeID.Class
import           Data.TypeID.Error
import           Data.TypeID.Internal (TypeID)
import qualified Data.TypeID.Internal as TID
import           Data.UUID.Types.Internal (UUID(..))
import qualified Data.UUID.V7 as V7
import           Data.Word
import           GHC.TypeLits (symbolVal)

-- | 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 { forall {k} (prefix :: k). KindID prefix -> UUID
_getUUID :: UUID }
  deriving (KindID prefix -> KindID prefix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
/= :: KindID prefix -> KindID prefix -> Bool
$c/= :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
== :: KindID prefix -> KindID prefix -> Bool
$c== :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
Eq, KindID prefix -> KindID prefix -> Bool
KindID prefix -> KindID prefix -> Ordering
KindID prefix -> KindID prefix -> KindID prefix
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (prefix :: k). Eq (KindID prefix)
forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
forall k (prefix :: k). KindID prefix -> KindID prefix -> Ordering
forall k (prefix :: k).
KindID prefix -> KindID prefix -> KindID prefix
min :: KindID prefix -> KindID prefix -> KindID prefix
$cmin :: forall k (prefix :: k).
KindID prefix -> KindID prefix -> KindID prefix
max :: KindID prefix -> KindID prefix -> KindID prefix
$cmax :: forall k (prefix :: k).
KindID prefix -> KindID prefix -> KindID prefix
>= :: KindID prefix -> KindID prefix -> Bool
$c>= :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
> :: KindID prefix -> KindID prefix -> Bool
$c> :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
<= :: KindID prefix -> KindID prefix -> Bool
$c<= :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
< :: KindID prefix -> KindID prefix -> Bool
$c< :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Bool
compare :: KindID prefix -> KindID prefix -> Ordering
$ccompare :: forall k (prefix :: k). KindID prefix -> KindID prefix -> Ordering
Ord)

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => Show (KindID prefix) where
    show :: KindID prefix -> String
    show :: KindID prefix -> String
show = forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> String
toString
    {-# INLINE show #-}

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => Read (KindID prefix) where
    readsPrec :: Int -> String -> [(KindID prefix, String)]
    readsPrec :: Int -> ReadS (KindID prefix)
readsPrec Int
_ String
str = case String -> Either TypeIDError (TypeID, String)
TID.parseStringS String
str of
      Left TypeIDError
_           -> []
      Right (TypeID
tid, String
rem) -> case forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> Maybe (KindID prefix)
fromTypeID TypeID
tid of
        Maybe (KindID prefix)
Nothing  -> []
        Just KindID prefix
kid -> [(KindID prefix
kid, String
rem)]
    {-# INLINE readsPrec #-}

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => ToJSON (KindID prefix) where
    toJSON :: KindID prefix -> Value
    toJSON :: KindID prefix -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> Text
toText
    {-# INLINE toJSON #-}

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => FromJSON (KindID prefix) where
    parseJSON :: Value -> Parser (KindID prefix)
    parseJSON :: Value -> Parser (KindID prefix)
parseJSON Value
str = do
      Text
s <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
str
      case forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
Text -> Either TypeIDError (KindID prefix)
parseText Text
s of
        Left TypeIDError
err  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeIDError
err
        Right KindID prefix
kid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure KindID prefix
kid
    {-# INLINE parseJSON #-}

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => ToJSONKey (KindID prefix) where
    toJSONKey :: ToJSONKeyFunction (KindID prefix)
    toJSONKey :: ToJSONKeyFunction (KindID prefix)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> Text
toText
    {-# INLINE toJSONKey #-}

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => FromJSONKey (KindID prefix) where
    fromJSONKey :: FromJSONKeyFunction (KindID prefix)
    fromJSONKey :: FromJSONKeyFunction (KindID prefix)
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser \Text
t -> case forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
Text -> Either TypeIDError (KindID prefix)
parseText Text
t of
      Left TypeIDError
err  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeIDError
err
      Right KindID prefix
kid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure KindID prefix
kid
    {-# INLINE fromJSONKey #-}

instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => Hashable (KindID prefix) where
    hashWithSalt :: Int -> KindID prefix -> Int
    hashWithSalt :: Int -> KindID prefix -> Int
hashWithSalt Int
salt = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID
    {-# INLINE hashWithSalt #-}

-- | Get the prefix, 'UUID', and timestamp of a 'KindID'.
instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => IDType (KindID prefix) where
    getPrefix :: KindID prefix -> Text
    getPrefix :: KindID prefix -> Text
getPrefix KindID prefix
_ = String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @(PrefixSymbol prefix)))
    {-# INLINE getPrefix #-}

    getUUID :: KindID prefix -> UUID
    getUUID :: KindID prefix -> UUID
getUUID = forall {k} (prefix :: k). KindID prefix -> UUID
_getUUID
    {-# INLINE getUUID #-}

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

-- | Conversion between 'KindID' and 'String'/'Text'/'ByteString'.
instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => IDConv (KindID prefix) where
    string2ID :: String -> Either TypeIDError (KindID prefix)
    string2ID :: String -> Either TypeIDError (KindID prefix)
string2ID = forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
String -> Either TypeIDError (KindID prefix)
parseString
    {-# INLINE string2ID #-}

    text2ID :: Text -> Either TypeIDError (KindID prefix)
    text2ID :: Text -> Either TypeIDError (KindID prefix)
text2ID = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
Text -> Either TypeIDError (KindID prefix)
parseText
    {-# INLINE text2ID #-}

    byteString2ID :: ByteString -> Either TypeIDError (KindID prefix)
    byteString2ID :: ByteString -> Either TypeIDError (KindID prefix)
byteString2ID = forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
ByteString -> Either TypeIDError (KindID prefix)
parseByteString
    {-# INLINE byteString2ID #-}

    id2String :: KindID prefix -> String
    id2String :: KindID prefix -> String
id2String = forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> String
toString
    {-# INLINE id2String #-}

    id2Text :: KindID prefix -> Text
    id2Text :: KindID prefix -> Text
id2Text = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> Text
toText
    {-# INLINE id2Text #-}

    id2ByteString :: KindID prefix -> ByteString
    id2ByteString :: KindID prefix -> ByteString
id2ByteString = forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> ByteString
toByteString
    {-# INLINE id2ByteString #-}

-- | Generate 'KindID's.
instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
  => IDGen (KindID prefix) where
    type IDGenPrefix (KindID prefix) = 'Nothing

    genID_ :: MonadIO m => Proxy (KindID prefix) -> m (KindID prefix)
    genID_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (KindID prefix) -> m (KindID prefix)
genID_ Proxy (KindID prefix)
_ = forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
m (KindID prefix)
genKindID
    {-# INLINE genID_ #-}

    genID'_ :: MonadIO m => Proxy (KindID prefix) -> m (KindID prefix)
    genID'_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (KindID prefix) -> m (KindID prefix)
genID'_ Proxy (KindID prefix)
_ = forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
m (KindID prefix)
genKindID'
    {-# INLINE genID'_ #-}

    genIDs_ :: MonadIO m => Proxy (KindID prefix) -> Word16 -> m [KindID prefix]
    genIDs_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (KindID prefix) -> Word16 -> m [KindID prefix]
genIDs_ Proxy (KindID prefix)
_ = forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
Word16 -> m [KindID prefix]
genKindIDs
    {-# INLINE genIDs_ #-}

    decorate_ :: Proxy (KindID prefix) -> UUID -> KindID prefix
    decorate_ :: Proxy (KindID prefix) -> UUID -> KindID prefix
decorate_ Proxy (KindID prefix)
_ = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
UUID -> KindID prefix
decorateKindID
    {-# INLINE decorate_ #-}

    checkID_ :: Proxy (KindID prefix) -> KindID prefix -> Maybe TypeIDError
    checkID_ :: Proxy (KindID prefix) -> KindID prefix -> Maybe TypeIDError
checkID_ Proxy (KindID prefix)
_ = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> Maybe TypeIDError
checkKindID
    {-# INLINE checkID_ #-}

    checkIDWithEnv_ :: MonadIO m 
                    => Proxy (KindID prefix)
                    -> KindID prefix
                    -> m (Maybe TypeIDError)
    checkIDWithEnv_ :: forall (m :: * -> *).
MonadIO m =>
Proxy (KindID prefix) -> KindID prefix -> m (Maybe TypeIDError)
checkIDWithEnv_ Proxy (KindID prefix)
_ = forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
KindID prefix -> m (Maybe TypeIDError)
checkKindIDWithEnv
    {-# INLINE checkIDWithEnv_ #-}

-- | 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 :: forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
m (KindID prefix)
genKindID = forall {k} (prefix :: k). UUID -> KindID prefix
KindID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m UUID
V7.genUUID
{-# INLINE genKindID #-}

-- | Generate a new 'KindID' from a prefix based on statelesss 'UUID'v7.
--
-- See the documentation of 'V7.genUUID'' for more information.
genKindID' :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m)
           => m (KindID prefix)
genKindID' :: forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
m (KindID prefix)
genKindID' = forall {k} (prefix :: k). UUID -> KindID prefix
KindID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m UUID
V7.genUUID'
{-# 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 :: forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
Word16 -> m [KindID prefix]
genKindIDs Word16
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (prefix :: k). UUID -> KindID prefix
KindID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => Word16 -> m [UUID]
V7.genUUIDs Word16
n
{-# INLINE genKindIDs #-}

-- | The nil 'KindID'.
nilKindID :: KindID ""
nilKindID :: KindID ""
nilKindID = forall {k} (prefix :: k). UUID -> KindID prefix
KindID UUID
V7.nil
{-# INLINE nilKindID #-}
{-# DEPRECATED nilKindID "Will be removed in the next major release." #-}

-- | Obtain a 'KindID' from a prefix and a 'UUID'.
decorateKindID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
               => UUID -> KindID prefix
decorateKindID :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
UUID -> KindID prefix
decorateKindID = forall {k} (prefix :: k). UUID -> KindID prefix
KindID
{-# INLINE decorateKindID #-}

-- | Convert a 'KindID' to a 'TypeID'.
toTypeID :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
         => KindID prefix -> TypeID
toTypeID :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID KindID prefix
kid = Text -> UUID -> TypeID
TID.TypeID (forall a. IDType a => a -> Text
getPrefix KindID prefix
kid) (forall a. IDType a => a -> UUID
getUUID KindID prefix
kid)
{-# INLINE toTypeID #-}

-- | 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
            . (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
           => TypeID -> Maybe (KindID prefix)
fromTypeID :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> Maybe (KindID prefix)
fromTypeID TypeID
tid = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @(PrefixSymbol prefix))) forall a. Eq a => a -> a -> Bool
== forall a. IDType a => a -> Text
getPrefix TypeID
tid)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (prefix :: k). UUID -> KindID prefix
KindID (forall a. IDType a => a -> UUID
getUUID TypeID
tid)
{-# INLINE fromTypeID #-}

-- | Pretty-print a 'KindID'. It is 'id2String' with concrete type.
toString :: (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix))
         => KindID prefix -> String
toString :: forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> String
toString = TypeID -> String
TID.toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID
{-# 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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> Text
toText = TypeID -> Text
TID.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID
{-# 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 :: forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> ByteString
toByteString = TypeID -> ByteString
TID.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID
{-# 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 :: forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
String -> Either TypeIDError (KindID prefix)
parseString String
str = do
  TypeID
tid <- String -> Either TypeIDError TypeID
TID.parseString String
str
  case forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> Maybe (KindID prefix)
fromTypeID TypeID
tid of
    Maybe (KindID prefix)
Nothing  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Text -> TypeIDError
TypeIDErrorPrefixMismatch
                       (String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @(PrefixSymbol prefix))))
                       (forall a. IDType a => a -> Text
getPrefix TypeID
tid)
    Just KindID prefix
kid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure KindID prefix
kid
{-# 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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
Text -> Either TypeIDError (KindID prefix)
parseText Text
str = do
  TypeID
tid <- Text -> Either TypeIDError TypeID
TID.parseText Text
str
  case forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> Maybe (KindID prefix)
fromTypeID TypeID
tid of
    Maybe (KindID prefix)
Nothing  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Text -> TypeIDError
TypeIDErrorPrefixMismatch
                       (String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @(PrefixSymbol prefix))))
                       (forall a. IDType a => a -> Text
getPrefix TypeID
tid)
    Just KindID prefix
kid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure KindID prefix
kid
{-# 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 :: forall k (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
ByteString -> Either TypeIDError (KindID prefix)
parseByteString ByteString
str = do
  TypeID
tid <- ByteString -> Either TypeIDError TypeID
TID.parseByteString ByteString
str
  case forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> Maybe (KindID prefix)
fromTypeID TypeID
tid of
    Maybe (KindID prefix)
Nothing  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Text -> TypeIDError
TypeIDErrorPrefixMismatch
                       (String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @(PrefixSymbol prefix))))
                       (forall a. IDType a => a -> Text
getPrefix TypeID
tid)
    Just KindID prefix
kid -> forall (f :: * -> *) a. Applicative f => a -> f a
pure KindID prefix
kid
{-# INLINE parseByteString #-}

-- | 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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> Maybe TypeIDError
checkKindID = TypeID -> Maybe TypeIDError
TID.checkTypeID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID
{-# 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 prefix -> m (Maybe TypeIDError)
checkKindIDWithEnv :: forall {k} (prefix :: k) (m :: * -> *).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix), MonadIO m) =>
KindID prefix -> m (Maybe TypeIDError)
checkKindIDWithEnv = forall (m :: * -> *). MonadIO m => TypeID -> m (Maybe TypeIDError)
TID.checkTypeIDWithEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
KindID prefix -> TypeID
toTypeID
{-# INLINE checkKindIDWithEnv #-}

-- | 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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> KindID prefix
unsafeFromTypeID TypeID
tid = forall {k} (prefix :: k). UUID -> KindID prefix
KindID (forall a. IDType a => a -> UUID
getUUID TypeID
tid)
{-# INLINE unsafeFromTypeID #-}

-- | 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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
String -> KindID prefix
unsafeParseString = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> KindID prefix
unsafeFromTypeID forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TypeID
TID.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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
Text -> KindID prefix
unsafeParseText = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> KindID prefix
unsafeFromTypeID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TypeID
TID.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 :: forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
ByteString -> KindID prefix
unsafeParseByteString = forall {k} (prefix :: k).
(ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) =>
TypeID -> KindID prefix
unsafeFromTypeID forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TypeID
TID.unsafeParseByteString
{-# INLINE unsafeParseByteString #-}