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

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

;;; search-paths.scm ends here
Commit	Line	Data
e89431bf	1	;;; GNU Guix --- Functional package management for GNU
fcd75bdb	2	;;; Copyright © 2013, 2014, 2015, 2017 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 LC	40	environment-variable-definition
8e3a3bc2 LC	41	search-path-definition))
e89431bf LC	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
fcd75bdb	58	(separator search-path-specification-separator ;string \| #f
e89431bf LC	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
fdfa753c LC	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
e89431bf LC	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
6568d2bd LC	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
36914999	128	(define* (evaluate-search-paths search-paths directories
6568d2bd	129	#:optional (getenv (const #f)))
36914999 LC	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."
fcd75bdb LC	134	(define (search-path-definition spec)
	135	(match spec
	136	(($ <search-path-specification> variable files #f type pattern)
	137	;; Separator is #f so return the first match.
	138	(match (with-null-error-port
	139	(search-path-as-list files directories
	140	#:type type
	141	#:pattern pattern))
	142	(()
	143	#f)
	144	((head . _)
	145	(let ((value (getenv variable)))
	146	(if (and value (string=? value head))
	147	#f ;VARIABLE already set appropriately
	148	(cons spec head))))))
	149	(($ <search-path-specification> variable files separator
	150	type pattern)
6568d2bd LC	151	(let* ((values (or (and=> (getenv variable)
	152	(cut string-tokenize* <> separator))
	153	'()))
6568d2bd LC	154	;; XXX: Silence 'find-files' when it stumbles upon non-existent
	155	;; directories (see
	156	;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
	157	(path (with-null-error-port
36914999	158	(search-path-as-list files directories
6568d2bd LC	159	#:type type
	160	#:pattern pattern))))
	161	(if (every (cut member <> values) path)
	162	#f ;VARIABLE is already set appropriately
441cfb42	163	(cons spec (string-join path separator)))))))
6568d2bd LC	164
	165	(filter-map search-path-definition search-paths))
	166
b07901c0 LC	167	(define* (environment-variable-definition variable value
	168	#:key
	169	(kind 'exact)
	170	(separator ":"))
8e3a3bc2	171	"Return a the definition of VARIABLE to VALUE in Bash syntax.
b07901c0 LC	172
	173	KIND can be either 'exact (return the definition of VARIABLE=VALUE),
	174	'prefix (return the definition where VALUE is added as a prefix to VARIABLE's
	175	current value), or 'suffix (return the definition where VALUE is added as a
	176	suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix,
	177	SEPARATOR is used as the separator between VARIABLE's current value and its
	178	prefix/suffix."
fcd75bdb	179	(match (if (not separator) 'exact kind)
b07901c0 LC	180	('exact
	181	(format #f "export ~a=\"~a\"" variable value))
	182	('prefix
	183	(format #f "export ~a=\"~a${~a:+~a}$~a\""
	184	variable value variable separator variable))
	185	('suffix
	186	(format #f "export ~a=\"$~a${~a:+~a}~a\""
	187	variable variable variable separator value))))
	188
8e3a3bc2 LC	189	(define* (search-path-definition search-path value
	190	#:key (kind 'exact))
	191	"Similar to 'environment-variable-definition', but applied to a
	192	<search-path-specification>."
	193	(match search-path
	194	(($ <search-path-specification> variable _ separator)
	195	(environment-variable-definition variable value
	196	#:kind kind
	197	#:separator separator))))
	198
e89431bf	199	;;; search-paths.scm ends here