Room-list page and HTML templating
This commit is contained in:
parent
8173fe25ed
commit
d919194fe7
|
@ -16,6 +16,7 @@
|
||||||
;;
|
;;
|
||||||
|
|
||||||
(import scheme
|
(import scheme
|
||||||
|
(chicken io) (chicken string) (chicken irregex) (chicken pretty-print)
|
||||||
srfi-1
|
srfi-1
|
||||||
(prefix chatdir chatdir:)
|
(prefix chatdir chatdir:)
|
||||||
(prefix intarweb intarweb:)
|
(prefix intarweb intarweb:)
|
||||||
|
@ -23,16 +24,64 @@
|
||||||
(prefix uri-common uri:))
|
(prefix uri-common uri:))
|
||||||
|
|
||||||
|
|
||||||
|
(define (sanitize-html text)
|
||||||
|
(irregex-replace/all
|
||||||
|
"{" (spiffy:htmlize text) "{"))
|
||||||
|
|
||||||
|
|
||||||
|
(define (html-from-template template-file variables-alist)
|
||||||
|
(let ([text (call-with-input-file template-file
|
||||||
|
(lambda (in-port) (read-string #f in-port)))])
|
||||||
|
(map (lambda (variable-pair)
|
||||||
|
(set! text
|
||||||
|
(irregex-replace/all
|
||||||
|
(string-append "{{" (car variable-pair) "}}")
|
||||||
|
text
|
||||||
|
(cdr variable-pair))))
|
||||||
|
variables-alist)
|
||||||
|
text))
|
||||||
|
|
||||||
|
|
||||||
|
(define (room-listing-html irc-dir)
|
||||||
|
(html-from-template
|
||||||
|
"templates/room-list.html"
|
||||||
|
`(("LIST_ITEMS"
|
||||||
|
. ,(reduce-right
|
||||||
|
string-append
|
||||||
|
""
|
||||||
|
(map (lambda (room)
|
||||||
|
(html-from-template
|
||||||
|
"templates/room-list-item.html"
|
||||||
|
`(("ROOM_TITLE" . ,room)
|
||||||
|
("ROOM_ID" . ,room)
|
||||||
|
("LAST_MESSAGE" . "nekonata: Lorem ipso facto…"))))
|
||||||
|
(chatdir:channels irc-dir)))))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (http-get-room irc-dir #!optional request continue)
|
||||||
|
(spiffy:send-response status: 'ok
|
||||||
|
body: (room-listing-html irc-dir)))
|
||||||
|
|
||||||
|
|
||||||
;; Handle all GET requests.
|
;; Handle all GET requests.
|
||||||
(define (get-handler irc-dir request continue)
|
(define (http-get irc-dir request continue)
|
||||||
(let ([path (uri:uri-path (intarweb:request-uri request))])
|
(let ([path (uri:uri-path (intarweb:request-uri request))])
|
||||||
(if (starts-with? path '(/))
|
(cond [(starts-with? path '(/ "room"))
|
||||||
(spiffy:send-response status: 'ok body: "<h1>Index ♥</h1>")
|
(http-get-room irc-dir request continue)]
|
||||||
(continue))))
|
[(starts-with? path '(/ "style.css"))
|
||||||
|
(spiffy:send-response
|
||||||
|
status: 'ok
|
||||||
|
body: (call-with-input-file "templates/style.css"
|
||||||
|
(lambda (in-port) (read-string #f in-port)))
|
||||||
|
headers: '((content-type "text/css")))]
|
||||||
|
[(list= equal? path '(/))
|
||||||
|
(spiffy:send-response status: 'ok body: "<h1>Index ♥</h1>")]
|
||||||
|
[#t
|
||||||
|
(continue)])))
|
||||||
|
|
||||||
|
|
||||||
;; Handle all POST requests.
|
;; Handle all POST requests.
|
||||||
(define (post-handler irc-dir request continue)
|
(define (http-post irc-dir request continue)
|
||||||
(continue))
|
(continue))
|
||||||
|
|
||||||
|
|
||||||
|
@ -42,9 +91,9 @@
|
||||||
(let* ([request (spiffy:current-request)]
|
(let* ([request (spiffy:current-request)]
|
||||||
[request-type (intarweb:request-method request)])
|
[request-type (intarweb:request-method request)])
|
||||||
(cond [(eq? request-type 'GET)
|
(cond [(eq? request-type 'GET)
|
||||||
(get-handler irc-dir request continue)]
|
(http-get irc-dir request continue)]
|
||||||
[(eq? request-type 'POST)
|
[(eq? request-type 'POST)
|
||||||
(post-handler irc-dir request continue)]
|
(http-post irc-dir request continue)]
|
||||||
[#t
|
[#t
|
||||||
(intarweb:continue)]))))
|
(intarweb:continue)]))))
|
||||||
|
|
||||||
|
@ -52,11 +101,12 @@
|
||||||
;; Kick off the HTTP server.
|
;; Kick off the HTTP server.
|
||||||
(define (start-server irc-dir)
|
(define (start-server irc-dir)
|
||||||
(spiffy:vhost-map `((".*" . ,(make-http-handler irc-dir))))
|
(spiffy:vhost-map `((".*" . ,(make-http-handler irc-dir))))
|
||||||
|
(spiffy:root-path irc-dir)
|
||||||
(spiffy:start-server port: 8080))
|
(spiffy:start-server port: 8080))
|
||||||
|
|
||||||
|
|
||||||
;; Check if a `list` begins with the elements of another list.
|
;; Check if a `list` begins with the elements of another list.
|
||||||
(define (starts-with? list list-start #!optional (= eq?))
|
(define (starts-with? list list-start #!optional (= equal?))
|
||||||
(list= =
|
(list= =
|
||||||
(take list (length list-start))
|
(take list (length list-start))
|
||||||
list-start))
|
list-start))
|
||||||
|
|
|
@ -0,0 +1,6 @@
|
||||||
|
<a href="/room/{{ROOM_ID}}/">
|
||||||
|
<div class="room-list-item" id="{{ROOM_ID}}">
|
||||||
|
<b>{{ROOM_TITLE}}</b>
|
||||||
|
<p>{{LAST_MESSAGE}}</p>
|
||||||
|
</div>
|
||||||
|
</a>
|
|
@ -0,0 +1,11 @@
|
||||||
|
<!DOCTYPE HTML>
|
||||||
|
<html lang="en">
|
||||||
|
<head>
|
||||||
|
<title>Rooms</title>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||||
|
<link rel="stylesheet" href="/style.css" type="text/css">
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
{{LIST_ITEMS}}
|
||||||
|
</body>
|
||||||
|
</html>
|
|
@ -0,0 +1,15 @@
|
||||||
|
.room-list-item {
|
||||||
|
background-color: #d7d7af;
|
||||||
|
}
|
||||||
|
|
||||||
|
.room-list-item {
|
||||||
|
color: black;
|
||||||
|
}
|
||||||
|
|
||||||
|
.room-list-item:hover {
|
||||||
|
background-color: #d7ff87;
|
||||||
|
}
|
||||||
|
|
||||||
|
.room-list-item:target {
|
||||||
|
background-color: #5fafd7;
|
||||||
|
}
|
Reference in New Issue