aboutsummaryrefslogtreecommitdiff
path: root/module/output
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-12-23 23:40:14 +0100
committerHugo Hörnquist <hugo@hornquist.se>2019-12-24 00:02:02 +0100
commit92b2f429a06ed9b052baff5e27f012397b338f6a (patch)
tree0ca9c2d8d1d72f5c898ee8384c2ef5459c1ef112 /module/output
parentMove open-{input,output}-port to (util io). (diff)
downloadcalp-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.scm53
-rw-r--r--module/output/ical.scm17
-rw-r--r--module/output/terminal.scm15
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))))))