aboutsummaryrefslogtreecommitdiff
path: root/module/main.scm
blob: 924a846c8fd12dbb1f13aba9c326141076f66b8c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
#!/usr/bin/guile \
-e main -s
!#

(add-to-load-path (dirname (current-filename)))

(use-modules (srfi srfi-1)
             (srfi srfi-19)
             (srfi srfi-26)
             (srfi srfi-41)
             (srfi srfi-41 util)
             (util)
             (vcomponent)
             (vcomponent recurrence)
             (vcomponent datetime)

             (output html)
             (output terminal)
             (output none)

             (ice-9 getopt-long)

             (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)
  (define calendars (map make-vcomponent (calendar-files)))
  (define events (concatenate (map (cut children <> 'VEVENT) 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))))

(define (ornull a b)
  (if (null? a)
      b a))

(define (main args)
  (let ((opts (getopt-long args options #:stop-at-first-non-option #t)))
    (init
     (lambda (c e)
       (let ((ropt (ornull (option-ref opts '() '())
                           '("term"))))
         ((case (string->symbol (car ropt))
            ((none) none-main)
            ((html) html-main)
            ((term) terminal-main))
          c e ropt))))
    (newline)))