Fix name clash with Prelude
This commit is contained in:
parent
60a03897ac
commit
1dd3322a6d
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user