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/output/html.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 '')
-rw-r--r-- | module/output/html.scm | 53 |
1 files changed, 15 insertions, 38 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index a9643fc3..21713455 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -11,8 +11,6 @@ #:use-module (srfi srfi-19 util) #:use-module (output general) - #:use-module (ice-9 getopt-long) - #:use-module (git) #:use-module (parameters) #:use-module (config)) @@ -297,39 +295,18 @@ (div (@ (class "eventlist")) ,@(stream->list (stream-map fmt-day evs))))))))) -(define opt-spec - '((from (value #t) (single-char #\f)) - (to (value #t) (single-char #\t)) - (chunked) - ) - ) - -(define-public (html-main calendars events args) - (define opts (getopt-long args opt-spec)) - - (cond [(option-ref opts 'chunked #f) - (let* ((start (cond [(option-ref opts 'from #f) => parse-freeform-date] - [else (start-of-month (current-date))]))) - - (stream-for-each (lambda (pair) - (format (current-error-port) "d = ~a~%u = ~a~%" (car pair) (cadr pair)) - (let ((fname (format #f "./html/~a.html" (date->string (car pair) "~1")))) - (format (current-error-port) "Writing to [~a]~%" fname) - (with-output-to-file fname - (lambda () (apply html-generate calendars events pair))))) - (let ((ms (month-stream start))) - (stream-take - 12 (stream-zip - ms (stream-map (lambda (d) (normalize-date - (set (date-day d) = (- 1)))) - (stream-cdr ms)))) - ))) - - - ] - [else - (let* ((start (cond [(option-ref opts 'from #f) => parse-freeform-date] - [else (start-of-month (current-date))])) - (end (cond [(option-ref opts 'to #f) => parse-freeform-date] - [else (normalize-date* (set (date-month start) = (+ 1)))]))) - (html-generate calendars events start end))])) + +(define-public (html-chunked-main calendars events start) + (stream-for-each (lambda (pair) + (format (current-error-port) "d = ~a~%u = ~a~%" (car pair) (cadr pair)) + (let ((fname (format #f "./html/~a.html" (date->string (car pair) "~1")))) + (format (current-error-port) "Writing to [~a]~%" fname) + (with-output-to-file fname + (lambda () (apply html-generate calendars events pair))))) + (let ((ms (month-stream start))) + (stream-take + 12 (stream-zip + ms (stream-map (lambda (d) (normalize-date + (set (date-day d) = (- 1)))) + (stream-cdr ms)))) + ))) |