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)