aboutsummaryrefslogtreecommitdiff
path: root/config.scm
blob: f234c81ea57987d0e08a91ba4c313f809d23b17f (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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
;;; Preliminary config file for the system.
;;; Currently loaded by main, and requires that `calendar-files`
;;; is set to a list of files (or directories).

(use-modules (vcomponent))

(use-modules (srfi srfi-88)
             (ice-9 regex)
             ;; (ice-9 rdelim)
             (sxml simple)
             (glob)

             (util config)
             )

(set-config! 'calendar-files (glob "~/.local/var/cal/*"))

;;; TODO possibly replace with propper lookup
(define my-courses
  '((TSEA82 . "Datorteknik")
    (TFYA19 . "Kvantdatorer")
    (TATA42 . "Tvåvarren")
    (TSRT04 . "Matlab")
    (TDDC78 . "Paralellprogrammering")
    (TDDB68 . "Pintos")))

(define* (aref alist key optional: default)
  (or (assoc-ref alist key) default key))

(set-config! 'summary-filter
 (lambda (ev str)
   (regexp-substitute/global
    #f "T[A-Z]{3}[0-9]{2}" str
    'pre (lambda (m) (aref my-courses (string->symbol (match:substring m))))
    'post)))

(define (a link) `(a (@ (href ,link)) ,link))

(define (parse-html str)
  ;; extra space to ensure that we don't get a self closing
  ;; div tag in the final output
  ;; TODO Fix a real sxml->html   | The space
  ;; method instead of pretending |
  ;; that HTML is XML.            v
  (xml->sxml (string-append "<div> " str "</div>")
             default-entity-handler:
             (lambda (port name)
               (case name
                 [(nbsp) " "]
                 [else (symbol->string name)]))) )

(define (parse-links str)
  (define regexp (make-regexp "https?://\\S+"))
  (let recur ((str str))
    (let ((m (regexp-exec regexp str)))
      (if (not m)
          (list str)
          (cons* (match:prefix m)
                 (a (match:substring m))
                 (recur (match:suffix m)))))))

(set-config! 'description-filter
 (lambda (ev str)
   (cond [(member (attr (parent ev) 'NAME)
                  '("D-sektionens officiella kalender" "LiTHe kod"))
          (parse-html (regexp-substitute/global
                        #f "<br>" str
                        'pre "<br/>" 'post))]
         [(member (attr (parent ev) 'NAME)
                  '("Nolle-P"))
          (parse-html
           (regexp-substitute/global
            #f "STAB(EN)?\\w*" str
            'pre
            (lambda (m)
              (string-append "<span class='staben'>"
                             (match:substring m)
                             "</span>"))
            'post))]
         [else (parse-links str)])))

(set-config! 'week-start (@ (datetime util) mon))