{-# 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 Text.Printf 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 (baseUrl,_) <- serverSettings 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) 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 let url = BS.unpack url' word <- liftIO (insert table url) liftIO $ putStrLn (printf "Registered %s -> %s " url word) render "done.html" $ object ["link" .= (baseUrl ++ word)] Nothing -> respond badRequest