From 55477368f84f76b831d3b714c52784e7bb952021 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 1 Feb 2022 21:32:15 +0100 Subject: Move path-append to own module. --- module/calp/benchmark/parse.scm | 1 + module/calp/entry-points/html.scm | 7 ++++--- module/calp/html/vcomponent.scm | 3 +++ module/calp/main.scm | 11 ++++++----- module/calp/server/routes.scm | 1 + module/datetime/instance.scm | 1 + module/hnh/util.scm | 20 -------------------- module/hnh/util/io.scm | 1 - module/hnh/util/path.scm | 20 ++++++++++++++++++++ module/vcomponent/formats/vdir/parse.scm | 1 + module/vcomponent/formats/vdir/save-delete.scm | 1 + tests/util.scm | 3 ++- 12 files changed, 40 insertions(+), 30 deletions(-) create mode 100644 module/hnh/util/path.scm diff --git a/module/calp/benchmark/parse.scm b/module/calp/benchmark/parse.scm index f1ddf17d..1391d18a 100644 --- a/module/calp/benchmark/parse.scm +++ b/module/calp/benchmark/parse.scm @@ -1,5 +1,6 @@ (define-module (calp benchmark parse) :use-module (hnh util) + :use-module ((hnh util path) :select (path-append)) :use-module (glob) :use-module (statprof) diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index adac302f..7c4fe257 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -1,6 +1,7 @@ (define-module (calp entry-points html) :export (main) :use-module (hnh util) + :use-module ((hnh util path) :select (path-append)) :use-module (calp util time) :use-module (hnh util options) :use-module (datetime) @@ -66,15 +67,15 @@ ;; file existing but is of wrong type, (define (create-files output-directory) - (let* ((link (path-append output-directory "/static"))) + (let* ((link (path-append output-directory "static"))) (unless (file-exists? output-directory) (mkdir output-directory)) ;; TODO nicer way to resolve static - (let ((link (path-append output-directory "/static"))) + (let ((link (path-append output-directory "static"))) (unless (file-exists? link) - (symlink (path-append (xdg-data-home) "/calp/www/static") link))))) + (symlink (path-append (xdg-data-home) "calp" "www" "static") link))))) (define (re-root-static tree) diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 34aeca66..4c1ebbb3 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -1,5 +1,8 @@ (define-module (calp html vcomponent) :use-module (hnh util) + ;; TODO should we really use path-append here? Path append is + ;; system-dependant, while URL-paths aren't. + :use-module ((hnh util path) :select (path-append)) :use-module (srfi srfi-1) :use-module (srfi srfi-41) :use-module ((rnrs io ports) :select (put-bytevector)) diff --git a/module/calp/main.scm b/module/calp/main.scm index 01d66e5f..0ae22927 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -1,6 +1,7 @@ ;; -*- geiser-scheme-implementation: guile -*- (define-module (calp main) :use-module (hnh util) + :use-module ((hnh util path) :select (path-append)) :use-module (srfi srfi-1) :use-module (srfi srfi-88) ; keyword syntax @@ -125,8 +126,8 @@ ;; if an explicitly given config is missing. [(find file-exists? (list - (path-append (xdg-config-home) "/calp/config.scm") - (path-append (xdg-sysconfdir) "/calp/config.scm"))) + (path-append (xdg-config-home) "calp" "config.scm") + (path-append (xdg-sysconfdir) "calp" "config.scm"))) => identity])) (when stprof (statprof-start)) @@ -210,7 +211,7 @@ (throw 'return)) (when (option-ref opts 'update-zoneinfo #f) - (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "/tzget"))) + (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "tzget"))) (filename (or (find file-exists? locations) (error "tzget not installed, please put it in one of ~a" locations))) (pipe (open-input-pipe filename))) @@ -219,13 +220,13 @@ (define line ((@ (ice-9 rdelim) read-line) pipe)) (define names (string-split line #\space)) ((@ (hnh util io) with-atomic-output-to-file) - (path-append (xdg-data-home) "/calp/zoneinfo.scm") + (path-append (xdg-data-home) "calp" "zoneinfo.scm") (lambda () (write `(set-config! 'tz-list ',names)) (newline) (write `(set-config! 'last-zoneinfo-upgrade ,((@ (datetime) current-date)))) (newline))))) ;; always load zoneinfo if available. - (let ((z (path-append (xdg-data-home) "/calp/zoneinfo.scm"))) + (let ((z (path-append (xdg-data-home) "calp" "zoneinfo.scm"))) (when (file-exists? z) (primitive-load z))) diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index b53e1cad..87af983a 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -1,5 +1,6 @@ (define-module (calp server routes) :use-module (hnh util) + :use-module ((hnh util path) :select (path-append)) :use-module (hnh util options) :use-module (hnh util exceptions) diff --git a/module/datetime/instance.scm b/module/datetime/instance.scm index 294aee27..5ce312f2 100644 --- a/module/datetime/instance.scm +++ b/module/datetime/instance.scm @@ -2,6 +2,7 @@ :use-module (hnh util) :use-module (calp util config) :use-module (hnh util exceptions) + :use-module ((hnh util path) :select (path-append)) :use-module (datetime zic) :use-module ((xdg basedir) :prefix xdg-) :export (zoneinfo)) diff --git a/module/hnh/util.scm b/module/hnh/util.scm index 7fe44462..7fa3419d 100644 --- a/module/hnh/util.scm +++ b/module/hnh/util.scm @@ -556,26 +556,6 @@ -;; TODO shouldn't this use `file-name-separator-string'? -(define-public (path-append . strings) - (fold (lambda (s done) - (string-append - done - (if (string-null? s) - (string-append s "/") - (if (char=? #\/ (string-last done)) - (if (char=? #\/ (string-first s)) - (string-drop s 1) s) - (if (char=? #\/ (string-first s)) - s (string-append "/" s)))))) - (let ((s (car strings))) - (if (string-null? s) - "/" s)) - (cdr strings))) - - - - (define-syntax let-env (syntax-rules () [(_ ((name value) ...) diff --git a/module/hnh/util/io.scm b/module/hnh/util/io.scm index 04e54a9e..161e09a0 100644 --- a/module/hnh/util/io.scm +++ b/module/hnh/util/io.scm @@ -12,7 +12,6 @@ (open-output-file str))) - (define-public (read-lines port) (with-input-from-port port (lambda () diff --git a/module/hnh/util/path.scm b/module/hnh/util/path.scm new file mode 100644 index 00000000..b08932f9 --- /dev/null +++ b/module/hnh/util/path.scm @@ -0,0 +1,20 @@ +(define-module (hnh util path) + :use-module (srfi srfi-1) + :use-module (hnh util)) + +;; TODO shouldn't this use `file-name-separator-string'? +(define-public (path-append . strings) + (fold (lambda (s done) + (string-append + done + (if (string-null? s) + (string-append s "/") + (if (char=? #\/ (string-last done)) + (if (char=? #\/ (string-first s)) + (string-drop s 1) s) + (if (char=? #\/ (string-first s)) + s (string-append "/" s)))))) + (let ((s (car strings))) + (if (string-null? s) + "/" s)) + (cdr strings))) diff --git a/module/vcomponent/formats/vdir/parse.scm b/module/vcomponent/formats/vdir/parse.scm index 20b89026..c4a48889 100644 --- a/module/vcomponent/formats/vdir/parse.scm +++ b/module/vcomponent/formats/vdir/parse.scm @@ -12,6 +12,7 @@ :use-module ((ice-9 ftw) :select (scandir ftw)) :use-module (hnh util) + :use-module ((hnh util path) :select (path-append)) :use-module (hnh util exceptions) :use-module (vcomponent base) diff --git a/module/vcomponent/formats/vdir/save-delete.scm b/module/vcomponent/formats/vdir/save-delete.scm index 73725b2c..6068e34c 100644 --- a/module/vcomponent/formats/vdir/save-delete.scm +++ b/module/vcomponent/formats/vdir/save-delete.scm @@ -11,6 +11,7 @@ (define-module (vcomponent formats vdir save-delete) :use-module (hnh util) + :use-module ((hnh util path) :select (path-append)) :use-module ((hnh util exceptions) :select (assert)) :use-module (vcomponent formats ical output) :use-module (vcomponent) diff --git a/tests/util.scm b/tests/util.scm index 45e69dd6..721b7e1b 100644 --- a/tests/util.scm +++ b/tests/util.scm @@ -4,8 +4,9 @@ (((hnh util) filter-sorted set/r! find-min find-max span-upto - iterate ->string ->quoted-string path-append + iterate ->string ->quoted-string begin1) + ((hnh util path) path-append) ((ice-9 ports) with-output-to-string) ) -- cgit v1.2.3