50 lines
1.2 KiB
Haskell
50 lines
1.2 KiB
Haskell
{-|
|
|
This module implements the algorithm
|
|
by which a URL is converted into a word.
|
|
-}
|
|
module Breve.Generator
|
|
( Name
|
|
, Url
|
|
, nameHash
|
|
, intHash
|
|
) where
|
|
|
|
import Control.Monad (replicateM)
|
|
import Control.Monad.State
|
|
import System.Random
|
|
import Crypto.Hash.SHA256 (hash)
|
|
import Data.Binary (decode)
|
|
import Data.ByteString.Lazy (fromStrict)
|
|
import Data.Text (Text, pack)
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
|
|
-- | A phonetic word associated to a URL
|
|
type Name = Text
|
|
|
|
-- | Any kind of URL
|
|
type Url = Text
|
|
|
|
-- | Takes a random element of a list
|
|
choice :: [a] -> State StdGen a
|
|
choice xs = (xs !!) <$> randomSt (0, length xs - 1)
|
|
where randomSt = state . randomR
|
|
|
|
-- | Generates a random phonetic string
|
|
word :: State StdGen Name
|
|
word = pack <$> replicateM 10 letter where
|
|
vowels = "aeiou"
|
|
consonants = "bcdfghjklmnpqrstvwxyz"
|
|
letter = choice [vowels, consonants] >>= choice
|
|
|
|
-- | SHA256 hash to seed a generator
|
|
intHash :: Url -> Int
|
|
intHash = decode . fromStrict . hash . encodeUtf8
|
|
|
|
-- | Assigns a unique name to the given URL
|
|
--
|
|
-- The result is a computation based on a RNG
|
|
-- seeded by URL itself and is therefore
|
|
-- deterministic.
|
|
nameHash :: Url -> Name
|
|
nameHash = evalState word . mkStdGen . intHash
|