diff options
Diffstat (limited to 'module/entry-points/server.scm')
-rw-r--r-- | module/entry-points/server.scm | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm new file mode 100644 index 00000000..4215ab9a --- /dev/null +++ b/module/entry-points/server.scm @@ -0,0 +1,90 @@ +(define-module (entry-points server) + :export (main) + :use-module (util)) + +(use-modules* (web (server request response uri)) + (output (html)) + (server (util macro)) + (sxml (simple)) + (ice-9 (match control rdelim curried-definitions ftw + getopt-long + iconv regex #| regex here due to bad macros |# )) + (srfi (srfi-1 srfi-19 srfi-88))) + +(use-modules (srfi srfi-19 util)) + +(define (file-extension name) + (car (last-pair (string-split name #\.)))) + +(define (sxml->xml-string sxml) + (with-output-to-string + (lambda () (sxml->xml sxml)))) + +(define (directory-table dir) + `(table + (thead + (tr (th "Name") (th "Type") (th "Perm"))) + (tbody + ,@(map (lambda (kv) + (let* (((k stat) kv)) + `(tr (td (a (@ (href ,dir ,k)) ,k)) + (td ,(stat:type stat)) + (td ,(number->string (stat:perms stat) 8))))) + (cddr (file-system-tree dir)))))) + + +(define (make-make-routes calendar events) + (make-routes + + (GET "/" (y m) ; m in [1, 12] + (let* ((cd (current-date)) + (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" () + (return + '((content-type text/html)) + (sxml->xml-string + (directory-table "static/")))) + + (GET "/static/:filename" (filename) + (return + `((content-type ,(case (string->symbol (file-extension filename)) + ((js) 'text/javascript) + ((css) 'text/css)))) + (call-with-input-file (string-append "static/" filename) read-string))) + + (GET "/count" () + ;; (sleep 1) + (return '((content-type text/plain)) + (string-append (number->string state) "\n") + (1+ state))) + + )) + +(define options + '((port (value #t) (single-char #\p)) + (addr (value #t)))) + +(define-public (server-main c e args) + + (define opts (getopt-long args options)) + (define port (option-ref opts 'port 8080)) + (define addr (option-ref opts 'addr INADDR_LOOPBACK)) + + + (format #t "Starting server on ~a:~a~%I'm ~a, runing from ~a~%" + (number->string addr 16) port + (getpid) (getcwd)) + + (run-server (make-make-routes c e) + 'http + `(port: ,port + addr: ,addr) + 0)) |