diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-05-04 21:44:52 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-05-04 23:30:51 +0200 |
commit | 6568d2bd6e4e047dd95b00a7a6e7501a16491eb5 (patch) | |
tree | f5f16ed73cbb0486fd00a8147707ce75b2132df4 /guix | |
parent | e89431bf016830a919ec2430889f6c2679aab408 (diff) | |
download | gnu-guix-6568d2bd6e4e047dd95b00a7a6e7501a16491eb5.tar gnu-guix-6568d2bd6e4e047dd95b00a7a6e7501a16491eb5.tar.gz |
search-paths: Add 'evaluate-search-paths', from (guix scripts package).
* guix/scripts/package.scm (with-null-error-port,
evaluate-search-paths): Move to...
* guix/search-paths.scm: ... here.
* guix/utils.scm (string-tokenize*): Move to...
* guix/search-paths.scm: ... here.
* tests/utils.scm ("string-tokenize*"): Adjust accordingly.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/scripts/package.scm | 36 | ||||
-rw-r--r-- | guix/search-paths.scm | 72 | ||||
-rw-r--r-- | guix/utils.scm | 28 |
3 files changed, 71 insertions, 65 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 44cacdca8b..933f7d8ee5 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -375,42 +375,6 @@ an output path different than CURRENT-PATH." ;;; Search paths. ;;; -(define-syntax-rule (with-null-error-port exp) - "Evaluate EXP with the error port pointing to the bit bucket." - (with-error-to-port (%make-void-port "w") - (lambda () exp))) - -(define* (evaluate-search-paths search-paths directory - #:optional (getenv (const #f))) - "Evaluate SEARCH-PATHS, a list of search-path specifications, for DIRECTORY, -and return a list of variable/value pairs. Use GETENV to determine the -current settings and report only settings not already effective." - (define search-path-definition - (match-lambda - (($ <search-path-specification> variable files separator - type pattern) - (let* ((values (or (and=> (getenv variable) - (cut string-tokenize* <> separator)) - '())) - ;; Add a trailing slash to force symlinks to be treated as - ;; directories when 'find-files' traverses them. - (files (if pattern - (map (cut string-append <> "/") files) - files)) - - ;; XXX: Silence 'find-files' when it stumbles upon non-existent - ;; directories (see - ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.) - (path (with-null-error-port - (search-path-as-list files (list directory) - #:type type - #:pattern pattern)))) - (if (every (cut member <> values) path) - #f ;VARIABLE is already set appropriately - (cons variable (string-join path separator))))))) - - (filter-map search-path-definition search-paths)) - (define* (search-path-environment-variables entries profile #:optional (getenv getenv)) "Return environment variable definitions that may be needed for the use of diff --git a/guix/search-paths.scm b/guix/search-paths.scm index 147bfcae8c..b17f5acd5d 100644 --- a/guix/search-paths.scm +++ b/guix/search-paths.scm @@ -18,6 +18,9 @@ (define-module (guix search-paths) #:use-module (guix records) + #:use-module (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (<search-path-specification> search-path-specification @@ -29,7 +32,8 @@ search-path-specification-file-pattern search-path-specification->sexp - sexp->search-path-specification)) + sexp->search-path-specification + evaluate-search-paths)) ;;; Commentary: ;;; @@ -74,4 +78,70 @@ a <search-path-specification> object." (file-type type) (file-pattern pattern))))) +(define-syntax-rule (with-null-error-port exp) + "Evaluate EXP with the error port pointing to the bit bucket." + (with-error-to-port (%make-void-port "w") + (lambda () exp))) + +;; XXX: This procedure used to be in (guix utils) but since we want to be able +;; to use (guix search-paths) on the build side, we want to avoid the +;; dependency on (guix utils), and so this procedure is back here for now. +(define (string-tokenize* string separator) + "Return the list of substrings of STRING separated by SEPARATOR. This is +like `string-tokenize', but SEPARATOR is a string." + (define (index string what) + (let loop ((string string) + (offset 0)) + (cond ((string-null? string) + #f) + ((string-prefix? what string) + offset) + (else + (loop (string-drop string 1) (+ 1 offset)))))) + + (define len + (string-length separator)) + + (let loop ((string string) + (result '())) + (cond ((index string separator) + => + (lambda (offset) + (loop (string-drop string (+ offset len)) + (cons (substring string 0 offset) + result)))) + (else + (reverse (cons string result)))))) + +(define* (evaluate-search-paths search-paths directory + #:optional (getenv (const #f))) + "Evaluate SEARCH-PATHS, a list of search-path specifications, for DIRECTORY, +and return a list of variable/value pairs. Use GETENV to determine the +current settings and report only settings not already effective." + (define search-path-definition + (match-lambda + (($ <search-path-specification> variable files separator + type pattern) + (let* ((values (or (and=> (getenv variable) + (cut string-tokenize* <> separator)) + '())) + ;; Add a trailing slash to force symlinks to be treated as + ;; directories when 'find-files' traverses them. + (files (if pattern + (map (cut string-append <> "/") files) + files)) + + ;; XXX: Silence 'find-files' when it stumbles upon non-existent + ;; directories (see + ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.) + (path (with-null-error-port + (search-path-as-list files (list directory) + #:type type + #:pattern pattern)))) + (if (every (cut member <> values) path) + #f ;VARIABLE is already set appropriately + (cons variable (string-join path separator))))))) + + (filter-map search-path-definition search-paths)) + ;;; search-paths.scm ends here diff --git a/guix/utils.scm b/guix/utils.scm index 3d38ba1223..a2ade2bf97 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -72,7 +72,6 @@ version-major+minor guile-version>? package-name->name+version - string-tokenize* string-replace-substring arguments-from-environment-variable file-extension @@ -606,33 +605,6 @@ introduce the version part." (substring file 0 dot) file))) -(define (string-tokenize* string separator) - "Return the list of substrings of STRING separated by SEPARATOR. This is -like `string-tokenize', but SEPARATOR is a string." - (define (index string what) - (let loop ((string string) - (offset 0)) - (cond ((string-null? string) - #f) - ((string-prefix? what string) - offset) - (else - (loop (string-drop string 1) (+ 1 offset)))))) - - (define len - (string-length separator)) - - (let loop ((string string) - (result '())) - (cond ((index string separator) - => - (lambda (offset) - (loop (string-drop string (+ offset len)) - (cons (substring string 0 offset) - result)))) - (else - (reverse (cons string result)))))) - (define* (string-replace-substring str substr replacement #:optional (start 0) |