use haddock comments
This commit is contained in:
parent
ade3c55ad2
commit
fc3b5ba642
@ -16,22 +16,22 @@ import Data.Text.Encoding (encodeUtf8)
|
|||||||
type Name = Text
|
type Name = Text
|
||||||
type Url = Text
|
type Url = Text
|
||||||
|
|
||||||
-- Choose a random element of a list
|
-- | Takes a random element of a list
|
||||||
choice :: [a] -> State StdGen a
|
choice :: [a] -> State StdGen a
|
||||||
choice xs = (xs !!) <$> randomSt (0, length xs - 1)
|
choice xs = (xs !!) <$> randomSt (0, length xs - 1)
|
||||||
where randomSt = state . randomR
|
where randomSt = state . randomR
|
||||||
|
|
||||||
-- Generate a random phonetic string
|
-- | Generates a random phonetic string
|
||||||
word :: State StdGen Name
|
word :: State StdGen Name
|
||||||
word = pack <$> replicateM 10 letter where
|
word = pack <$> replicateM 10 letter where
|
||||||
vowels = "aeiou"
|
vowels = "aeiou"
|
||||||
consonants = "bcdfghjklmnpqrstvwxyz"
|
consonants = "bcdfghjklmnpqrstvwxyz"
|
||||||
letter = choice [vowels, consonants] >>= choice
|
letter = choice [vowels, consonants] >>= choice
|
||||||
|
|
||||||
-- SHA256 hash to seed a generator
|
-- | SHA256 hash to seed a generator
|
||||||
intHash :: Url -> Int
|
intHash :: Url -> Int
|
||||||
intHash = decode . fromStrict . hash . encodeUtf8
|
intHash = decode . fromStrict . hash . encodeUtf8
|
||||||
|
|
||||||
-- Assign a unique name to the url
|
-- | Assigns a unique name to the url
|
||||||
nameHash :: Url -> Name
|
nameHash :: Url -> Name
|
||||||
nameHash = evalState word . mkStdGen . intHash
|
nameHash = evalState word . mkStdGen . intHash
|
||||||
|
@ -1,5 +1,3 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Breve.Settings where
|
module Breve.Settings where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
@ -14,14 +14,14 @@ import qualified Data.HashTable.IO as H
|
|||||||
|
|
||||||
type UrlTable = H.CuckooHashTable Name Url
|
type UrlTable = H.CuckooHashTable Name Url
|
||||||
|
|
||||||
-- Periodically write a url table to a file
|
-- | Periodically write a url table to a file
|
||||||
sync :: UrlTable -> FilePath -> IO ()
|
sync :: UrlTable -> FilePath -> IO ()
|
||||||
sync table file = forever $ do
|
sync table file = forever $ do
|
||||||
threadDelay (round 3.0e8)
|
threadDelay (round 3.0e8)
|
||||||
content <- show <$> H.toList table
|
content <- show <$> H.toList table
|
||||||
writeFile file content
|
writeFile file content
|
||||||
|
|
||||||
-- Load a url table from a file
|
-- | Load a url table from a file
|
||||||
load :: FilePath -> IO UrlTable
|
load :: FilePath -> IO UrlTable
|
||||||
load file = do
|
load file = do
|
||||||
content <- readFile file
|
content <- readFile file
|
||||||
@ -31,11 +31,11 @@ load file = do
|
|||||||
forkIO (sync table file)
|
forkIO (sync table file)
|
||||||
return table
|
return table
|
||||||
|
|
||||||
-- Insert the url in a table and return the name
|
-- | Insert the url in a table and return the name
|
||||||
insert :: UrlTable -> Url -> IO Name
|
insert :: UrlTable -> Url -> IO Name
|
||||||
insert table url = H.insert table new url >> return new
|
insert table url = H.insert table new url >> return new
|
||||||
where new = nameHash url
|
where new = nameHash url
|
||||||
|
|
||||||
-- Lookup a table for the associated url
|
-- | Lookup a table for the associated url
|
||||||
extract :: UrlTable -> Name -> IO (Maybe Url)
|
extract :: UrlTable -> Name -> IO (Maybe Url)
|
||||||
extract = H.lookup
|
extract = H.lookup
|
||||||
|
Loading…
Reference in New Issue
Block a user