diff options
Diffstat (limited to 'guix/search-paths.scm')
-rw-r--r-- | guix/search-paths.scm | 193 |
1 files changed, 193 insertions, 0 deletions
diff --git a/guix/search-paths.scm b/guix/search-paths.scm new file mode 100644 index 0000000000..7fd15d440c --- /dev/null +++ b/guix/search-paths.scm @@ -0,0 +1,193 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(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 + search-path-specification? + search-path-specification-variable + search-path-specification-files + search-path-specification-separator + search-path-specification-file-type + search-path-specification-file-pattern + + $PATH + + search-path-specification->sexp + sexp->search-path-specification + string-tokenize* + evaluate-search-paths + environment-variable-definition + search-path-definition)) + +;;; Commentary: +;;; +;;; This module defines "search path specifications", which allow packages to +;;; declare environment variables that they use to define search paths. For +;;; instance, GCC has the 'CPATH' variable, Guile has the 'GUILE_LOAD_PATH' +;;; variable, etc. +;;; +;;; Code: + +;; The specification of a search path. +(define-record-type* <search-path-specification> + search-path-specification make-search-path-specification + search-path-specification? + (variable search-path-specification-variable) ;string + (files search-path-specification-files) ;list of strings + (separator search-path-specification-separator ;string + (default ":")) + (file-type search-path-specification-file-type ;symbol + (default 'directory)) + (file-pattern search-path-specification-file-pattern ;#f | string + (default #f))) + +(define $PATH + ;; The 'PATH' variable. This variable is a bit special: it is not attached + ;; to any package in particular. + (search-path-specification + (variable "PATH") + (files '("bin" "sbin")))) + +(define (search-path-specification->sexp spec) + "Return an sexp representing SPEC, a <search-path-specification>. The sexp +corresponds to the arguments expected by `set-path-environment-variable'." + ;; Note that this sexp format is used both by build systems and in + ;; (guix profiles), so think twice before you change it. + (match spec + (($ <search-path-specification> variable files separator type pattern) + `(,variable ,files ,separator ,type ,pattern)))) + +(define (sexp->search-path-specification sexp) + "Convert SEXP, which is as returned by 'search-path-specification->sexp', to +a <search-path-specification> object." + (match sexp + ((variable files separator type pattern) + (search-path-specification + (variable variable) + (files files) + (separator separator) + (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 directories + #:optional (getenv (const #f))) + "Evaluate SEARCH-PATHS, a list of search-path specifications, for +DIRECTORIES, a list of directory names, and return a list of +specification/value pairs. Use GETENV to determine the current settings and +report only settings not already effective." + (define search-path-definition + (match-lambda + ((and spec + ($ <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 directories + #:type type + #:pattern pattern)))) + (if (every (cut member <> values) path) + #f ;VARIABLE is already set appropriately + (cons spec (string-join path separator))))))) + + (filter-map search-path-definition search-paths)) + +(define* (environment-variable-definition variable value + #:key + (kind 'exact) + (separator ":")) + "Return a the definition of VARIABLE to VALUE in Bash syntax. + +KIND can be either 'exact (return the definition of VARIABLE=VALUE), +'prefix (return the definition where VALUE is added as a prefix to VARIABLE's +current value), or 'suffix (return the definition where VALUE is added as a +suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix, +SEPARATOR is used as the separator between VARIABLE's current value and its +prefix/suffix." + (match kind + ('exact + (format #f "export ~a=\"~a\"" variable value)) + ('prefix + (format #f "export ~a=\"~a${~a:+~a}$~a\"" + variable value variable separator variable)) + ('suffix + (format #f "export ~a=\"$~a${~a:+~a}~a\"" + variable variable variable separator value)))) + +(define* (search-path-definition search-path value + #:key (kind 'exact)) + "Similar to 'environment-variable-definition', but applied to a +<search-path-specification>." + (match search-path + (($ <search-path-specification> variable _ separator) + (environment-variable-definition variable value + #:kind kind + #:separator separator)))) + +;;; search-paths.scm ends here |