summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-04-28 17:17:33 +0200
committerLudovic Courtès <ludo@gnu.org>2018-05-10 14:53:56 +0200
commitdac1c97d131d297134fa878ac240d9ec0127044b (patch)
treefd64fc397e73001b8e6ae6e3513602feaaad65fe /guix
parent8584965b7949cdd7a4cd702b5422474b088beb36 (diff)
downloadgnu-guix-dac1c97d131d297134fa878ac240d9ec0127044b.tar
gnu-guix-dac1c97d131d297134fa878ac240d9ec0127044b.tar.gz
union: Add 'relative-file-name'.
* guix/build/union.scm (%not-slash): New variable. (relative-file-name): New procedure. * tests/union.scm (test-relative-file-name): New macro and tests.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/union.scm41
1 files changed, 40 insertions, 1 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 1179f1234b..82d6199d9e 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -27,7 +27,9 @@
#:use-module (rnrs io ports)
#:export (union-build
- warn-about-collision))
+ warn-about-collision
+
+ relative-file-name))
;;; Commentary:
;;;
@@ -174,4 +176,41 @@ returns #f, skip the faulty file altogether."
(union-of-directories output (delete-duplicates inputs)))
+
+;;;
+;;; Relative symlinks.
+;;;
+
+(define %not-slash
+ (char-set-complement (char-set #\/)))
+
+(define (relative-file-name reference file)
+ "Given REFERENCE and FILE, both of which are absolute file names, return the
+file name of FILE relative to REFERENCE.
+
+ (relative-file-name \"/gnu/store/foo\" \"/gnu/store/bin/bar\")
+ => \"../bin/bar\"
+
+Note that this is from a purely lexical standpoint; conversely, \"..\" is
+*not* resolved lexically on POSIX in the presence of symlinks."
+ (if (and (string-prefix? "/" file) (string-prefix? "/" reference))
+ (let loop ((reference (string-tokenize reference %not-slash))
+ (file (string-tokenize file %not-slash)))
+ (define (finish)
+ (string-join (append (make-list (length reference) "..") file)
+ "/"))
+
+ (match reference
+ (()
+ (finish))
+ ((head . tail)
+ (match file
+ (()
+ (finish))
+ ((head* . tail*)
+ (if (string=? head head*)
+ (loop tail tail*)
+ (finish)))))))
+ file))
+
;;; union.scm ends here