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 "/" (render index ())
|
||||||
get "/main.css" (serveStatic css)
|
get "/main.css" (serveStatic css)
|
||||||
|
|
||||||
get "/:word" $ do
|
get "/:name" $ do
|
||||||
word <- queryParam' "word"
|
name <- queryParam' "name"
|
||||||
url <- liftIO (extract table word)
|
url <- liftIO (extract table name)
|
||||||
case url of
|
case url of
|
||||||
Just url -> do
|
Just url -> do
|
||||||
logStr (printf "Resolved %s -> %s" word url)
|
logStr (printf "Resolved %s -> %s" name url)
|
||||||
respond $ redirectTo (BS.pack url)
|
respond $ redirectTo (BS.pack url)
|
||||||
Nothing -> respond notFound
|
Nothing -> respond notFound
|
||||||
|
|
||||||
@ -46,7 +46,7 @@ app runner = do
|
|||||||
(form, _) <- parseForm
|
(form, _) <- parseForm
|
||||||
case BS.unpack <$> lookup "url" form of
|
case BS.unpack <$> lookup "url" form of
|
||||||
Just url -> do
|
Just url -> do
|
||||||
word <- liftIO (insert table url)
|
name <- liftIO (insert table url)
|
||||||
logStr (printf "Registered %s -> %s " url word)
|
logStr (printf "Registered %s -> %s " url name)
|
||||||
render done $ object ["link" .= (bindUrl ++ word)]
|
render done $ object ["link" .= (bindUrl ++ name)]
|
||||||
Nothing -> respond badRequest
|
Nothing -> respond badRequest
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
module Breve.Generator
|
module Breve.Generator
|
||||||
( wordID
|
( nameHash
|
||||||
, hashID
|
, intHash
|
||||||
, Word
|
, Name
|
||||||
, Url
|
, Url
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -13,7 +13,7 @@ import Data.Binary (decode)
|
|||||||
import Data.ByteString.Char8 (pack)
|
import Data.ByteString.Char8 (pack)
|
||||||
import Data.ByteString.Lazy (fromStrict)
|
import Data.ByteString.Lazy (fromStrict)
|
||||||
|
|
||||||
type Word = String
|
type Name = String
|
||||||
type Url = String
|
type Url = String
|
||||||
|
|
||||||
-- Choose a random element of a list
|
-- Choose a random element of a list
|
||||||
@ -22,16 +22,16 @@ choice xs = (xs !!) <$> randomSt (0, length xs - 1)
|
|||||||
where randomSt = state . randomR
|
where randomSt = state . randomR
|
||||||
|
|
||||||
-- Generate a random phonetic string
|
-- Generate a random phonetic string
|
||||||
word :: State StdGen Word
|
word :: State StdGen Name
|
||||||
word = replicateM 10 letter where
|
word = 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
|
||||||
hashID :: Url -> Int
|
intHash :: Url -> Int
|
||||||
hashID = decode . fromStrict . hash . pack
|
intHash = decode . fromStrict . hash . pack
|
||||||
|
|
||||||
-- Assing a unique word to the url
|
-- Assing a unique name to the url
|
||||||
wordID :: Url -> Word
|
nameHash :: Url -> Name
|
||||||
wordID = evalState word . mkStdGen . hashID
|
nameHash = evalState word . mkStdGen . intHash
|
||||||
|
@ -12,7 +12,7 @@ import Control.Concurrent (forkIO, threadDelay)
|
|||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import qualified Data.HashTable.IO as H
|
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
|
-- Periodically write a url table to a file
|
||||||
sync :: UrlTable -> FilePath -> IO ()
|
sync :: UrlTable -> FilePath -> IO ()
|
||||||
@ -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 word
|
-- Insert the url in a table and return the name
|
||||||
insert :: UrlTable -> Url -> IO Word
|
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 = wordID url
|
where new = nameHash url
|
||||||
|
|
||||||
-- Lookup a table for the associated url
|
-- Lookup a table for the associated url
|
||||||
extract :: UrlTable -> Word -> IO (Maybe Url)
|
extract :: UrlTable -> Name -> IO (Maybe Url)
|
||||||
extract = H.lookup
|
extract = H.lookup
|
||||||
|
Loading…
Reference in New Issue
Block a user