From c789080f28a72884171b43a93ee8001ebb9a2bd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 22 Aug 2020 19:14:36 +0200 Subject: Move more places to use path-append. --- module/calp/server/routes.scm | 6 +- module/vcomponent/vdir/parse.scm | 147 +++++++++++++++++++-------------------- 2 files changed, 75 insertions(+), 78 deletions(-) diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 697f2e50..29a620b0 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -42,15 +42,13 @@ -(define (// . args) (string-join args file-name-separator-string )) - (define (directory-table dir) `(table (thead (tr (th "") (th "Name") (th "Perm"))) (tbody ,@(map (lambda (k) - (let* ((stat (lstat (// dir k)))) + (let* ((stat (lstat (path-append dir k)))) `(tr (td ,(case (stat:type stat) [(directory) "📁"] [(regular) "📰"] @@ -406,7 +404,7 @@ (return '((content-type text/html)) (sxml->html-string - (directory-table (// "static" *))))) + (directory-table (path-append "static" *))))) (GET "/count" () diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm index c4b1b694..e2fc37a1 100644 --- a/module/vcomponent/vdir/parse.scm +++ b/module/vcomponent/vdir/parse.scm @@ -25,78 +25,77 @@ ;; themselves. Therefore, a simple comparison should work, ;; and then the TZOFFSETTO properties can be subtd. (define-public (parse-vdir path) - (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) - (let ((color - (catch 'system-error - (lambda () (call-with-input-file (/ path "color") read-line)) - (const "#FFFFFF"))) - (name - (catch 'system-error - (lambda () (call-with-input-file (/ path "displayname") read-line)) - (const #f)))) - - (reduce (lambda (item calendar) - - (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e))) - (children item))) - - - ;; (assert (eq? 'VCALENDAR (type calendar))) - (assert (eq? 'VCALENDAR (type item))) - - (for child in (children item) - (set! (prop child '-X-HNH-FILENAME) - (prop (parent child) '-X-HNH-FILENAME))) - - ;; NOTE The vdir standard says that each file should contain - ;; EXACTLY one event. It can however contain multiple VEVENT - ;; components, but they are still the same event. - ;; In our case this means exceptions to reccurence rules, which - ;; is set up here, and then later handled in rrule-generate. - ;; NOTE These events also share UID, but are diferentiated - ;; by RECURRENCE-ID. As far as I can tell this goes against - ;; the standard. Section 3.8.4.4. - (case (length events) - [(0) (warning "No events in component~%~a" - (prop item '-X-HNH-FILENAME))] - [(1) - (let ((child (car events))) - (assert (memv (type child) '(VTIMEZONE VEVENT))) - (add-child! calendar child))] - - ;; two or more - [else - - ;; Sorting on SEQUENCE here would have been nice. - ;; But the patches can apparently share a sequence number - ;; of 0 with the original event! - ;; (╯°□°）╯ ┻━┻ - (let* ((head (find (negate (extract 'RECURRENCE-ID)) - events)) - (rest (delete head events eq?))) - - (set! (prop head '-X-HNH-ALTERNATIVES) - (alist->hash-table - (map cons - (map (extract 'RECURRENCE-ID) rest) - rest)) - #; - (sort*! rest ;; HERE - date/-time< (extract 'RECURRENCE-ID))) - (add-child! calendar head))]) - - ;; return - calendar) - (make-vcomponent) - (map #; (@ (ice-9 threads) par-map) - (lambda (fname) - (let ((fullname (/ path fname))) - (let ((cal (call-with-input-file fullname - parse-calendar))) - (set! (prop cal 'COLOR) color - (prop cal 'NAME) name - (prop cal '-X-HNH-FILENAME) fullname) - cal))) - (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) - (string= "ics" (string-take-right s 3)))))))))) + (let ((color + (catch 'system-error + (lambda () (call-with-input-file (path-append path "color") read-line)) + (const "#FFFFFF"))) + (name + (catch 'system-error + (lambda () (call-with-input-file (path-append path "displayname") read-line)) + (const #f)))) + + (reduce (lambda (item calendar) + + (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e))) + (children item))) + + + ;; (assert (eq? 'VCALENDAR (type calendar))) + (assert (eq? 'VCALENDAR (type item))) + + (for child in (children item) + (set! (prop child '-X-HNH-FILENAME) + (prop (parent child) '-X-HNH-FILENAME))) + + ;; NOTE The vdir standard says that each file should contain + ;; EXACTLY one event. It can however contain multiple VEVENT + ;; components, but they are still the same event. + ;; In our case this means exceptions to reccurence rules, which + ;; is set up here, and then later handled in rrule-generate. + ;; NOTE These events also share UID, but are diferentiated + ;; by RECURRENCE-ID. As far as I can tell this goes against + ;; the standard. Section 3.8.4.4. + (case (length events) + [(0) (warning "No events in component~%~a" + (prop item '-X-HNH-FILENAME))] + [(1) + (let ((child (car events))) + (assert (memv (type child) '(VTIMEZONE VEVENT))) + (add-child! calendar child))] + + ;; two or more + [else + + ;; Sorting on SEQUENCE here would have been nice. + ;; But the patches can apparently share a sequence number + ;; of 0 with the original event! + ;; (╯°□°）╯ ┻━┻ + (let* ((head (find (negate (extract 'RECURRENCE-ID)) + events)) + (rest (delete head events eq?))) + + (set! (prop head '-X-HNH-ALTERNATIVES) + (alist->hash-table + (map cons + (map (extract 'RECURRENCE-ID) rest) + rest)) + #; + (sort*! rest ;; HERE + date/-time< (extract 'RECURRENCE-ID))) + (add-child! calendar head))]) + + ;; return + calendar) + (make-vcomponent) + (map #; (@ (ice-9 threads) par-map) + (lambda (fname) + (let ((fullname (path-append path fname))) + (let ((cal (call-with-input-file fullname + parse-calendar))) + (set! (prop cal 'COLOR) color + (prop cal 'NAME) name + (prop cal '-X-HNH-FILENAME) fullname) + cal))) + (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) + (string= "ics" (string-take-right s 3))))))))) -- cgit v1.2.3