diff --git a/Application.hs b/Application.hs index 7100616..e09d51b 100644 --- a/Application.hs +++ b/Application.hs @@ -11,6 +11,7 @@ import Web.Frank import Control.Applicative import Control.Monad.IO.Class +import Text.Printf import Data.Maybe import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BL @@ -23,22 +24,25 @@ app runner = do table <- records runner $ controllerApp settings $ do - get "/" $ render "index.html" () - - get "/main.css" $ serveStatic "layouts/main.css" + get "/" (render "index.html" ()) + get "/main.css" (serveStatic "layouts/main.css") get "/:word" $ do word <- queryParam' "word" url <- liftIO (extract table word) - respond $ case url of - Just url -> redirectTo (BS.pack url) - Nothing -> notFound + case url of + Just url -> do + liftIO $ putStrLn (printf "Resolved %s -> %s" word url) + respond $ redirectTo (BS.pack url) + Nothing -> respond notFound post "/short" $ do (form, _) <- parseForm case lookup "url" form of - Just url -> do + Just url' -> do + let url = BS.unpack url' 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)] Nothing -> respond badRequest