rnhmjoj/breve
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use printf for logging

Browse Source
This commit is contained in:
rnhmjoj 2015-04-08 13:56:05 +02:00
parent 90afb6593b
commit f5157016db
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Application.hs
View File

@ -11,6 +11,7 @@ import Web.Frank
import Control.Applicative import Control.Applicative
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Text.Printf
import Data.Maybe import Data.Maybe
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.ByteString.Lazy.Char8 as BL
@ -23,22 +24,25 @@ app runner = do
table <- records table <- records
runner $ controllerApp settings $ do runner $ controllerApp settings $ do
get "/" $ render "index.html" () get "/" (render "index.html" ())
get "/main.css" (serveStatic "layouts/main.css")
get "/main.css" $ serveStatic "layouts/main.css"
get "/:word" $ do get "/:word" $ do
word <- queryParam' "word" word <- queryParam' "word"
url <- liftIO (extract table word) url <- liftIO (extract table word)
respond $ case url of case url of
Just url -> redirectTo (BS.pack url) Just url -> do
Nothing -> notFound liftIO $ putStrLn (printf "Resolved %s -> %s" word url)
respond $ redirectTo (BS.pack url)
Nothing -> respond notFound
post "/short" $ do post "/short" $ do
(form, _) <- parseForm (form, _) <- parseForm
case lookup "url" form of case lookup "url" form of
Just url -> do Just url' -> do
let url = BS.unpack url'
address <- return "http://localhost:3000/" address <- return "http://localhost:3000/"
word <- liftIO (insert table (BS.unpack url)) word <- liftIO (insert table url)
liftIO $ putStrLn (printf "Registered %s -> %s " url word)
render "done.html" $ object ["link" .= (address ++ word)] render "done.html" $ object ["link" .= (address ++ word)]
Nothing -> respond badRequest Nothing -> respond badRequest