{-# LANGUAGE AllowAmbiguousTypes #-}
module Data.TypeID.Class
(
TypeIDLike
, IDType(..)
, IDConv(..)
, IDGen(..)
, decorate
, genID
, genID'
, genIDs
, checkID
, checkIDWithEnv
, GenFunc(..)
, ResWithErr(..)
) where
import Control.Exception
import Control.Monad.IO.Class
import Data.ByteString.Lazy (ByteString)
import Data.Kind (Type)
import Data.Proxy
import Data.Text (Text)
import Data.TypeID.Error
import Data.UUID.V7 (UUID)
import Data.Word
type TypeIDLike a = (IDType a, IDConv a, IDGen a)
class IDType a where
getPrefix :: a -> Text
getUUID :: a -> UUID
getTime :: a -> Word64
class IDConv a where
string2ID :: String -> Either TypeIDError a
text2ID :: Text -> Either TypeIDError a
byteString2ID :: ByteString -> Either TypeIDError a
id2String :: a -> String
id2Text :: a -> Text
id2ByteString :: a -> ByteString
string2IDM :: MonadIO m => String -> m a
string2IDM = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => String -> Either TypeIDError a
string2ID
{-# INLINE string2IDM #-}
text2IDM :: MonadIO m => Text -> m a
text2IDM = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => Text -> Either TypeIDError a
text2ID
{-# INLINE text2IDM #-}
byteString2IDM :: MonadIO m => ByteString -> m a
byteString2IDM = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => ByteString -> Either TypeIDError a
byteString2ID
{-# INLINE byteString2IDM #-}
unsafeString2ID :: String -> a
unsafeString2ID = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => String -> Either TypeIDError a
string2ID
{-# INLINE unsafeString2ID #-}
unsafeText2ID :: Text -> a
unsafeText2ID = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => Text -> Either TypeIDError a
text2ID
{-# INLINE unsafeText2ID #-}
unsafeByteString2ID :: ByteString -> a
unsafeByteString2ID = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => ByteString -> Either TypeIDError a
byteString2ID
{-# INLINE unsafeByteString2ID #-}
genID :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (m a)
genID :: forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
GenFunc (IDGenPrefix a) (m a)
genID = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (m a)
genID_ @a @m forall {k} (t :: k). Proxy t
Proxy
{-# INLINE genID #-}
genID' :: forall a m. (IDGen a, MonadIO m) => GenFunc (IDGenPrefix a) (m a)
genID' :: forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
GenFunc (IDGenPrefix a) (m a)
genID' = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (m a)
genID'_ @a @m forall {k} (t :: k). Proxy t
Proxy
{-# INLINE genID' #-}
genIDs :: forall a m. (IDGen a, MonadIO m)
=> GenFunc (IDGenPrefix a) (Word16 -> m [a])
genIDs :: forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
GenFunc (IDGenPrefix a) (Word16 -> m [a])
genIDs = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (Word16 -> m [a])
genIDs_ @a @m forall {k} (t :: k). Proxy t
Proxy
{-# INLINE genIDs #-}
decorate :: forall a. IDGen a
=> GenFunc (IDGenPrefix a) (UUID -> ResWithErr (IDGenPrefix a) a)
decorate :: forall a.
IDGen a =>
GenFunc (IDGenPrefix a) (UUID -> ResWithErr (IDGenPrefix a) a)
decorate = forall a.
IDGen a =>
Proxy a
-> GenFunc (IDGenPrefix a) (UUID -> ResWithErr (IDGenPrefix a) a)
decorate_ @a forall {k} (t :: k). Proxy t
Proxy
{-# INLINE decorate #-}
checkID :: forall a. IDGen a => a -> Maybe TypeIDError
checkID :: forall a. IDGen a => a -> Maybe TypeIDError
checkID = forall a. IDGen a => Proxy a -> a -> Maybe TypeIDError
checkID_ @a forall {k} (t :: k). Proxy t
Proxy
{-# INLINE checkID #-}
checkIDWithEnv :: forall a m. (IDGen a, MonadIO m) => a -> m (Maybe TypeIDError)
checkIDWithEnv :: forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
a -> m (Maybe TypeIDError)
checkIDWithEnv = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> a -> m (Maybe TypeIDError)
checkIDWithEnv_ @a @m forall {k} (t :: k). Proxy t
Proxy
{-# INLINE checkIDWithEnv #-}
class IDGen a where
type IDGenPrefix a :: Maybe Type
genID_ :: MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (m a)
genID'_ :: forall m. MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (m a)
genID'_ = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (m a)
genID_ @_ @m
{-# INLINE genID'_ #-}
genIDs_ :: MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (Word16 -> m [a])
decorate_ :: Proxy a
-> GenFunc (IDGenPrefix a) (UUID -> ResWithErr (IDGenPrefix a) a)
checkID_ :: Proxy a -> a -> Maybe TypeIDError
checkIDWithEnv_ :: MonadIO m => Proxy a -> a -> m (Maybe TypeIDError)
checkIDWithEnv_ Proxy a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDGen a => Proxy a -> a -> Maybe TypeIDError
checkID_ (forall {k} (t :: k). Proxy t
Proxy @a)
{-# INLINE checkIDWithEnv_ #-}
type family GenFunc prefix res where
GenFunc ('Just prefix) res = prefix -> res
GenFunc 'Nothing res = res
type family ResWithErr prefix res where
ResWithErr ('Just prefix) res = Either TypeIDError res
ResWithErr 'Nothing res = res