[jackhill/guix/guix.git] / guix / search-paths.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2017, 2018 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
            set-search-paths))

;;; 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 | #f
                (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 spec)
    (match spec
      (($ <search-path-specification> variable files #f type pattern)
       ;; Separator is #f so return the first match.
       (match (with-null-error-port
               (search-path-as-list files directories
                                    #:type type
                                    #:pattern pattern))
         (()
          #f)
         ((head . _)
          (let ((value (getenv variable)))
            (if (and value (string=? value head))
                #f                         ;VARIABLE already set appropriately
                (cons spec head))))))
      (($ <search-path-specification> variable files separator
                                      type pattern)
       (let* ((values (or (and=> (getenv variable)
                                 (cut string-tokenize* <> separator))
                          '()))
              ;; 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 (if (not separator) 'exact 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))))

(define* (set-search-paths search-paths directories
                           #:key (setenv setenv))
  "Set the search path environment variables specified by SEARCH-PATHS for the
given directories."
  (for-each (match-lambda
              ((spec . value)
               (setenv (search-path-specification-variable spec)
                       value)))
            (evaluate-search-paths search-paths directories)))

;;; search-paths.scm ends here
Commit	Line	Data
e89431bf	1	;;; GNU Guix --- Functional package management for GNU
54fd5ad0	2	;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
e89431bf LC	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)
6568d2bd LC	21	#:use-module (guix build utils)
	22	#:use-module (srfi srfi-1)
	23	#:use-module (srfi srfi-26)
e89431bf LC	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
fdfa753c LC	34	$PATH
fdfa753c LC	35
e89431bf	36	search-path-specification->sexp
6568d2bd	37	sexp->search-path-specification
d838e702	38	string-tokenize*
b07901c0	39	evaluate-search-paths
8e3a3bc2	40	environment-variable-definition
54fd5ad0 LC	41	search-path-definition
54fd5ad0 LC	42	set-search-paths))
e89431bf LC	43
	44	;;; Commentary:
	45	;;;
	46	;;; This module defines "search path specifications", which allow packages to
	47	;;; declare environment variables that they use to define search paths. For
	48	;;; instance, GCC has the 'CPATH' variable, Guile has the 'GUILE_LOAD_PATH'
	49	;;; variable, etc.
	50	;;;
	51	;;; Code:
	52
	53	;; The specification of a search path.
	54	(define-record-type* <search-path-specification>
	55	search-path-specification make-search-path-specification
	56	search-path-specification?
	57	(variable search-path-specification-variable) ;string
	58	(files search-path-specification-files) ;list of strings
fcd75bdb	59	(separator search-path-specification-separator ;string \| #f
e89431bf LC	60	(default ":"))
	61	(file-type search-path-specification-file-type ;symbol
	62	(default 'directory))
	63	(file-pattern search-path-specification-file-pattern ;#f \| string
	64	(default #f)))
	65
fdfa753c LC	66	(define $PATH
	67	;; The 'PATH' variable. This variable is a bit special: it is not attached
	68	;; to any package in particular.
	69	(search-path-specification
	70	(variable "PATH")
	71	(files '("bin" "sbin"))))
	72
e89431bf LC	73	(define (search-path-specification->sexp spec)
	74	"Return an sexp representing SPEC, a <search-path-specification>. The sexp
	75	corresponds to the arguments expected by `set-path-environment-variable'."
	76	;; Note that this sexp format is used both by build systems and in
	77	;; (guix profiles), so think twice before you change it.
	78	(match spec
	79	(($ <search-path-specification> variable files separator type pattern)
	80	`(,variable ,files ,separator ,type ,pattern))))
	81
	82	(define (sexp->search-path-specification sexp)
	83	"Convert SEXP, which is as returned by 'search-path-specification->sexp', to
	84	a <search-path-specification> object."
	85	(match sexp
	86	((variable files separator type pattern)
	87	(search-path-specification
	88	(variable variable)
	89	(files files)
	90	(separator separator)
	91	(file-type type)
	92	(file-pattern pattern)))))
	93
6568d2bd LC	94	(define-syntax-rule (with-null-error-port exp)
	95	"Evaluate EXP with the error port pointing to the bit bucket."
	96	(with-error-to-port (%make-void-port "w")
	97	(lambda () exp)))
	98
	99	;; XXX: This procedure used to be in (guix utils) but since we want to be able
	100	;; to use (guix search-paths) on the build side, we want to avoid the
	101	;; dependency on (guix utils), and so this procedure is back here for now.
	102	(define (string-tokenize* string separator)
	103	"Return the list of substrings of STRING separated by SEPARATOR. This is
	104	like `string-tokenize', but SEPARATOR is a string."
	105	(define (index string what)
	106	(let loop ((string string)
	107	(offset 0))
	108	(cond ((string-null? string)
	109	#f)
	110	((string-prefix? what string)
	111	offset)
	112	(else
	113	(loop (string-drop string 1) (+ 1 offset))))))
	114
	115	(define len
	116	(string-length separator))
	117
	118	(let loop ((string string)
	119	(result '()))
	120	(cond ((index string separator)
	121	=>
	122	(lambda (offset)
	123	(loop (string-drop string (+ offset len))
	124	(cons (substring string 0 offset)
	125	result))))
	126	(else
	127	(reverse (cons string result))))))
	128
36914999	129	(define* (evaluate-search-paths search-paths directories
6568d2bd	130	#:optional (getenv (const #f)))
36914999 LC	131	"Evaluate SEARCH-PATHS, a list of search-path specifications, for
	132	DIRECTORIES, a list of directory names, and return a list of
	133	specification/value pairs. Use GETENV to determine the current settings and
	134	report only settings not already effective."
fcd75bdb LC	135	(define (search-path-definition spec)
	136	(match spec
	137	(($ <search-path-specification> variable files #f type pattern)
	138	;; Separator is #f so return the first match.
	139	(match (with-null-error-port
	140	(search-path-as-list files directories
	141	#:type type
	142	#:pattern pattern))
	143	(()
	144	#f)
	145	((head . _)
	146	(let ((value (getenv variable)))
	147	(if (and value (string=? value head))
	148	#f ;VARIABLE already set appropriately
	149	(cons spec head))))))
	150	(($ <search-path-specification> variable files separator
	151	type pattern)
6568d2bd LC	152	(let* ((values (or (and=> (getenv variable)
	153	(cut string-tokenize* <> separator))
	154	'()))
6568d2bd LC	155	;; XXX: Silence 'find-files' when it stumbles upon non-existent
	156	;; directories (see
	157	;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
	158	(path (with-null-error-port
36914999	159	(search-path-as-list files directories
6568d2bd LC	160	#:type type
	161	#:pattern pattern))))
	162	(if (every (cut member <> values) path)
	163	#f ;VARIABLE is already set appropriately
441cfb42	164	(cons spec (string-join path separator)))))))
6568d2bd LC	165
	166	(filter-map search-path-definition search-paths))
	167
b07901c0 LC	168	(define* (environment-variable-definition variable value
	169	#:key
	170	(kind 'exact)
	171	(separator ":"))
8e3a3bc2	172	"Return a the definition of VARIABLE to VALUE in Bash syntax.
b07901c0 LC	173
	174	KIND can be either 'exact (return the definition of VARIABLE=VALUE),
	175	'prefix (return the definition where VALUE is added as a prefix to VARIABLE's
	176	current value), or 'suffix (return the definition where VALUE is added as a
	177	suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix,
	178	SEPARATOR is used as the separator between VARIABLE's current value and its
	179	prefix/suffix."
fcd75bdb	180	(match (if (not separator) 'exact kind)
b07901c0 LC	181	('exact
	182	(format #f "export ~a=\"~a\"" variable value))
	183	('prefix
	184	(format #f "export ~a=\"~a${~a:+~a}$~a\""
	185	variable value variable separator variable))
	186	('suffix
	187	(format #f "export ~a=\"$~a${~a:+~a}~a\""
	188	variable variable variable separator value))))
	189
8e3a3bc2 LC	190	(define* (search-path-definition search-path value
	191	#:key (kind 'exact))
	192	"Similar to 'environment-variable-definition', but applied to a
	193	<search-path-specification>."
	194	(match search-path
	195	(($ <search-path-specification> variable _ separator)
	196	(environment-variable-definition variable value
	197	#:kind kind
	198	#:separator separator))))
	199
54fd5ad0 LC	200	(define* (set-search-paths search-paths directories
	201	#:key (setenv setenv))
	202	"Set the search path environment variables specified by SEARCH-PATHS for the
	203	given directories."
	204	(for-each (match-lambda
	205	((spec . value)
	206	(setenv (search-path-specification-variable spec)
	207	value)))
	208	(evaluate-search-paths search-paths directories)))
	209
e89431bf	210	;;; search-paths.scm ends here