{-# 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 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
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
string2ID = forall a. IDConv a => Text -> Either TypeIDError a
text2ID forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
{-# INLINE string2ID #-}
text2ID :: Text -> Either TypeIDError a
text2ID = forall a. IDConv a => ByteString -> Either TypeIDError a
byteString2ID forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
{-# INLINE text2ID #-}
byteString2ID :: ByteString -> Either TypeIDError a
byteString2ID = forall a. IDConv a => String -> Either TypeIDError a
string2ID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
{-# INLINE byteString2ID #-}
id2String :: a -> String
id2String = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => a -> Text
id2Text
{-# INLINE id2String #-}
id2Text :: a -> Text
id2Text = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => a -> ByteString
id2ByteString
{-# INLINE id2Text #-}
id2ByteString :: a -> ByteString
id2ByteString = ByteString -> ByteString
BSL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IDConv a => a -> String
id2String
{-# INLINE id2ByteString #-}
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 #-}
{-# MINIMAL string2ID, id2String
| string2ID, id2Text
| string2ID, id2ByteString
| text2ID, id2String
| text2ID, id2Text
| text2ID, id2ByteString
| byteString2ID, id2String
| byteString2ID, id2Text
| byteString2ID, id2ByteString #-}
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))
genID = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq 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) (IDGenReq a (m a))
genID' :: forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
GenFunc (IDGenPrefix a) (IDGenReq a (m a))
genID' = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq 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) (IDGenReq a (Word16 -> m [a]))
genIDs :: forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
GenFunc (IDGenPrefix a) (IDGenReq a (Word16 -> m [a]))
genIDs = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq 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
type IDGenReq a r :: Type
genID_ :: MonadIO m => Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq a (m a))
genID'_ :: forall m. MonadIO m
=> Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq a (m a))
genID'_ = forall a (m :: * -> *).
(IDGen a, MonadIO m) =>
Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq a (m a))
genID_ @_ @m
{-# INLINE genID'_ #-}
genIDs_ :: forall m. MonadIO m
=> Proxy a -> GenFunc (IDGenPrefix a) (IDGenReq 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