(define-module (entry-points server) :use-module (util) :use-module (util app) :use-module (util config) :use-module (util options) :use-module (srfi srfi-1) :use-module (ice-9 match) :use-module (ice-9 control) :use-module (ice-9 rdelim) :use-module (ice-9 curried-definitions) :use-module (ice-9 ftw) :use-module (ice-9 getopt-long) :use-module (ice-9 iconv) :use-module (ice-9 regex) #| regex here due to bad macros |# :use-module (web server) :use-module (web request) :use-module (web response) :use-module (web uri) :use-module (web http) :use-module (sxml simple) :use-module (server util) :use-module (server macro) :use-module (vcomponent) :use-module (datetime) :use-module (datetime util) :use-module (output html) :use-module (output ical) :export (main) ) (define (file-extension name) (car (last-pair (string-split name #\.)))) (define (sxml->html-string sxml) (with-output-to-string (lambda () (display "\n") (sxml->xml sxml)))) (define (// . args) (string-join args file-name-separator-string )) (define (directory-table dir) `(table (thead (tr (th "") (th "Name") (th "Perm"))) (tbody ,@(map (lambda (k) (let* ((stat (lstat (// dir k)))) `(tr (td ,(case (stat:type stat) [(directory) "📁"] [(regular) "📰"] [else "🙃"])) (td (a (@ (href "/" ,dir "/" ,k)) ,k)) (td ,(number->string (stat:perms stat) 8))))) (cdr (scandir dir)))))) (define-method (make-make-routes) (make-routes (GET "/week/:start-date.html" (start-date) (let* ((start-date (start-of-week (parse-iso-date start-date) (get-config 'week-start)))) (return '((content-type text/html)) (with-output-to-string (lambda () (html-generate calendars: (getf 'calendars) events: (getf 'event-set) start-date: start-date end-date: (date+ start-date (date day: 6)) next-start: (lambda (d) (date+ d (date day: 7))) prev-start: (lambda (d) (date- d (date day: 7))) render-calendar: render-calendar intervaltype: 'week )))))) (GET "/month/:start-date.html" (start-date) (let* ((start-date (parse-iso-date start-date))) (return '((content-type text/html)) (with-output-to-string (lambda () (html-generate calendars: (getf 'calendars) events: (getf 'event-set) start-date: start-date end-date: (date- (month+ start-date) (date day: 1)) next-start: month+ prev-start: month- ;; internally rounds start-date to start of month render-calendar: render-calendar-table pre-start: (start-of-week start-date) post-end: (end-of-week (end-of-month start-date)) intervaltype: 'month )))))) ;; Get specific page by query string instead of by path. ;; Useful for