diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-12-23 23:40:14 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-12-24 00:02:02 +0100 |
commit | 92b2f429a06ed9b052baff5e27f012397b338f6a (patch) | |
tree | 0ca9c2d8d1d72f5c898ee8384c2ef5459c1ef112 /module/server.scm | |
parent | Move open-{input,output}-port to (util io). (diff) | |
download | calp-92b2f429a06ed9b052baff5e27f012397b338f6a.tar.gz calp-92b2f429a06ed9b052baff5e27f012397b338f6a.tar.xz |
Rework program initialization.
Old init setup had the fancy idea to parse all files before anything
could be done with them. This however led to problems when a part of the
program which didn't care for the calendar files (such as text
formatting).
It also made testing performance almost impossible since to much code
was run before I had a chance to init statprof.
Diffstat (limited to 'module/server.scm')
-rw-r--r-- | module/server.scm | 89 |
1 files changed, 0 insertions, 89 deletions
diff --git a/module/server.scm b/module/server.scm deleted file mode 100644 index af87a638..00000000 --- a/module/server.scm +++ /dev/null @@ -1,89 +0,0 @@ -(define-module (server) - :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)) |