module Data.NanoID where import Control.Monad import qualified Data.ByteString.Char8 as C import System.Random.MWC newtype NanoID = NanoID { NanoID -> ByteString unNanoID :: C.ByteString } deriving (NanoID -> NanoID -> Bool (NanoID -> NanoID -> Bool) -> (NanoID -> NanoID -> Bool) -> Eq NanoID forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: NanoID -> NanoID -> Bool $c/= :: NanoID -> NanoID -> Bool == :: NanoID -> NanoID -> Bool $c== :: NanoID -> NanoID -> Bool Eq, Int -> NanoID -> ShowS [NanoID] -> ShowS NanoID -> String (Int -> NanoID -> ShowS) -> (NanoID -> String) -> ([NanoID] -> ShowS) -> Show NanoID forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [NanoID] -> ShowS $cshowList :: [NanoID] -> ShowS show :: NanoID -> String $cshow :: NanoID -> String showsPrec :: Int -> NanoID -> ShowS $cshowsPrec :: Int -> NanoID -> ShowS Show) newtype Alphabet = Alphabet { Alphabet -> ByteString unAlphabet :: C.ByteString } deriving (Alphabet -> Alphabet -> Bool (Alphabet -> Alphabet -> Bool) -> (Alphabet -> Alphabet -> Bool) -> Eq Alphabet forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Alphabet -> Alphabet -> Bool $c/= :: Alphabet -> Alphabet -> Bool == :: Alphabet -> Alphabet -> Bool $c== :: Alphabet -> Alphabet -> Bool Eq, Int -> Alphabet -> ShowS [Alphabet] -> ShowS Alphabet -> String (Int -> Alphabet -> ShowS) -> (Alphabet -> String) -> ([Alphabet] -> ShowS) -> Show Alphabet forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Alphabet] -> ShowS $cshowList :: [Alphabet] -> ShowS show :: Alphabet -> String $cshow :: Alphabet -> String showsPrec :: Int -> Alphabet -> ShowS $cshowsPrec :: Int -> Alphabet -> ShowS Show) type Length = Int defaultAlphabet :: Alphabet defaultAlphabet :: Alphabet defaultAlphabet = ByteString -> Alphabet Alphabet (String -> ByteString C.pack String "ABCDEFGHIJKLMNOPKRSTUVWXYZ_-abcdefghijklmnopqrstuvwxyz") nanoID :: IO (Either String NanoID) nanoID :: IO (Either String NanoID) nanoID = IO (Gen RealWorld) IO GenIO createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO (Either String NanoID)) -> IO (Either String NanoID) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Alphabet -> Int -> GenIO -> IO (Either String NanoID) customNanoID Alphabet defaultAlphabet Int 21 customNanoID :: Alphabet -> Length -> GenIO-> IO (Either String NanoID) customNanoID :: Alphabet -> Int -> GenIO -> IO (Either String NanoID) customNanoID Alphabet a Int l GenIO g = if Int l Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 21 then Either String NanoID -> IO (Either String NanoID) forall (m :: * -> *) a. Monad m => a -> m a return (String -> Either String NanoID forall a b. a -> Either a b Left String "The length of NanoID is less or equal to 21") else do let acs :: ByteString acs = Alphabet -> ByteString unAlphabet Alphabet a al :: Int al = ByteString -> Int C.length ByteString acs NanoID -> Either String NanoID forall (f :: * -> *) a. Applicative f => a -> f a pure (NanoID -> Either String NanoID) -> (String -> NanoID) -> String -> Either String NanoID forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> NanoID NanoID (ByteString -> NanoID) -> (String -> ByteString) -> String -> NanoID forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ByteString C.pack (String -> Either String NanoID) -> IO String -> IO (Either String NanoID) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Int -> IO Char -> IO String forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a] replicateM Int l ((\Int r -> ByteString -> Int -> Char C.index ByteString acs (Int rInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1)) (Int -> Char) -> IO Int -> IO Char forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Int, Int) -> GenIO -> IO Int forall a (m :: * -> *). (Variate a, PrimMonad m) => (a, a) -> Gen (PrimState m) -> m a uniformR (Int 1,Int al) GenIO g)