diff options
Diffstat (limited to 'main.scm')
| -rw-r--r-- | main.scm | 68 |
1 files changed, 39 insertions, 29 deletions
@@ -50,7 +50,7 @@ ; (port (request-port request))) ; (read-u8vector len port))) -(define style (read-string #f +(define stylesheet (read-string #f (open-input-file "./style.css" #:text))) (define (top-posts) (map-row list db @@ -59,7 +59,7 @@ LEFT JOIN posts c ON c.id = p.parent_id WHERE c.parent_id IS NULL GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id - ORDER BY count(c.id) DESC LIMIT 25")) + ORDER BY count(c.id) DESC, p.created_at DESC LIMIT 25")) @@ -80,7 +80,7 @@ LEFT JOIN posts c ON c.id = p.parent_id WHERE c.parent_id IS ? GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id - ORDER BY count(c.id) DESC LIMIT 25" post-id)) + ORDER BY count(c.id) DESC, p.created_at DESC LIMIT 25" post-id)) ;(define (top-posts) (map-row list db ; "SELECT id, user_id, content, created_at @@ -96,7 +96,7 @@ (define (parent-id p) (fifth p)) (define (children-count p) (sixth p)) -(define users (alist->hash-table '(("dan" . "pw")))) +(define users (alist->hash-table '(("lawrence" . "pw") ("demo" . "pw") ("dan" . "pw")))) (define apikeys (make-hash-table)) @@ -134,7 +134,9 @@ (define (page inner) (with-output-to-string (lambda () (sxml-display-as-html - `(html (head (style ,style)) + `(html (head + (link (@ [rel "stylesheet"] [href "/style.css"])) + (meta (@ [name "viewport"] [content "width=device-width, initial-scale=1"]))) (body ; (h1 "Title") ; (a (@ [href "/"]) "Back") @@ -151,7 +153,10 @@ (input (@ [id "submit"] [type "submit"] [value "Submit"]))))) (define (vote-to-flush-prompt) - (let ([prompts '("Flush it all away!")]) ; "Drain the swamp!" "Unclog the bog!")]) + (let ([prompts '("Flush it all away!" + "Drain the swamp!" + "Unclog the bog!" + "Vote for a Purge!")]) (list-ref prompts (pseudo-random-integer (length prompts))))) @@ -186,6 +191,12 @@ (define routes `( + (GET (/ "style.css") ,(lambda (rt) + (send-response + headers: `((content-type text/css)) + status: 'ok + body: stylesheet + ))) (GET (/ "unvote") ,(lambda (rt) (unvote (get-current-user)) (send-response @@ -239,24 +250,22 @@ status: 'ok body: (posts-page current-user displayed-posts))))) - - -(GET (/ "posts" ":id") ,(lambda (rt) - (let* ([current-user (get-current-user)] - [post-id (get-route-param rt "id")] - [post (get-post post-id)] - [comments (get-child-posts post-id)] - [displayed-posts (cons post comments)]) - (send-response - headers: '((content-type text/html)) - status: 'ok - body: (posts-page current-user displayed-posts))))) - -(GET (/ "posts") ,(lambda (rt) - (send-response - headers: `((location "/")) - status: 'see-other - ))) + (GET (/ "posts" ":id") ,(lambda (rt) + (let* ([current-user (get-current-user)] + [post-id (get-route-param rt "id")] + [post (get-post post-id)] + [comments (get-child-posts post-id)] + [displayed-posts (cons post comments)]) + (send-response + headers: '((content-type text/html)) + status: 'ok + body: (posts-page current-user displayed-posts))))) + + (GET (/ "posts") ,(lambda (rt) + (send-response + headers: `((location "/")) + status: 'see-other + ))) )) @@ -281,12 +290,13 @@ (second r)))) routes)) -(define (handle-greeting continue) +(define (handle continue) (let* ((uri (request-uri (current-request))) (method (request-method (current-request))) - (route (find-route uri method)) - (handler (third route))) - (handler route))) + (route (find-route uri method))) + (if route + ((third route) route) + (begin (display uri ) (display method) (send-status 'not-found "Page Not Found"))))) -(vhost-map `(("localhost" . ,handle-greeting))) +(vhost-map `((".*" . ,handle))) (start-server port: 7080) |