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.
This commit is contained in:
parent
e89431bf01
commit
6568d2bd6e
4 changed files with 77 additions and 70 deletions
|
|
@ -375,42 +375,6 @@ an output path different than CURRENT-PATH."
|
||||||
;;; Search paths.
|
;;; 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
|
(define* (search-path-environment-variables entries profile
|
||||||
#:optional (getenv getenv))
|
#:optional (getenv getenv))
|
||||||
"Return environment variable definitions that may be needed for the use of
|
"Return environment variable definitions that may be needed for the use of
|
||||||
|
|
|
||||||
|
|
@ -18,6 +18,9 @@
|
||||||
|
|
||||||
(define-module (guix search-paths)
|
(define-module (guix search-paths)
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
|
#:use-module (guix build utils)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (<search-path-specification>
|
#:export (<search-path-specification>
|
||||||
search-path-specification
|
search-path-specification
|
||||||
|
|
@ -29,7 +32,8 @@
|
||||||
search-path-specification-file-pattern
|
search-path-specification-file-pattern
|
||||||
|
|
||||||
search-path-specification->sexp
|
search-path-specification->sexp
|
||||||
sexp->search-path-specification))
|
sexp->search-path-specification
|
||||||
|
evaluate-search-paths))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -74,4 +78,70 @@ a <search-path-specification> object."
|
||||||
(file-type type)
|
(file-type type)
|
||||||
(file-pattern pattern)))))
|
(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
|
;;; search-paths.scm ends here
|
||||||
|
|
|
||||||
|
|
@ -72,7 +72,6 @@
|
||||||
version-major+minor
|
version-major+minor
|
||||||
guile-version>?
|
guile-version>?
|
||||||
package-name->name+version
|
package-name->name+version
|
||||||
string-tokenize*
|
|
||||||
string-replace-substring
|
string-replace-substring
|
||||||
arguments-from-environment-variable
|
arguments-from-environment-variable
|
||||||
file-extension
|
file-extension
|
||||||
|
|
@ -606,33 +605,6 @@ introduce the version part."
|
||||||
(substring file 0 dot)
|
(substring file 0 dot)
|
||||||
file)))
|
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
|
(define* (string-replace-substring str substr replacement
|
||||||
#:optional
|
#:optional
|
||||||
(start 0)
|
(start 0)
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
|
@ -82,10 +82,11 @@
|
||||||
("foo" "bar" "baz")
|
("foo" "bar" "baz")
|
||||||
("foo" "bar" "")
|
("foo" "bar" "")
|
||||||
("foo" "bar" "baz"))
|
("foo" "bar" "baz"))
|
||||||
|
(let ((string-tokenize* (@@ (guix search-paths) string-tokenize*)))
|
||||||
(list (string-tokenize* "foo" ":")
|
(list (string-tokenize* "foo" ":")
|
||||||
(string-tokenize* "foo;bar;baz" ";")
|
(string-tokenize* "foo;bar;baz" ";")
|
||||||
(string-tokenize* "foo!bar!" "!")
|
(string-tokenize* "foo!bar!" "!")
|
||||||
(string-tokenize* "foo+-+bar+-+baz" "+-+")))
|
(string-tokenize* "foo+-+bar+-+baz" "+-+"))))
|
||||||
|
|
||||||
(test-equal "string-replace-substring"
|
(test-equal "string-replace-substring"
|
||||||
'("foo BAR! baz"
|
'("foo BAR! baz"
|
||||||
|
|
|
||||||
Reference in a new issue