45 lines
1.1 KiB
Haskell
45 lines
1.1 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
module Application where
|
||
|
|
|
||
|
|
import Shortener.Common
|
||
|
|
import Shortener.UrlTable
|
||
|
|
|
||
|
|
import Web.Simple
|
||
|
|
import Web.Simple.Static
|
||
|
|
import Web.Simple.Templates
|
||
|
|
import Web.Frank
|
||
|
|
|
||
|
|
import Control.Applicative
|
||
|
|
import Control.Monad.IO.Class
|
||
|
|
import Data.Maybe
|
||
|
|
import Data.Aeson
|
||
|
|
import qualified Data.ByteString.Lazy.Char8 as BL
|
||
|
|
import qualified Data.ByteString.Char8 as BS
|
||
|
|
|
||
|
|
|
||
|
|
app :: (Application -> IO ()) -> IO ()
|
||
|
|
app runner = do
|
||
|
|
settings <- newAppSettings
|
||
|
|
table <- records
|
||
|
|
|
||
|
|
runner $ controllerApp settings $ do
|
||
|
|
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
|
||
|
|
|
||
|
|
post "/short" $ do
|
||
|
|
(form, _) <- parseForm
|
||
|
|
case lookup "url" form of
|
||
|
|
Just url -> do
|
||
|
|
address <- return "http://localhost:3000/"
|
||
|
|
word <- liftIO (insert table (BS.unpack url))
|
||
|
|
render "done.html" $ object ["link" .= (address ++ word)]
|
||
|
|
Nothing -> respond badRequest
|