From 6c37a4c00cd420e50d0cd2ad088268bcbb3d9155 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 1 Apr 2020 21:01:17 +0200 Subject: Update remaining code to use new config scheme. --- module/datetime/util.scm | 5 ++-- module/entry-points/benchmark.scm | 5 ++-- module/entry-points/html.scm | 9 +++---- module/entry-points/ical.scm | 5 ++-- module/entry-points/server.scm | 28 +++++++++---------- module/entry-points/terminal.scm | 6 ++--- module/main.scm | 3 ++- module/output/html.scm | 26 +++++++++--------- module/output/terminal.scm | 57 ++++++++++++++++++++------------------- module/util/config/all.scm | 3 --- module/vcomponent/load.scm | 7 ++--- 11 files changed, 71 insertions(+), 83 deletions(-) delete mode 100644 module/util/config/all.scm (limited to 'module') diff --git a/module/datetime/util.scm b/module/datetime/util.scm index c567d44f..7f085bbf 100644 --- a/module/datetime/util.scm +++ b/module/datetime/util.scm @@ -352,7 +352,6 @@ (* (1- date-diff) 24)))) -(register-config! - week-start - sun +(define-config week-start sun + "First day of week" (ensure (lambda (x) (<= sun x sat)))) diff --git a/module/entry-points/benchmark.scm b/module/entry-points/benchmark.scm index a21b4630..4843a80a 100644 --- a/module/entry-points/benchmark.scm +++ b/module/entry-points/benchmark.scm @@ -4,7 +4,6 @@ :use-module (ice-9 getopt-long) :use-module (util) :use-module (vcomponent) - :use-module (util config all) ) @@ -14,5 +13,5 @@ (define (main args) (define opts (getopt-long args opt-spec)) - (load-calendars* calendar-files: (cond [(option-ref opts 'file #f) => list] - [else (calendar-files)]))) + (cond [(option-ref opts 'file #f) => (compose load-calendars* list)] + [else (load-calendars)])) diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm index bacc8038..34ecc2dd 100644 --- a/module/entry-points/html.scm +++ b/module/entry-points/html.scm @@ -7,8 +7,6 @@ :use-module (datetime) :use-module (datetime util) :use-module (ice-9 getopt-long) - - :use-module (util config all) ) @@ -32,9 +30,8 @@ (define style (string->symbol (option-ref opts 'style "wide"))) (define-values (calendars events) - (load-calendars - calendar-files: (cond [(option-ref opts 'file #f) => list] - [else (calendar-files)]) )) + (cond [(option-ref opts 'file #f) => (compose load-calendars list)] + [else (load-calendars)])) (report-time! "Calendars loaded") @@ -49,7 +46,7 @@ ;; be a good idea to instead center it on the current week, meaning ;; that the active row is always in the center (html-chunked-main count calendars events - (previous-week-start start (week-start)) + (previous-week-start start (get-config 'week-start)) (date day: 7))] [(table) (html-table-main count calendars events start)] diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm index e2ee7dcf..f2f4e0b5 100644 --- a/module/entry-points/ical.scm +++ b/module/entry-points/ical.scm @@ -3,7 +3,6 @@ :use-module (util) :use-module (output ical) :use-module ((vcomponent) :select (load-calendars*)) - :use-module ((util config all) :select (calendar-files)) :use-module (ice-9 getopt-long) :use-module (datetime) :use-module (datetime util) @@ -26,8 +25,8 @@ ;; TODO this contains repeated events multiple times (define-values (calendars regular repeating) - (load-calendars* calendar-files: (cond [(option-ref opts 'file #f) => list] - [else (calendar-files)]) )) + (cond [(option-ref opts 'file #f) => (compose load-calendars* list)] + [else (load-calendars*)])) (ical-main calendars regular repeating start end) ) diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index e3ce168a..25b86735 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -2,7 +2,6 @@ :export (main) :use-module (util) :use-module (vcomponent) - :use-module (util config all) ) (use-modules* (web (server request response uri)) @@ -122,9 +121,8 @@ [else AF_INET6])) (define-values (c e) - (load-calendars - calendar-files: (cond [(option-ref opts 'file #f) => list] - [else (calendar-files)]) )) + (cond [(option-ref opts 'file #f) => (compose load-calendars list)] + [else (load-calendars)])) @@ -134,19 +132,19 @@ ;; placed after load-calendars to keep Guile 2.2 compability. (set! addr (if addr addr - (if (eqv? family AF_INET6) - "::" "0.0.0.0"))) + (if (eqv? family AF_INET6) + "::" "0.0.0.0"))) ;; NOTE The default make-default-socket is broken for IPv6. ;; A patch has been submitted to the mailing list. 2020-03-31 (module-set! - (resolve-module '(web server http)) - 'make-default-socket - (lambda (family addr port) - (let ((sock (socket family SOCK_STREAM 0))) - (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) - (bind sock family addr port) - sock))) + (resolve-module '(web server http)) + 'make-default-socket + (lambda (family addr port) + (let ((sock (socket family SOCK_STREAM 0))) + (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) + (bind sock family addr port) + sock))) ;; TODO possibly test inet-pton here on address? @@ -158,6 +156,6 @@ (run-server (make-make-routes c e) 'http `(family: ,family - port: ,port - host: ,addr) + port: ,port + host: ,addr) 0)) diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm index 0f2a85f0..9f486d90 100644 --- a/module/entry-points/terminal.scm +++ b/module/entry-points/terminal.scm @@ -5,7 +5,6 @@ :use-module (ice-9 getopt-long) :use-module (datetime) :use-module (datetime util) - :use-module (util config all) :use-module (vulgar) ) @@ -16,9 +15,8 @@ (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)]) )) + (cond [(option-ref opts 'file #f) => (compose load-calendars list)] + [else (load-calendars)])) (let ((date (or (and=> (option-ref opts 'date #f) parse-freeform-date) (current-date)))) diff --git a/module/main.scm b/module/main.scm index 011e5f63..4b47025a 100755 --- a/module/main.scm +++ b/module/main.scm @@ -29,7 +29,7 @@ exec guile -e main -s $0 "$@" (statprof) - (util config all)) + ) (define options '((statprof (value optional)) @@ -81,6 +81,7 @@ exec guile -e main -s $0 "$@" (define (main args) (report-time! "Program start") + ;; ((@ (util config) print-configuration-documentation)) (with-throw-handler #t (lambda () (wrapped-main args)) (lambda (err . args) diff --git a/module/output/html.scm b/module/output/html.scm index 299dde3d..9cee3e26 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -21,14 +21,12 @@ ;; #:use-module (module config all) ) -(register-config! - summary-filter - (lambda (_ a) a) +(define-config summary-filter (lambda (_ a) a) + "" (ensure procedure?)) -(register-config! - description-filter - (lambda (_ a) a) +(define-config description-filter (lambda (_ a) a) + "" (ensure procedure?)) (define (date-link date) @@ -161,7 +159,7 @@ (div (@ (class "popup")) ,(event-debug-html ev)) (div (@ (class "body")) - ,((summary-filter) ev (attr ev 'SUMMARY)))))) + ,((get-config 'summary-filter) ev (attr ev 'SUMMARY)))))) ) @@ -212,7 +210,7 @@ (div (@ (class "popup")) ,(event-debug-html ev)) (div (@ (class "body")) - ,((summary-filter) ev (attr ev 'SUMMARY))))))) + ,((get-config 'summary-filter) ev (attr ev 'SUMMARY))))))) ;; Lay out complete day (graphical) @@ -318,7 +316,7 @@ [(start) `(div ,start)])) ,(when (and=> (attr ev 'LOCATION) (negate string-null?)) `(div (b "Plats: ") ,(attr ev 'LOCATION))) - ,(and=> (attr ev 'DESCRIPTION) (lambda (str) ((description-filter) ev str)))))) + ,(and=> (attr ev 'DESCRIPTION) (lambda (str) ((get-config 'description-filter) ev str)))))) ;; Single event in side bar (text objects) (define (fmt-day day) @@ -347,7 +345,7 @@ (div (@ (class "inline-event CAL_" ;; TODO centralize handling of unnamed calendars once again. ,(html-attr (or (attr (parent event) 'NAME) "unnamed")))) - ,((summary-filter) event (attr event 'SUMMARY))))) + ,((get-config 'summary-filter) event (attr event 'SUMMARY))))) ;; (stream event-group) -> sxml (define*-public (render-calendar-table key: events start-date end-date pre-start post-end #:allow-other-keys) @@ -357,7 +355,7 @@ `(div (@ (class "caltable")) ,@(map (lambda (d) `(div (@ (class "thead")) ,(week-day-name d))) - (weekday-list (week-start))) + (weekday-list (get-config 'week-start))) ,@(cons ;; First day is a special case, since I always want to show a full date there. ;; For all other days I'm only interested in the parts that change. @@ -420,7 +418,7 @@ (define* (cal-table key: start-date end-date - (week-start (week-start)) + (week-start (get-config 'week-start)) next-start prev-start) (define (td date) @@ -552,7 +550,7 @@ "View " (a (@ (href "/week/" ,(date->string (if (= 1 (day start-date)) - (start-of-week start-date (week-start)) + (start-of-week start-date (get-config 'week-start)) start-date) "~1") ".html")) @@ -640,7 +638,7 @@ (lambda (start-of-month) (let ((fname (format #f "./html/~a.html" (date->string start-of-month "~1")))) (format (current-error-port) "Writing to [~a]~%" fname) - (let* ((before current after (month-days start-of-month (week-start)))) + (let* ((before current after (month-days start-of-month (get-config 'week-start)))) (with-output-to-file fname ;; TODO this produces incorrect next and prev links ;; TODO It actually produces almost all date links wrong diff --git a/module/output/terminal.scm b/module/output/terminal.scm index c344776f..e94d971d 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -36,34 +36,35 @@ (cur-event -1) (summary-width 30) (location-width 20)) - (for-each - (lambda (ev i) - (display - (string-append - (if (datetime? (attr ev 'DTSTART)) - (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") - ((@ (texinfo string-utils) center-string) - (date->string (attr ev 'DTSTART)) - 19)) - ; TODO show truncated string - " │ " - (if (= i cur-event) "\x1b[7m" "") - (color-escape (attr (parent ev) 'COLOR)) - ;; Summary filter is a hook for the user - (let ((dirty (attr ev 'X-HNH-DIRTY))) - (string-append - (if dirty "* " "") - (trim-to-width ((summary-filter) ev (attr ev 'SUMMARY)) (- summary-width - (if dirty 2 0))))) - STR-RESET - " │ " - (if (attr ev 'LOCATION) "" "\x1b[1;30m") - (trim-to-width - (or (attr ev 'LOCATION) "INGEN LOKAL") location-width) - STR-RESET - "\n"))) - events - (iota (length events)))) + (for-each + (lambda (ev i) + (display + (string-append + (if (datetime? (attr ev 'DTSTART)) + (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") + ((@ (texinfo string-utils) center-string) + (date->string (attr ev 'DTSTART)) + 19)) + ; TODO show truncated string + " │ " + (if (= i cur-event) "\x1b[7m" "") + (color-escape (attr (parent ev) 'COLOR)) + ;; Summary filter is a hook for the user + (let ((dirty (attr ev 'X-HNH-DIRTY))) + (string-append + (if dirty "* " "") + ;; TODO reintroduce summary-filter + (trim-to-width (attr ev 'SUMMARY) (- summary-width + (if dirty 2 0))))) + STR-RESET + " │ " + (if (attr ev 'LOCATION) "" "\x1b[1;30m") + (trim-to-width + (or (attr ev 'LOCATION) "INGEN LOKAL") location-width) + STR-RESET + "\n"))) + events + (iota (length events)))) (define (displayln a) (display a) (newline)) diff --git a/module/util/config/all.scm b/module/util/config/all.scm deleted file mode 100644 index 984b1d68..00000000 --- a/module/util/config/all.scm +++ /dev/null @@ -1,3 +0,0 @@ -(define-module (util config all) - :use-module (util config)) - diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm index d4324437..8e11c9b2 100644 --- a/module/vcomponent/load.scm +++ b/module/vcomponent/load.scm @@ -2,6 +2,7 @@ :export (load-calendars load-calendars*) :use-module (util) :use-module (util time) + :use-module (util config) :use-module (srfi srfi-1) :use-module (datetime) :use-module (datetime util) @@ -14,11 +15,11 @@ :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?)) :use-module ((vcomponent datetime) :select (ev-time