guix/search-paths.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix search-paths)
  20   #:use-module (guix records)
  21   #:use-module (guix build utils)
  22   #:use-module (srfi srfi-1)
  23   #:use-module (srfi srfi-26)
  24   #:use-module (ice-9 match)
  25   #:export (<search-path-specification>
  26             search-path-specification
  27             search-path-specification?
  28             search-path-specification-variable
  29             search-path-specification-files
  30             search-path-specification-separator
  31             search-path-specification-file-type
  32             search-path-specification-file-pattern
  33
  34             $PATH
  35
  36             search-path-specification->sexp
  37             sexp->search-path-specification
  38             string-tokenize*
  39             evaluate-search-paths
  40             environment-variable-definition
  41             search-path-definition))
  42
  43 ;;; Commentary:
  44 ;;;
  45 ;;; This module defines "search path specifications", which allow packages to
  46 ;;; declare environment variables that they use to define search paths.  For
  47 ;;; instance, GCC has the 'CPATH' variable, Guile has the 'GUILE_LOAD_PATH'
  48 ;;; variable, etc.
  49 ;;;
  50 ;;; Code:
  51
  52 ;; The specification of a search path.
  53 (define-record-type* <search-path-specification>
  54   search-path-specification make-search-path-specification
  55   search-path-specification?
  56   (variable     search-path-specification-variable) ;string
  57   (files        search-path-specification-files)    ;list of strings
  58   (separator    search-path-specification-separator ;string
  59                 (default ":"))
  60   (file-type    search-path-specification-file-type ;symbol
  61                 (default 'directory))
  62   (file-pattern search-path-specification-file-pattern ;#f | string
  63                 (default #f)))
  64
  65 (define $PATH
  66   ;; The 'PATH' variable.  This variable is a bit special: it is not attached
  67   ;; to any package in particular.
  68   (search-path-specification
  69    (variable "PATH")
  70    (files '("bin" "sbin"))))
  71
  72 (define (search-path-specification->sexp spec)
  73   "Return an sexp representing SPEC, a <search-path-specification>.  The sexp
  74 corresponds to the arguments expected by `set-path-environment-variable'."
  75   ;; Note that this sexp format is used both by build systems and in
  76   ;; (guix profiles), so think twice before you change it.
  77   (match spec
  78     (($ <search-path-specification> variable files separator type pattern)
  79      `(,variable ,files ,separator ,type ,pattern))))
  80
  81 (define (sexp->search-path-specification sexp)
  82   "Convert SEXP, which is as returned by 'search-path-specification->sexp', to
  83 a <search-path-specification> object."
  84   (match sexp
  85     ((variable files separator type pattern)
  86      (search-path-specification
  87       (variable variable)
  88       (files files)
  89       (separator separator)
  90       (file-type type)
  91       (file-pattern pattern)))))
  92
  93 (define-syntax-rule (with-null-error-port exp)
  94   "Evaluate EXP with the error port pointing to the bit bucket."
  95   (with-error-to-port (%make-void-port "w")
  96     (lambda () exp)))
  97
  98 ;; XXX: This procedure used to be in (guix utils) but since we want to be able
  99 ;; to use (guix search-paths) on the build side, we want to avoid the
 100 ;; dependency on (guix utils), and so this procedure is back here for now.
 101 (define (string-tokenize* string separator)
 102   "Return the list of substrings of STRING separated by SEPARATOR.  This is
 103 like `string-tokenize', but SEPARATOR is a string."
 104   (define (index string what)
 105     (let loop ((string string)
 106                (offset 0))
 107       (cond ((string-null? string)
 108              #f)
 109             ((string-prefix? what string)
 110              offset)
 111             (else
 112              (loop (string-drop string 1) (+ 1 offset))))))
 113
 114   (define len
 115     (string-length separator))
 116
 117   (let loop ((string string)
 118              (result  '()))
 119     (cond ((index string separator)
 120            =>
 121            (lambda (offset)
 122              (loop (string-drop string (+ offset len))
 123                    (cons (substring string 0 offset)
 124                          result))))
 125           (else
 126            (reverse (cons string result))))))
 127
 128 (define* (evaluate-search-paths search-paths directories
 129                                 #:optional (getenv (const #f)))
 130   "Evaluate SEARCH-PATHS, a list of search-path specifications, for
 131 DIRECTORIES, a list of directory names, and return a list of
 132 specification/value pairs.  Use GETENV to determine the current settings and
 133 report only settings not already effective."
 134   (define search-path-definition
 135     (match-lambda
 136       ((and spec
 137             ($ <search-path-specification> variable files separator
 138                                            type pattern))
 139        (let* ((values (or (and=> (getenv variable)
 140                                  (cut string-tokenize* <> separator))
 141                           '()))
 142               ;; Add a trailing slash to force symlinks to be treated as
 143               ;; directories when 'find-files' traverses them.
 144               (files  (if pattern
 145                           (map (cut string-append <> "/") files)
 146                           files))
 147
 148               ;; XXX: Silence 'find-files' when it stumbles upon non-existent
 149               ;; directories (see
 150               ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
 151               (path   (with-null-error-port
 152                        (search-path-as-list files directories
 153                                             #:type type
 154                                             #:pattern pattern))))
 155          (if (every (cut member <> values) path)
 156              #f                         ;VARIABLE is already set appropriately
 157              (cons spec (string-join path separator)))))))
 158
 159   (filter-map search-path-definition search-paths))
 160
 161 (define* (environment-variable-definition variable value
 162                                           #:key
 163                                           (kind 'exact)
 164                                           (separator ":"))
 165   "Return a the definition of VARIABLE to VALUE in Bash syntax.
 166
 167 KIND can be either 'exact (return the definition of VARIABLE=VALUE),
 168 'prefix (return the definition where VALUE is added as a prefix to VARIABLE's
 169 current value), or 'suffix (return the definition where VALUE is added as a
 170 suffix to VARIABLE's current value.)  In the case of 'prefix and 'suffix,
 171 SEPARATOR is used as the separator between VARIABLE's current value and its
 172 prefix/suffix."
 173   (match kind
 174     ('exact
 175      (format #f "export ~a=\"~a\"" variable value))
 176     ('prefix
 177      (format #f "export ~a=\"~a${~a:+~a}$~a\""
 178              variable value variable separator variable))
 179     ('suffix
 180      (format #f "export ~a=\"$~a${~a:+~a}~a\""
 181              variable variable variable separator value))))
 182
 183 (define* (search-path-definition search-path value
 184                                  #:key (kind 'exact))
 185   "Similar to 'environment-variable-definition', but applied to a
 186 <search-path-specification>."
 187   (match search-path
 188     (($ <search-path-specification> variable _ separator)
 189      (environment-variable-definition variable value
 190                                       #:kind kind
 191                                       #:separator separator))))
 192
 193 ;;; search-paths.scm ends here