From 8fefdc707257b2ed1a2fde2c267e6f17d1babd78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 22 May 2019 22:28:29 +0200 Subject: Large work on server software. --- module/server.scm | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) (limited to 'module/server.scm') diff --git a/module/server.scm b/module/server.scm index 063f6fc7..812f2453 100644 --- a/module/server.scm +++ b/module/server.scm @@ -3,8 +3,10 @@ (use-modules* (web (server request response uri)) (output (html)) - (ice-9 (match control rdelim curried-definitions)) - (srfi (srfi-1 srfi-19))) + (server (util macro)) + (ice-9 (match control rdelim curried-definitions + regex #| regex here due to bad macros |# )) + (srfi (srfi-1 srfi-19 srfi-88))) (define month-names '(jan feb mar apr may jun jul aug sep oct nov dec)) @@ -26,6 +28,7 @@ read-string))) ;;; TODO "/static/*" +#; (define (make-handler calendars events) (lambda (request request-body) (format (current-error-port) "[~a] ~a~%" @@ -51,5 +54,26 @@ (ret (build-response #:code 404) "404 Not Fonud")))))))))) +(define* (date key: (year 0) (month 0) (day 0) (hour 0) (minute 0) (second 0) (nsecs 0) (zone 0)) + (make-date nsecs second minute hour day month year zone)) + +(define (make-make-routes calendar events) + (make-routes + + (GET "/" (m) + (let* ((start (if m + (date year: 2019 day: 1 month: (string->number m)) + (current-date))) + (end (set (date-month start) = (+ 1)))) + (return '((content-type text/html)) + (with-output-to-string + (lambda () (html-generate calendar events start end)))))) + + (GET "/static/:filename/" (filename) + ((serve-file return) filename)) + + )) + + (define-public (server-main c e args) - (run-server (make-handler c e))) + (run-server (make-make-routes c e))) -- cgit v1.2.3