diff options
Diffstat (limited to 'guix/gexp.scm')
| -rw-r--r-- | guix/gexp.scm | 101 |
1 files changed, 69 insertions, 32 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 8dea022e04..d26fad7e0b 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; ;;; This file is part of GNU Guix. @@ -60,6 +60,7 @@ program-file-name program-file-gexp program-file-guile + program-file-module-path scheme-file scheme-file? @@ -380,45 +381,49 @@ This is the declarative counterpart of 'gexp->derivation'." (apply gexp->derivation name gexp options))))) (define-record-type <program-file> - (%program-file name gexp guile) + (%program-file name gexp guile path) program-file? (name program-file-name) ;string (gexp program-file-gexp) ;gexp - (guile program-file-guile)) ;package + (guile program-file-guile) ;package + (path program-file-module-path)) ;list of strings -(define* (program-file name gexp #:key (guile #f)) +(define* (program-file name gexp #:key (guile #f) (module-path %load-path)) "Return an object representing the executable store item NAME that runs -GEXP. GUILE is the Guile package used to execute that script. +GEXP. GUILE is the Guile package used to execute that script. Imported +modules of GEXP are looked up in MODULE-PATH. This is the declarative counterpart of 'gexp->script'." - (%program-file name gexp guile)) + (%program-file name gexp guile module-path)) (define-gexp-compiler (program-file-compiler (file <program-file>) system target) ;; Compile FILE by returning a derivation that builds the script. (match file - (($ <program-file> name gexp guile) + (($ <program-file> name gexp guile module-path) (gexp->script name gexp + #:module-path module-path #:guile (or guile (default-guile)))))) (define-record-type <scheme-file> - (%scheme-file name gexp) + (%scheme-file name gexp splice?) scheme-file? (name scheme-file-name) ;string - (gexp scheme-file-gexp)) ;gexp + (gexp scheme-file-gexp) ;gexp + (splice? scheme-file-splice?)) ;Boolean -(define* (scheme-file name gexp) +(define* (scheme-file name gexp #:key splice?) "Return an object representing the Scheme file NAME that contains GEXP. This is the declarative counterpart of 'gexp->file'." - (%scheme-file name gexp)) + (%scheme-file name gexp splice?)) (define-gexp-compiler (scheme-file-compiler (file <scheme-file>) system target) ;; Compile FILE by returning a derivation that builds the file. (match file - (($ <scheme-file> name gexp) - (gexp->file name gexp)))) + (($ <scheme-file> name gexp splice?) + (gexp->file name gexp #:splice? splice?)))) ;; Appending SUFFIX to BASE's output file name. (define-record-type <file-append> @@ -1116,11 +1121,14 @@ they can refer to each other." (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2)) -(define (load-path-expression modules) +(define* (load-path-expression modules #:optional (path %load-path)) "Return as a monadic value a gexp that sets '%load-path' and -'%load-compiled-path' to point to MODULES, a list of module names." - (mlet %store-monad ((modules (imported-modules modules)) - (compiled (compiled-modules modules))) +'%load-compiled-path' to point to MODULES, a list of module names. MODULES +are searched for in PATH." + (mlet %store-monad ((modules (imported-modules modules + #:module-path path)) + (compiled (compiled-modules modules + #:module-path path))) (return (gexp (eval-when (expand load eval) (set! %load-path (cons (ungexp modules) %load-path)) @@ -1129,11 +1137,13 @@ they can refer to each other." %load-compiled-path))))))) (define* (gexp->script name exp - #:key (guile (default-guile))) + #:key (guile (default-guile)) + (module-path %load-path)) "Return an executable script NAME that runs EXP using GUILE, with EXP's -imported modules in its search path." +imported modules in its search path. Look up EXP's modules in MODULE-PATH." (mlet %store-monad ((set-load-path - (load-path-expression (gexp-modules exp)))) + (load-path-expression (gexp-modules exp) + module-path))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) @@ -1148,29 +1158,47 @@ imported modules in its search path." (write '(ungexp set-load-path) port) (write '(ungexp exp) port) - (chmod port #o555))))))) - -(define* (gexp->file name exp #:key (set-load-path? #t)) - "Return a derivation that builds a file NAME containing EXP. When -SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path' -and '%load-compiled-path' to honor EXP's imported modules." + (chmod port #o555)))) + #:module-path module-path))) + +(define* (gexp->file name exp #:key + (set-load-path? #t) + (module-path %load-path) + (splice? #f)) + "Return a derivation that builds a file NAME containing EXP. When SPLICE? +is true, EXP is considered to be a list of expressions that will be spliced in +the resulting file. + +When SET-LOAD-PATH? is true, emit code in the resulting file to set +'%load-path' and '%load-compiled-path' to honor EXP's imported modules. +Lookup EXP's modules in MODULE-PATH." (match (if set-load-path? (gexp-modules exp) '()) (() ;zero modules (gexp->derivation name (gexp (call-with-output-file (ungexp output) (lambda (port) - (write '(ungexp exp) port)))) + (for-each (lambda (exp) + (write exp port)) + '(ungexp (if splice? + exp + (gexp ((ungexp exp))))))))) #:local-build? #t #:substitutable? #f)) ((modules ...) - (mlet %store-monad ((set-load-path (load-path-expression modules))) + (mlet %store-monad ((set-load-path (load-path-expression modules + module-path))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) (lambda (port) (write '(ungexp set-load-path) port) - (write '(ungexp exp) port)))) + (for-each (lambda (exp) + (write exp port)) + '(ungexp (if splice? + exp + (gexp ((ungexp exp))))))))) + #:module-path module-path #:local-build? #t #:substitutable? #f))))) @@ -1235,7 +1263,8 @@ This yields an 'etc' directory containing these two files." files)))))) (define* (directory-union name things - #:key (copy? #f) (quiet? #f)) + #:key (copy? #f) (quiet? #f) + (resolve-collision 'warn-about-collision)) "Return a directory that is the union of THINGS, where THINGS is a list of file-like objects denoting directories. For example: @@ -1243,6 +1272,10 @@ file-like objects denoting directories. For example: yields a directory that is the union of the 'guile' and 'emacs' packages. +Call RESOLVE-COLLISION when several files collide, passing it the list of +colliding files. RESOLVE-COLLISION must return the chosen file or #f, in +which case the colliding entry is skipped altogether. + When HARD-LINKS? is true, create hard links instead of symlinks. When QUIET? is true, the derivation will not print anything." (define symlink @@ -1266,12 +1299,16 @@ is true, the derivation will not print anything." (computed-file name (with-imported-modules '((guix build union)) (gexp (begin - (use-modules (guix build union)) + (use-modules (guix build union) + (srfi srfi-1)) ;for 'first' and 'last' + (union-build (ungexp output) '(ungexp things) #:log-port (ungexp log-port) - #:symlink (ungexp symlink))))))))) + #:symlink (ungexp symlink) + #:resolve-collision + (ungexp resolve-collision))))))))) ;;; |