diff --git a/spidercat.scm b/spidercat.scm index 12c9edb..c18bc63 100644 --- a/spidercat.scm +++ b/spidercat.scm @@ -16,6 +16,7 @@ ;; (import scheme + (chicken io) (chicken string) (chicken irregex) (chicken pretty-print) srfi-1 (prefix chatdir chatdir:) (prefix intarweb intarweb:) @@ -23,16 +24,64 @@ (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. -(define (get-handler irc-dir request continue) +(define (http-get irc-dir request continue) (let ([path (uri:uri-path (intarweb:request-uri request))]) - (if (starts-with? path '(/)) - (spiffy:send-response status: 'ok body: "

Index ♥

") - (continue)))) + (cond [(starts-with? path '(/ "room")) + (http-get-room irc-dir request 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: "

Index ♥

")] + [#t + (continue)]))) ;; Handle all POST requests. -(define (post-handler irc-dir request continue) +(define (http-post irc-dir request continue) (continue)) @@ -42,9 +91,9 @@ (let* ([request (spiffy:current-request)] [request-type (intarweb:request-method request)]) (cond [(eq? request-type 'GET) - (get-handler irc-dir request continue)] + (http-get irc-dir request continue)] [(eq? request-type 'POST) - (post-handler irc-dir request continue)] + (http-post irc-dir request continue)] [#t (intarweb:continue)])))) @@ -52,11 +101,12 @@ ;; Kick off the HTTP server. (define (start-server irc-dir) (spiffy:vhost-map `((".*" . ,(make-http-handler irc-dir)))) + (spiffy:root-path irc-dir) (spiffy:start-server port: 8080)) ;; 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= = (take list (length list-start)) list-start)) diff --git a/templates/room-list-item.html b/templates/room-list-item.html new file mode 100644 index 0000000..5e37ed3 --- /dev/null +++ b/templates/room-list-item.html @@ -0,0 +1,6 @@ + +
+ {{ROOM_TITLE}} +

{{LAST_MESSAGE}}

+
+ diff --git a/templates/room-list.html b/templates/room-list.html new file mode 100644 index 0000000..8b88cd3 --- /dev/null +++ b/templates/room-list.html @@ -0,0 +1,11 @@ + + + + Rooms + + + + + {{LIST_ITEMS}} + + diff --git a/templates/style.css b/templates/style.css new file mode 100644 index 0000000..071ebfa --- /dev/null +++ b/templates/style.css @@ -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; +}