-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
74 lines (66 loc) · 1.76 KB
/
Main.hs
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
65
66
67
68
69
70
71
72
73
{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings, QuasiQuotes #-}
import Snapper
-- Routes for GET
get [] = do
set "title" "Main Page"
set "result" ""
template "home"
get ["say", msg] = do
set "message" msg
template "echo"
get ("hello":xs) = do
contentType "text/plain"
text $ "Hello: " ++ unwords xs
get _ = pass
-- Routes for POST
post ["add"] = do
status 201
header "X-Powered-By" "Snapper"
res $ addHeader "X-Powered-By" "Snap" -- ditto
ua <- req $ getHeader "User-Agent"
x <- param "x" 0
y <- param "y" 0
set "title" "Added"
set "result" $ show (x+y)
template "home"
post _ = pass
main = snapper routes{ _GET_ = get, _POST_ = post } $ do
-- Inline templates
html "home" [s|
<ul>
<li><a href="hello/1/2/3">Hello</a></li>
<li><a href="say/world">world,</a></li>
<li><a href="echo?message=exclamation;foo=bar">(echo)!</a></li>
</ul>
<hr>
<form action=/add method=post>
<input name=x value=$(_x)> + <input name=y value=$(_y)>
<input type=submit value=Calculate!>
<_result/>
</form>
|]
html "layouts/default" [s|
<html>
<head>
<link rel="stylesheet" type="text/css" href="/screen.css" />
<title><_title/></title>
</head>
<body>
<div id="header">
<h1>Snapper!</h1>
</div>
<div id="content">
<content />
</div>
<div id="footer">
<p><em>
<a href="http://creativecommons.org/publicdomain/zero/1.0">CC0 Universal</a>:
To the extent possible under law, 唐鳳 has waived all copyright and
related or neighboring rights to the <b>Snapper</b> framework.
</em></p>
</div>
</body>
</html>
|]
-- External static directory, and dynamic template directory with .tpl/.xtpl files
return ("static", "templates")