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 | |
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/entry-points/import.scm (renamed from module/output/import.scm) | 10 | ||||
-rw-r--r-- | module/entry-points/info.scm (renamed from module/output/info.scm) | 8 | ||||
-rw-r--r-- | module/output/html.scm | 53 | ||||
-rw-r--r-- | module/output/ical.scm | 17 | ||||
-rw-r--r-- | module/output/terminal.scm | 15 |
5 files changed, 33 insertions, 70 deletions
diff --git a/module/output/import.scm b/module/entry-points/import.scm index 47f4fd47..5558433b 100644 --- a/module/output/import.scm +++ b/module/entry-points/import.scm @@ -1,5 +1,8 @@ -(define-module (output import) - :use-module (util)) +(define-module (entry-points import) + :export (main) + :use-module (util) + :use-module (ice-9 getopt-long) + ) (define options '((calendar (value #t) (single-char #\c)) @@ -29,3 +32,6 @@ ) + +(define (main . _) + 'noop) diff --git a/module/output/info.scm b/module/entry-points/info.scm index eba0979c..7bc898b2 100644 --- a/module/output/info.scm +++ b/module/entry-points/info.scm @@ -1,4 +1,5 @@ -(define-module (output info) +(define-module (entry-points info) + :export (main) :use-module (util)) (use-modules (ice-9 getopt-long) @@ -7,7 +8,10 @@ (vulgar color) (srfi srfi-1)) -(define-public (info-main calendars events args) +(define (main args) + (define-values (calendars events) + (load-calendars)) + (format #t "~%Found ~a calendars, named:~%~{ - [~4@a] ~a~a\x1b[m~%~}~%" (length calendars) (concatenate 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)))) + ))) diff --git a/module/output/ical.scm b/module/output/ical.scm index fcb75526..3dbc74b8 100644 --- a/module/output/ical.scm +++ b/module/output/ical.scm @@ -1,5 +1,4 @@ (define-module (output ical) - :use-module (ice-9 getopt-long) :use-module (ice-9 format) :use-module (ice-9 match) :use-module (util) @@ -11,14 +10,11 @@ :use-module (srfi srfi-41 util) ) -(define opt-spec - '((from (value #t) (single-char #\f)) - (to (value #t) (single-char #\t)))) ;; Format value depending on key type. ;; Should NOT emit the key. (define (value-format key vline) - (catch 'wrong-type-arg + (with-throw-handler 'wrong-type-arg (lambda () (case key ((DTSTART DTEND) @@ -38,7 +34,7 @@ (else (escape-chars (value vline))))) (lambda (err caller fmt args call-args) (format (current-error-port) - "WARNING: ~k~%" fmt args) + "WARNING: key = ~a, caller = ~s, call-args = ~s~%~k~%" key caller call-args fmt args) (with-output-to-string (lambda () (display (value vline)))) ))) @@ -101,14 +97,7 @@ CALSCALE:GREGORIAN\r (define (print-footer) (format #t "END:VCALENDAR\r\n")) -(define-public (ical-main calendars events args) - (define opts (getopt-long args opt-spec)) - - (define start (cond [(option-ref opts 'from #f) => parse-freeform-date] - [else (start-of-month (current-date))])) - (define end (cond [(option-ref opts 'to #f) => parse-freeform-date] - [else (normalize-date* (set (date-month start) = (+ 1)))])) - +(define-public (ical-main calendars events start end) (print-header) (let ((tzs (make-hash-table))) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 16ba31e9..5d8a5a24 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -19,11 +19,10 @@ #:use-module (vcomponent datetime) #:use-module (ice-9 format) - #:use-module (ice-9 getopt-long) #:use-module (parameters) #:use-module (config) - #:export (terminal-main)) + #:export (main-loop)) (define (open-in-editor fname) @@ -150,15 +149,3 @@ (memv char '(#\q))) (break))) )))) - -(define options - '((date (value #t) (single-char #\d)))) - -(define (terminal-main calendars events args) - (let ((opts (getopt-long args options))) - (let ((time (date->time-utc - (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date) - (current-date)))))) - ;; (format (current-error-port) "len(events) = ~a~%" (stream-length events)) - (with-vulgar - (lambda () (main-loop time events)))))) |