basic short generator

README.md

@@ -1,6 +1,6 @@
 human-friendly-id-gen
-==========
+=====================
 
-New Haskell project using stack template `hwp`.
+New Haskell project to generate Human Friendly Ids.
 
-Please read file `tutorial.md` for first steps in using the template.
+Those ids should be easy to read, write and to remember.

human-friendly-id-gen.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: c277b81ff031d947f88bdd54614d02de3b1cf3250caa509b48b416941d2a11a6
+-- hash: fe995591c3b1ff6d0108ed452651b05548563501e80b5e6503529ccc952a8fd0
 
 name:           human-friendly-id-gen
 version:        0.1.0.0
@@ -27,6 +27,7 @@ source-repository head
 
 library
   exposed-modules:
+      IDGen.Short
       Lib
   other-modules:
       Paths_human_friendly_id_gen
@@ -36,7 +37,10 @@ library
   ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -Werror -O2
   build-depends:
       base >=4.8 && <5
+    , mwc-random
+    , primitive
     , protolude
+    , vector
   default-language: Haskell2010
 
 executable human-friendly-id-gen-exe

package.yaml

@@ -4,7 +4,7 @@ category: Test
 author:              Yann Esposito
 maintainer:          yann.esposito@gmail.com
 copyright:           © 2018 Yann Esposito
-github:              yogsototh/human-friendly-id-gen
+homepage:            https://gitlab.esy.fun/yogsototh/human-friendly-id-gen#readme
 license: ISC
 extra-source-files:
 - README.md
@@ -26,6 +26,10 @@ dependencies:
 - protolude
 library:
   source-dirs: src
+  dependencies:
+  - mwc-random
+  - vector
+  - primitive
 executables:
   human-friendly-id-gen-exe:
     main: Main.hs
@@ -72,4 +76,4 @@ benchmarks:
     dependencies:
     - criterion >=1.1
     - human-friendly-id-gen
-stability: alpha (experimental)
+stability: alpha (experimental)

src-exe/Main.hs

@@ -1,6 +1,6 @@
 import Protolude
 
-import Lib (inc)
+import IDGen.Short (idgen)
 
 main :: IO ()
-main = print (inc 41)
+main = idgen 8 >>= putText

src/IDGen/Short.hs

@@ -0,0 +1,93 @@
+{-|
+module      : IDGen.Short
+Description : Short strategy to generate random human friendly ids
+License     : Public Domain
+Maintainer  : yann.esposito@gmail.com
+
+Should generate readable words easy to pronounce so minimizing mistake
+when talking about them.
+
+Yet not the best for preventing collision.
+
+-}
+module IDGen.Short
+  ( idgen
+  , idgenVariableLength
+  , collisionProbability
+  )
+where
+
+import Protolude
+
+import qualified System.Random.MWC as Random
+import qualified System.Random.MWC.Distributions as Distr
+import qualified Control.Monad.Primitive as Prim
+import qualified Data.Vector as V
+
+
+-- | Will generate readable short names The integer parameter determine the
+-- length in number of syllabus of the name
+idgen :: Int -> IO Text
+idgen n = Random.withSystemRandom $ \gen -> do
+    mconcat <$> replicateM n (genSylab gen)
+
+-- | Approximate collision probability other n generated name with complexity
+-- parameter equal to l
+--
+-- For example if you generate 1000 words randomly with complexity parameter 4
+-- We estimate the probability of collision to 3.85%
+--
+-- This is a nice helper function to use when you want to estimate the optimal
+-- length of your ids
+--
+-- @
+-- > collisionProbability 1000 4
+-- 3.8580246913580245e-2
+--
+-- > collisionProbability 10000 5
+-- 6.430041152263374e-2
+--
+-- > collisionProbability 10000 6
+-- 1.0716735253772291e-3
+-- @
+collisionProbability :: Double -- ^ nb of generated names
+                     -> Double -- ^ length parameter used
+                     -> Double
+collisionProbability n l = min ((n**2) / (2 * (nbSylabs ** l))) 1
+
+-- | Will generate readable short names
+-- The integer parameter determine the maximal length in number of sillabus of the name
+idgenVariableLength :: Int -> IO Text
+idgenVariableLength n = Random.withSystemRandom $ \gen -> do
+    val <- Distr.exponential nbSylabs gen
+    let len = n - (min (truncate $ val * fromIntegral n) (n - 1))
+    mconcat <$> replicateM len (genSylab gen)
+
+nbSylabs :: Double
+nbSylabs = fromIntegral $ V.length consonnants * V.length voyels
+
+genSylab :: Random.Gen Prim.RealWorld -> IO Text
+genSylab gen = mappend <$> genConsonnant gen <*> genVoyel gen
+
+genConsonnant :: Random.Gen (Prim.PrimState IO) -> IO Text
+genConsonnant gen = do
+  (k :: Int) <- Random.uniformR (0, V.length consonnants - 1) gen
+  return (consonnants V.! k)
+
+consonnants :: V.Vector Text
+consonnants = V.fromList basics
+  where
+    basics = ["b" , "d", "f", "j", "k", "l", "m", "n", "p", "r", "s", "t", "v", "x", "z"]
+    -- you can also use basic <> composed but it will change the length of names in number of chars
+    -- and provide slightly harder to pronounce, read and understand names
+    -- for now I prefer to put that aside
+    -- composable = [ "b" , "d", "f", "k", "p", "s", "t", "v", "z"]
+    -- composed = mconcat (fmap (\x -> [ x <> c | c <- ["r", "l"]]) composable)
+
+genVoyel :: Prim.PrimMonad m => Random.Gen (Prim.PrimState m) -> m Text
+genVoyel gen = do
+  (k :: Int) <- Random.uniformR (0, V.length voyels - 1) gen
+  return (voyels V.! k)
+
+voyels :: V.Vector Text
+voyels = V.fromList ["a","i","o","u"]