1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Web.Scotty
import Control.Concurrent.MVar
import Control.Monad.IO.Class
import qualified Data.Map as M
import qualified Data.Text.Lazy as T
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.Static
import Prelude ()
import Prelude.Compat
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes
-- Note:
-- Scotty does not require blaze-html or
-- wai-middleware-static, but this example does
-- cabal install blaze-html wai-middleware-static
import Text.Blaze.Html.Renderer.Text (renderHtml)
-- TODO:
-- Implement some kind of session and/or cookies
-- Add links
main :: IO ()
main = do
m <- newMVar (0::Int,M.empty :: M.Map Int T.Text)
scotty 3000 $ do
middleware logStdoutDev
middleware static
get "/" $ do
html $ renderHtml
$ H.html $ do
H.body $ do
H.form H.! method "post" H.! action "/shorten" $ do
H.input H.! type_ "text" H.! name "url"
H.input H.! type_ "submit"
post "/shorten" $ do
url <- param "url"
liftIO $ modifyMVar_ m $ \(i,db) -> return (i+1, M.insert i (T.pack url) db)
redirect "/list"
-- We have to be careful here, because this route can match pretty much anything.
-- Thankfully, the type system knows that 'hash' must be an Int, so this route
-- only matches if 'read' can successfully parse the hash capture as an Int.
-- Otherwise, the pattern match will fail and Scotty will continue matching
-- subsequent routes.
get "/:hash" $ do
hash <- param "hash"
(_,db) <- liftIO $ readMVar m
case M.lookup hash db of
Nothing -> raise $ mconcat ["URL hash #", T.pack $ show $ hash, " not found in database!"]
Just url -> redirect url
-- We put /list down here to show that it will not match the '/:hash' route above.
get "/list" $ do
(_,db) <- liftIO $ readMVar m
json $ M.toList db
|
