added command line and lovecraftian gen
This commit is contained in:
parent
d0cb946ba4
commit
d2a03a9125
8 changed files with 140 additions and 54 deletions
|
@ -2,7 +2,7 @@
|
||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: c5f958a044b04a3b5795efc86fa4cd7fd5ef7fd9f515f9e483f366db6991f1ec
|
-- hash: 9c3e37ab9a4ab0be5cfdc76a03c0f8a4f3927508f29397d5d7cf5ebb45fa74b3
|
||||||
|
|
||||||
name: human-friendly-id-gen
|
name: human-friendly-id-gen
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -28,8 +28,9 @@ data-files:
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
IDGen.Dictionary
|
HFIG.Dictionary
|
||||||
IDGen.Short
|
HFIG.Lovecraftian
|
||||||
|
HFIG.Short
|
||||||
Lib
|
Lib
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_human_friendly_id_gen
|
Paths_human_friendly_id_gen
|
||||||
|
@ -58,6 +59,7 @@ executable human-friendly-id-gen-exe
|
||||||
base >=4.8 && <5
|
base >=4.8 && <5
|
||||||
, human-friendly-id-gen
|
, human-friendly-id-gen
|
||||||
, protolude
|
, protolude
|
||||||
|
, turtle
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite human-friendly-id-gen-doctest
|
test-suite human-friendly-id-gen-doctest
|
||||||
|
|
|
@ -44,6 +44,7 @@ executables:
|
||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
dependencies:
|
dependencies:
|
||||||
- human-friendly-id-gen
|
- human-friendly-id-gen
|
||||||
|
- turtle
|
||||||
tests:
|
tests:
|
||||||
human-friendly-id-gen-doctest:
|
human-friendly-id-gen-doctest:
|
||||||
main: Main.hs
|
main: Main.hs
|
||||||
|
|
|
@ -1,6 +1,47 @@
|
||||||
import Protolude
|
module Main where
|
||||||
|
|
||||||
import IDGen.Short (idgen)
|
import Protolude hiding (FilePath, die)
|
||||||
|
|
||||||
|
import Turtle
|
||||||
|
|
||||||
|
import qualified HFIG.Dictionary as Dict
|
||||||
|
import qualified HFIG.Lovecraftian as Lovecraftian
|
||||||
|
import qualified HFIG.Short as Short
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = idgen 8 >>= putText
|
main = do
|
||||||
|
opts <- options "Generate Human Friendly identifiers" optParser
|
||||||
|
case genMode opts of
|
||||||
|
Short -> Short.idgen 8 >>= putText
|
||||||
|
Lovecraftian -> Lovecraftian.idgen 2 >>= putText
|
||||||
|
Dict -> do
|
||||||
|
let file = case optDict opts of
|
||||||
|
Just "english" -> "dictionaries/english.txt"
|
||||||
|
Just "first-names" -> "dictionaries/first-names.txt"
|
||||||
|
Just "generic" -> "dictionaries/generic.txt"
|
||||||
|
Just "literary" -> "dictionaries/literary.txt"
|
||||||
|
Just filepath -> toS (format fp filepath)
|
||||||
|
Nothing -> "dictionaries/english.txt"
|
||||||
|
dict <- Dict.dictionaryFromFile file
|
||||||
|
Dict.idgen dict (fromMaybe 3 (optLen opts)) >>= putText
|
||||||
|
|
||||||
|
-- Option parsing
|
||||||
|
data GenMode = Short | Lovecraftian | Dict deriving (Eq)
|
||||||
|
data AppOptions = AppOptions { genMode :: GenMode
|
||||||
|
, optDict :: Maybe FilePath
|
||||||
|
, optLen :: Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
optParser :: Parser AppOptions
|
||||||
|
optParser = AppOptions
|
||||||
|
<$> (fromMaybe Lovecraftian <$> optional (opt toGenMode "gen" 'g' "Possible values: short, dict"))
|
||||||
|
<*> optional (optPath "dict" 'd' "dictionary (predefined names are: english, first-names, generic, literary) or use any file path (one word per line)")
|
||||||
|
<*> optional (optInt "len" 'n' "complexity depends on the gen chosen")
|
||||||
|
|
||||||
|
toGenMode :: Text -> Maybe GenMode
|
||||||
|
toGenMode "s" = Just Short
|
||||||
|
toGenMode "short" = Just Short
|
||||||
|
toGenMode "d" = Just Dict
|
||||||
|
toGenMode "dict" = Just Dict
|
||||||
|
toGenMode "dictionary" = Just Dict
|
||||||
|
toGenMode _ = Nothing
|
||||||
|
|
|
@ -4,7 +4,8 @@ import Test.Tasty
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
import Test.Tasty.SmallCheck
|
import Test.Tasty.SmallCheck
|
||||||
|
|
||||||
import Lib (inc)
|
inc :: Int -> Int
|
||||||
|
inc = (+1)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain $ testGroup "all-tests" tests
|
main = defaultMain $ testGroup "all-tests" tests
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
{-|
|
{-|
|
||||||
module : IDGen.Dictionary
|
module : HFIG.Dictionary
|
||||||
Description : Dictionary strategy to generate random human friendly ids
|
Description : Dictionary strategy to generate random human friendly ids
|
||||||
License : Public Domain
|
License : Public Domain
|
||||||
Maintainer : yann.esposito@gmail.com
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
@ -10,8 +10,9 @@ when talking about them.
|
||||||
Yet not the best for preventing collision.
|
Yet not the best for preventing collision.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
module IDGen.Dictionary
|
module HFIG.Dictionary
|
||||||
( idgen
|
( idgen
|
||||||
|
, dictionaryFromFile
|
||||||
, collisionProbability
|
, collisionProbability
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -23,12 +24,12 @@ import qualified Control.Monad.Primitive as Prim
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
type Dictionary = V.Vector Text
|
||||||
|
|
||||||
-- | Will generate readable short names The integer parameter determine the
|
-- | Will generate readable short names The integer parameter determine the
|
||||||
-- length in number of syllabus of the name
|
-- length in number of syllabus of the name
|
||||||
idgen :: Int -> FilePath -> IO Text
|
idgen :: Dictionary -> Int -> IO Text
|
||||||
idgen n dictName = do
|
idgen allwords n =
|
||||||
allwords <- words dictName
|
|
||||||
Random.withSystemRandom $ \gen ->
|
Random.withSystemRandom $ \gen ->
|
||||||
T.intercalate "-" <$> replicateM n (genWord gen allwords)
|
T.intercalate "-" <$> replicateM n (genWord gen allwords)
|
||||||
|
|
||||||
|
@ -65,5 +66,5 @@ genWord gen allwords = do
|
||||||
(k :: Int) <- Random.uniformR (0, V.length allwords - 1) gen
|
(k :: Int) <- Random.uniformR (0, V.length allwords - 1) gen
|
||||||
return (allwords V.! k)
|
return (allwords V.! k)
|
||||||
|
|
||||||
words :: FilePath -> IO (V.Vector Text)
|
dictionaryFromFile :: FilePath -> IO (V.Vector Text)
|
||||||
words dictName = (V.fromList . T.lines) <$> readFile dictName
|
dictionaryFromFile dictName = (V.fromList . T.lines) <$> readFile dictName
|
78
src/HFIG/Lovecraftian.hs
Normal file
78
src/HFIG/Lovecraftian.hs
Normal file
|
@ -0,0 +1,78 @@
|
||||||
|
{-|
|
||||||
|
module : HFIG.Lovecraftian
|
||||||
|
Description : Lovecraftian 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 HFIG.Lovecraftian
|
||||||
|
( idgen
|
||||||
|
, collisionProbability
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Protolude
|
||||||
|
|
||||||
|
import qualified System.Random.MWC as Random
|
||||||
|
import qualified Control.Monad.Primitive as Prim
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
import Data.Vector ((!))
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
choice <- Random.uniformR (0 :: Int,1) gen
|
||||||
|
let np = if choice == 0 then drop 1 nameparts else nameparts
|
||||||
|
Text.intercalate "-" <$> replicateM n (genGod gen np)
|
||||||
|
|
||||||
|
rnd :: Prim.PrimMonad m => Random.Gen (Prim.PrimState m) -> V.Vector b -> m b
|
||||||
|
rnd gen v = do
|
||||||
|
(k :: Int) <- Random.uniformR (0,V.length v - 1) gen
|
||||||
|
return (v ! k)
|
||||||
|
|
||||||
|
genGod :: Random.Gen Prim.RealWorld -> [V.Vector Text] -> IO Text
|
||||||
|
genGod gen nps = mconcat <$> traverse (rnd gen) nps
|
||||||
|
|
||||||
|
nameparts :: [V.Vector Text]
|
||||||
|
nameparts = [
|
||||||
|
V.fromList ["a","e","i","u","o","a","ai","aiu","aiue","e","i","ia","iau","iu","o","u","y","ya","yi","yo"]
|
||||||
|
, V.fromList ["bh","br","c'th","cn","ct","cth","cx","d","d'","g","gh","ghr","gr","h","k","kh","kth","mh","mh'","ml","n","ng","sh","t","th","tr","v","v'","vh","vh'","vr","x","z","z'","zh"]
|
||||||
|
, V.fromList ["a","e","i","u","o","a","e","i","u","o","ao","aio","ui","aa","io","ou","y"]
|
||||||
|
, V.fromList ["bb","bh","br","cn","ct","dh","dhr","dr","drr","g","gd","gg","ggd","gh","gn","gnn","gr","jh","kl","l","ld","lk","ll","lp","lth","mbr","nd","p","r","rr","rv","th","thl","thr","thrh","tl","vh","x","xh","z","zh","zt"]
|
||||||
|
, V.fromList ["","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","","'dhr","'dr","'end","'gn","'ith","'itr","'k","'kr","'l","'m","'r","'th","'vh","'x","'zh"]
|
||||||
|
, V.fromList ["a","e","i","u","o"]
|
||||||
|
, V.fromList ["","","","","","","","","","","d","g","h","l","lb","lbh","n","r","rc","rh","s","sh","ss","st","sz","th","tl","x","xr","xz"]
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | 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 * (fromIntegral size ** l))) 1
|
||||||
|
where size = product (fmap (V.length . V.filter (/= "")) nameparts) -- filtering the "" give a better approximation
|
|
@ -1,5 +1,5 @@
|
||||||
{-|
|
{-|
|
||||||
module : IDGen.Short
|
module : HFIG.Short
|
||||||
Description : Short strategy to generate random human friendly ids
|
Description : Short strategy to generate random human friendly ids
|
||||||
License : Public Domain
|
License : Public Domain
|
||||||
Maintainer : yann.esposito@gmail.com
|
Maintainer : yann.esposito@gmail.com
|
||||||
|
@ -10,7 +10,7 @@ when talking about them.
|
||||||
Yet not the best for preventing collision.
|
Yet not the best for preventing collision.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
module IDGen.Short
|
module HFIG.Short
|
||||||
( idgen
|
( idgen
|
||||||
, idgenVariableLength
|
, idgenVariableLength
|
||||||
, collisionProbability
|
, collisionProbability
|
38
src/Lib.hs
38
src/Lib.hs
|
@ -1,38 +0,0 @@
|
||||||
{- |
|
|
||||||
Module : Lib
|
|
||||||
Description : Example of a library file.
|
|
||||||
Copyright : (c) 2018, Yann Esposito
|
|
||||||
License : ISC
|
|
||||||
Maintainer : yann.esposito@gmail.com
|
|
||||||
Stability : experimental
|
|
||||||
Portability : POSIX
|
|
||||||
|
|
||||||
Example of library file which is also used for testing the test suites.
|
|
||||||
You can write a longer description of this module here and add @some markup@.
|
|
||||||
|
|
||||||
-}
|
|
||||||
module Lib
|
|
||||||
(
|
|
||||||
-- * Exported functions
|
|
||||||
inc
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Protolude
|
|
||||||
|
|
||||||
-- | Increment one 'Num' value.
|
|
||||||
--
|
|
||||||
-- >>> let answer = 42 :: Int
|
|
||||||
-- >>> let prev = answer - 1
|
|
||||||
-- >>> inc prev
|
|
||||||
-- 42
|
|
||||||
-- >>> succ . Prelude.last . Prelude.take prev . iterate inc $ 1
|
|
||||||
-- 42
|
|
||||||
--
|
|
||||||
-- Properties:
|
|
||||||
--
|
|
||||||
-- prop> succ x == inc x
|
|
||||||
-- prop> inc (negate x) == negate (pred x)
|
|
||||||
--
|
|
||||||
inc :: Int -- ^ value to increment
|
|
||||||
-> Int -- ^ result
|
|
||||||
inc x = x + 1
|
|
Loading…
Reference in a new issue