Fix name clash with Prelude

master
rnhmjoj 2015-04-11 18:51:15 +02:00
parent 60a03897ac
commit 1dd3322a6d
3 changed files with 22 additions and 22 deletions

View File

@ -33,12 +33,12 @@ app runner = do
get "/" (render index ())
get "/main.css" (serveStatic css)
get "/:word" $ do
word <- queryParam' "word"
url <- liftIO (extract table word)
get "/:name" $ do
name <- queryParam' "name"
url <- liftIO (extract table name)
case url of
Just url -> do
logStr (printf "Resolved %s -> %s" word url)
logStr (printf "Resolved %s -> %s" name url)
respond $ redirectTo (BS.pack url)
Nothing -> respond notFound
@ -46,7 +46,7 @@ app runner = do
(form, _) <- parseForm
case BS.unpack <$> lookup "url" form of
Just url -> do
word <- liftIO (insert table url)
logStr (printf "Registered %s -> %s " url word)
render done $ object ["link" .= (bindUrl ++ word)]
name <- liftIO (insert table url)
logStr (printf "Registered %s -> %s " url name)
render done $ object ["link" .= (bindUrl ++ name)]
Nothing -> respond badRequest

View File

@ -1,7 +1,7 @@
module Breve.Generator
( wordID
, hashID
, Word
( nameHash
, intHash
, Name
, Url
) where
@ -13,7 +13,7 @@ import Data.Binary (decode)
import Data.ByteString.Char8 (pack)
import Data.ByteString.Lazy (fromStrict)
type Word = String
type Name = String
type Url = String
-- Choose a random element of a list
@ -22,16 +22,16 @@ choice xs = (xs !!) <$> randomSt (0, length xs - 1)
where randomSt = state . randomR
-- Generate a random phonetic string
word :: State StdGen Word
word :: State StdGen Name
word = replicateM 10 letter where
vowels = "aeiou"
consonants = "bcdfghjklmnpqrstvwxyz"
letter = choice [vowels, consonants] >>= choice
-- SHA256 hash to seed a generator
hashID :: Url -> Int
hashID = decode . fromStrict . hash . pack
intHash :: Url -> Int
intHash = decode . fromStrict . hash . pack
-- Assing a unique word to the url
wordID :: Url -> Word
wordID = evalState word . mkStdGen . hashID
-- Assing a unique name to the url
nameHash :: Url -> Name
nameHash = evalState word . mkStdGen . intHash

View File

@ -12,7 +12,7 @@ import Control.Concurrent (forkIO, threadDelay)
import Text.Read (readMaybe)
import qualified Data.HashTable.IO as H
type UrlTable = H.CuckooHashTable Word Url
type UrlTable = H.CuckooHashTable Name Url
-- Periodically write a url table to a file
sync :: UrlTable -> FilePath -> IO ()
@ -31,11 +31,11 @@ load file = do
forkIO (sync table file)
return table
-- Insert the url in a table and return the word
insert :: UrlTable -> Url -> IO Word
-- Insert the url in a table and return the name
insert :: UrlTable -> Url -> IO Name
insert table url = H.insert table new url >> return new
where new = wordID url
where new = nameHash url
-- Lookup a table for the associated url
extract :: UrlTable -> Word -> IO (Maybe Url)
extract :: UrlTable -> Name -> IO (Maybe Url)
extract = H.lookup