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.

14 files changed, 216 insertions, 138 deletions

diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
new file mode 100644
index 00000000..699eebdb
--- /dev/null
+++ b/module/entry-points/html.scm
@@ -0,0 +1,35 @@
+(define-module (entry-points html)
+  :export (main)
+  :use-module (output html)
+  :use-module (util)
+  :use-module (vcomponent)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 util)
+  :use-module (ice-9 getopt-long)
+
+  :use-module (parameters)
+  ;; :use-module (config)
+  )
+
+
+(define opt-spec
+  '((from (value #t) (single-char #\F))
+    (to (value #t) (single-char #\T))
+    (file (value #t) (single-char #\f))
+    (chunked)))
+
+(define (main 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-values (calendars events)
+    (load-calendars
+     calendar-files: (cond [(option-ref opts 'file #f) => list]
+                           [else (calendar-files)]) ))
+
+  (if (option-ref opts 'chunked #f)
+      (html-chunked-main calendars events start)
+      (html-generate calendars events start end)))
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
new file mode 100644
index 00000000..99253160
--- /dev/null
+++ b/module/entry-points/ical.scm
@@ -0,0 +1,30 @@
+(define-module (entry-points ical)
+  :export (main)
+  :use-module (util)
+  :use-module (output ical)
+  :use-module ((vcomponent) :select (load-calendars))
+  :use-module ((parameters) :select (calendar-files))
+  :use-module (ice-9 getopt-long)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 util)
+  )
+
+(define opt-spec
+  '((from (value #t) (single-char #\F))
+    (to (value #t) (single-char #\T))))
+
+(define (main 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-values (calendars events)
+    (load-calendars
+     calendar-files: (cond [(option-ref opts 'file #f) => list]
+                           [else (calendar-files)]) ))
+
+  (ical-main calendars events start end)
+ )
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/server.scm b/module/entry-points/server.scm
index af87a638..4215ab9a 100644
--- a/module/server.scm
+++ b/module/entry-points/server.scm
@@ -1,4 +1,5 @@
-(define-module (server)
+(define-module (entry-points server)
+  :export (main)
   :use-module (util))
 
 (use-modules* (web (server request response uri))
diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm
new file mode 100644
index 00000000..45f9b8eb
--- /dev/null
+++ b/module/entry-points/terminal.scm
@@ -0,0 +1,29 @@
+(define-module (entry-points terminal)
+  :export (main)
+  :use-module (output terminal)
+  :use-module (vcomponent)
+  :use-module (ice-9 getopt-long)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-19 util)
+  :use-module (parameters)
+  :use-module (vulgar)
+  )
+
+(define options
+  '((date (value #t) (single-char #\d))
+    (file (value #t) (single-char #\f))))
+
+(define (main args)
+  (define opts (getopt-long args options))
+  (define-values (calendars events)
+    (load-calendars
+     calendar-files: (cond [(option-ref opts 'file #f) => list]
+                           [else (calendar-files)]) ))
+
+  (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))))
+)
diff --git a/module/entry-points/text.scm b/module/entry-points/text.scm
new file mode 100644
index 00000000..a537b6ac
--- /dev/null
+++ b/module/entry-points/text.scm
@@ -0,0 +1,19 @@
+(define-module (entry-points text)
+  :export (main)
+  :use-module (output text)
+  :use-module (ice-9 getopt-long)
+  :use-module (util io)
+  )
+
+
+(define options
+  '((width (value #t) (single-char #\w))
+    (file (value #t) (single-char #\f))
+    ))
+
+(define (main opts)
+ (for-each (lambda (l) (display l) (newline))
+           (flow-text
+            (with-input-from-port (open-input-port (option-ref opts 'file "-"))
+              (@ (ice-9 rdelim) read-string))
+            #:width (or (string->number (option-ref opts 'width "")) 70))))
diff --git a/module/main.scm b/module/main.scm
index 0727d3ca..72465a50 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -8,22 +8,21 @@ exec guile -e main -s $0 "$@"
 
 (use-modules (srfi srfi-1)
              (srfi srfi-19)
-             (srfi srfi-26)
              (srfi srfi-41)
              (srfi srfi-41 util)
-             (srfi srfi-88)
+             (srfi srfi-88)             ; keyword syntax
+
              (util)
-             (vcomponent)
-             (vcomponent recurrence)
-             (vcomponent datetime)
+             (util io)
+
+             ((entry-points html)     :prefix     html-)
+             ((entry-points terminal) :prefix terminal-)
+             ((entry-points import)   :prefix   import-)
+             ((entry-points text)     :prefix     text-)
+             ((entry-points info)     :prefix     info-)
+             ((entry-points ical)     :prefix     ical-)
 
-             (output html)
-             (output terminal)
-             (output text)
-             (output import)
-             (output info)
-             (output ical)
-             (server)
+             ((entry-points server)   :prefix   server-)
 
              (ice-9 getopt-long)
 
@@ -32,37 +31,9 @@ exec guile -e main -s $0 "$@"
              (parameters)
              (config))
 
-;; Reads all calendar files from disk, and creates a list of "regular" events,
-;; and a stream of "repeating" events, which are passed in that order to the
-;; given procedure @var{proc}.
-;;
-;; Given as a sepparate function from main to ease debugging.
-(define* (init proc #:key (calendar-files (calendar-files)))
-  (define calendars (map parse-cal-path calendar-files))
-  (define events (concatenate
-                  ;; TODO does this drop events?
-                  (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
-                                        (children cal)))
-                       calendars)))
-
-  (let* ((repeating regular (partition repeating? events)))
-
-    (set! repeating (sort*! repeating time<? (extract 'DTSTART))
-          regular   (sort*! regular   time<? (extract 'DTSTART)))
-
-    (proc
-     calendars
-     (interleave-streams
-      ev-time<?
-      (cons (list->stream regular)
-            (map generate-recurrence-set repeating))))))
-
 (define options
   '((mode (value #t) (single-char #\m))
-    (file (value #t) (single-char #\f))
     (output (value #t) (single-char #\o))
-    (format (value #f))
-    (width (value #t) (single-char #\w))
     (statprof (value optional))))
 
 (define (ornull a b)
@@ -76,31 +47,21 @@ exec guile -e main -s $0 "$@"
   (when stprof
     (statprof-start))
 
-  (with-output-to-port (open-output-port (option-ref opts 'output "-"))
+  (with-output-to-port
+      (open-output-port (option-ref opts 'output "-"))
     (lambda ()
-      (if (option-ref opts 'format #f)
-          (for-each (lambda (l) (display l) (newline))
-                    (flow-text
-                     (with-input-from-port (open-input-port (option-ref opts 'file "-"))
-                       (@ (ice-9 rdelim) read-string))
-                     #:width (or (string->number (option-ref opts 'width "")) 70)))
-
-          (init
-           (lambda (c e)
-             (let ((ropt (ornull (option-ref opts '() '())
-                                 '("term"))))
-               ((case (string->symbol (car ropt))
-                  ((html) html-main)
-                  ((term) terminal-main)
-                  ((import) import-main)
-                  ((info) info-main)
-                  ((ical) ical-main)
-                  ((server) server-main)
-                  (else => (lambda (s) (error "Unsupported mode of operation:" s))))
-                c e ropt)))
-           calendar-files: (cond [(option-ref opts 'file #f) => list]
-                                 [else (calendar-files)])
-           ))
+      (let ((ropt (ornull (option-ref opts '() '())
+                          '("term"))))
+        ((case (string->symbol (car ropt))
+           ((html)       html-main)
+           ((term)   terminal-main)
+           ((import)   import-main)
+           ((text)       text-main)
+           ((info)       info-main)
+           ((ical)       ical-main)
+           ((server)   server-main)
+           (else => (lambda (s) (error "Unsupported mode of operation:" s))))
+         ropt))
       (newline)))
 
   (when stprof
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))))))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 0283161e..f40756e2 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -1,8 +1,9 @@
 (define-module (vcomponent)
   :use-module (vcomponent base)
   :use-module (vcomponent parse)
+  :use-module (vcomponent load)
   :use-module (util)
-  :re-export (make-vcomponent parse-cal-path parse-calendar))
+  :re-export (make-vcomponent parse-cal-path
+                              parse-calendar load-calendars))
 
 (re-export-modules (vcomponent base))
-
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index aa5b9de9..bf15510d 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -26,7 +26,7 @@
   (children children set-component-children!)
   (parent get-component-parent set-component-parent!)
   (attributes get-component-attributes))
-(export children type)
+(export vcomponent? children type)
 
 ;; TODO should this also update the parent
 (define-public parent
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
new file mode 100644
index 00000000..fb25732d
--- /dev/null
+++ b/module/vcomponent/load.scm
@@ -0,0 +1,39 @@
+(define-module (vcomponent load)
+  :export (load-calendars)
+  :use-module (util)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-19)
+  :use-module (srfi srfi-41)
+  :use-module (srfi srfi-41 util)
+  :use-module (parameters)
+  ;; :use-module (vcomponent)
+  :use-module (vcomponent base)
+  :use-module ((vcomponent parse) :select (parse-cal-path))
+  :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
+  :use-module ((vcomponent datetime) :select (ev-time<?)))
+
+
+;; Reads all calendar files from disk, and creates a list of "regular" events,
+;; and a stream of "repeating" events, which are passed in that order to the
+;; given procedure @var{proc}.
+;;
+;; Given as a sepparate function from main to ease debugging.
+(define* (load-calendars #:key (calendar-files (calendar-files)))
+  (define calendars (map parse-cal-path calendar-files))
+  (define events (concatenate
+                  ;; TODO does this drop events?
+                  (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
+                                        (children cal)))
+                       calendars)))
+
+  (let* ((repeating regular (partition repeating? events)))
+
+    (set! repeating (sort*! repeating time<? (extract 'DTSTART))
+          regular   (sort*! regular   time<? (extract 'DTSTART)))
+
+    (values
+     calendars
+     (interleave-streams
+      ev-time<?
+      (cons (list->stream regular)
+            (map generate-recurrence-set repeating))))))