gexp: Implement 'imported-modules' & co. using 'gexp->derivation'.
* guix/derivations.scm (imported-files): Keep private.
(%imported-modules, %compiled-modules, build-expression->derivation):
Mark as deprecated.
(imported-modules, compiled-modules): Remove.
* guix/gexp.scm (%mkdir-p-definition): New variable.
(imported-files, search-path*, imported-modules, compiled-modules):
New procedures.
* tests/derivations.scm ("imported-files"): Remove.
* tests/gexp.scm ("imported-files", "gexp->derivation #:modules"): New
tests.
This commit is contained in:
Ludovic Courtès
parent
57a516d3ec
commit
aa72d9afdf
|
|
@ -96,11 +96,8 @@
|
|||
|
||||
build-derivations
|
||||
built-derivations
|
||||
imported-modules
|
||||
compiled-modules
|
||||
|
||||
build-expression->derivation
|
||||
imported-files)
|
||||
build-expression->derivation)
|
||||
|
||||
;; Re-export it from here for backward compatibility.
|
||||
#:re-export (%guile-for-build))
|
||||
|
|
@ -942,7 +939,7 @@ recursively."
|
|||
(remove (cut string=? <> ".")
|
||||
(string-tokenize (dirname file-name) not-slash))))))
|
||||
|
||||
(define* (imported-files store files
|
||||
(define* (imported-files store files ;deprecated
|
||||
#:key (name "file-import")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build)))
|
||||
|
|
@ -982,7 +979,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
|
|||
;; up looking for the same files over and over again.
|
||||
(memoize search-path))
|
||||
|
||||
(define* (%imported-modules store modules
|
||||
(define* (%imported-modules store modules ;deprecated
|
||||
#:key (name "module-import")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build))
|
||||
|
|
@ -1001,7 +998,7 @@ search path."
|
|||
(imported-files store files #:name name #:system system
|
||||
#:guile guile)))
|
||||
|
||||
(define* (%compiled-modules store modules
|
||||
(define* (%compiled-modules store modules ;deprecated
|
||||
#:key (name "module-import-compiled")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build))
|
||||
|
|
@ -1124,7 +1121,7 @@ applied."
|
|||
#:outputs output-names
|
||||
#:local-build? #t)))))
|
||||
|
||||
(define* (build-expression->derivation store name exp
|
||||
(define* (build-expression->derivation store name exp ;deprecated
|
||||
#:key
|
||||
(system (%current-system))
|
||||
(inputs '())
|
||||
|
|
@ -1290,9 +1287,3 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?."
|
|||
|
||||
(define built-derivations
|
||||
(store-lift build-derivations))
|
||||
|
||||
(define imported-modules
|
||||
(store-lift %imported-modules))
|
||||
|
||||
(define compiled-modules
|
||||
(store-lift %compiled-modules))
|
||||
|
|
|
|||
158
guix/gexp.scm
158
guix/gexp.scm
|
|
@ -21,6 +21,7 @@
|
|||
#:use-module (guix monads)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-9 gnu)
|
||||
|
|
@ -31,7 +32,10 @@
|
|||
gexp->derivation
|
||||
gexp->file
|
||||
gexp->script
|
||||
text-file*))
|
||||
text-file*
|
||||
imported-files
|
||||
imported-modules
|
||||
compiled-modules))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -500,6 +504,157 @@ package/derivation references."
|
|||
(lambda #,formals
|
||||
#,sexp)))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Module handling.
|
||||
;;;
|
||||
|
||||
(define %mkdir-p-definition
|
||||
;; The code for 'mkdir-p' is copied from (guix build utils). We use it in
|
||||
;; derivations that cannot use the #:modules argument of 'gexp->derivation'
|
||||
;; precisely because they implement that functionality.
|
||||
(gexp
|
||||
(define (mkdir-p dir)
|
||||
(define absolute?
|
||||
(string-prefix? "/" dir))
|
||||
|
||||
(define not-slash
|
||||
(char-set-complement (char-set #\/)))
|
||||
|
||||
(let loop ((components (string-tokenize dir not-slash))
|
||||
(root (if absolute? "" ".")))
|
||||
(match components
|
||||
((head tail ...)
|
||||
(let ((path (string-append root "/" head)))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(mkdir path)
|
||||
(loop tail path))
|
||||
(lambda args
|
||||
(if (= EEXIST (system-error-errno args))
|
||||
(loop tail path)
|
||||
(apply throw args))))))
|
||||
(() #t))))))
|
||||
|
||||
(define* (imported-files files
|
||||
#:key (name "file-import")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build)))
|
||||
"Return a derivation that imports FILES into STORE. FILES must be a list
|
||||
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
|
||||
system, imported, and appears under FINAL-PATH in the resulting store path."
|
||||
(define file-pair
|
||||
(match-lambda
|
||||
((final-path . file-name)
|
||||
(mlet %store-monad ((file (interned-file file-name
|
||||
(basename final-path))))
|
||||
(return (list final-path file))))))
|
||||
|
||||
(mlet %store-monad ((files (sequence %store-monad
|
||||
(map file-pair files))))
|
||||
(define build
|
||||
(gexp
|
||||
(begin
|
||||
(use-modules (ice-9 match))
|
||||
|
||||
(ungexp %mkdir-p-definition)
|
||||
|
||||
(mkdir (ungexp output)) (chdir (ungexp output))
|
||||
(for-each (match-lambda
|
||||
((final-path store-path)
|
||||
(mkdir-p (dirname final-path))
|
||||
(symlink store-path final-path)))
|
||||
'(ungexp files)))))
|
||||
|
||||
;; TODO: Pass FILES as an environment variable so that BUILD remains
|
||||
;; exactly the same regardless of FILES: less disk space, and fewer
|
||||
;; 'add-to-store' RPCs.
|
||||
(gexp->derivation name build
|
||||
#:system system
|
||||
#:guile-for-build guile
|
||||
#:local-build? #t)))
|
||||
|
||||
(define search-path*
|
||||
;; A memoizing version of 'search-path' so 'imported-modules' does not end
|
||||
;; up looking for the same files over and over again.
|
||||
(memoize search-path))
|
||||
|
||||
(define* (imported-modules modules
|
||||
#:key (name "module-import")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build))
|
||||
(module-path %load-path))
|
||||
"Return a derivation that contains the source files of MODULES, a list of
|
||||
module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
|
||||
search path."
|
||||
;; TODO: Determine the closure of MODULES, build the `.go' files,
|
||||
;; canonicalize the source files through read/write, etc.
|
||||
(let ((files (map (lambda (m)
|
||||
(let ((f (string-append
|
||||
(string-join (map symbol->string m) "/")
|
||||
".scm")))
|
||||
(cons f (search-path* module-path f))))
|
||||
modules)))
|
||||
(imported-files files #:name name #:system system
|
||||
#:guile guile)))
|
||||
|
||||
(define* (compiled-modules modules
|
||||
#:key (name "module-import-compiled")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build))
|
||||
(module-path %load-path))
|
||||
"Return a derivation that builds a tree containing the `.go' files
|
||||
corresponding to MODULES. All the MODULES are built in a context where
|
||||
they can refer to each other."
|
||||
(mlet %store-monad ((modules (imported-modules modules
|
||||
#:system system
|
||||
#:guile guile
|
||||
#:module-path
|
||||
module-path)))
|
||||
(define build
|
||||
(gexp
|
||||
(begin
|
||||
(use-modules (ice-9 ftw)
|
||||
(ice-9 match)
|
||||
(srfi srfi-26)
|
||||
(system base compile))
|
||||
|
||||
(ungexp %mkdir-p-definition)
|
||||
|
||||
(define (regular? file)
|
||||
(not (member file '("." ".."))))
|
||||
|
||||
(define (process-directory directory output)
|
||||
(let ((entries (map (cut string-append directory "/" <>)
|
||||
(scandir directory regular?))))
|
||||
(for-each (lambda (entry)
|
||||
(if (file-is-directory? entry)
|
||||
(let ((output (string-append output "/"
|
||||
(basename entry))))
|
||||
(mkdir-p output)
|
||||
(process-directory entry output))
|
||||
(let* ((base (string-drop-right
|
||||
(basename entry)
|
||||
4)) ;.scm
|
||||
(output (string-append output "/" base
|
||||
".go")))
|
||||
(compile-file entry
|
||||
#:output-file output
|
||||
#:opts
|
||||
%auto-compilation-options))))
|
||||
entries)))
|
||||
|
||||
(set! %load-path (cons (ungexp modules) %load-path))
|
||||
(mkdir (ungexp output))
|
||||
(chdir (ungexp modules))
|
||||
(process-directory "." (ungexp output)))))
|
||||
|
||||
;; TODO: Pass MODULES as an environment variable.
|
||||
(gexp->derivation name build
|
||||
#:system system
|
||||
#:guile-for-build guile
|
||||
#:local-build? #t)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Convenience procedures.
|
||||
|
|
@ -562,7 +717,6 @@ and store file names; the resulting store file holds references to all these."
|
|||
|
||||
(gexp->derivation name builder))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Syntactic sugar.
|
||||
|
|
|
|||
|
|
@ -670,23 +670,6 @@
|
|||
(let ((p (derivation->output-path drv)))
|
||||
(string-contains (call-with-input-file p read-line) "GNU")))))
|
||||
|
||||
(test-assert "imported-files"
|
||||
(let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm"))
|
||||
("a/b/c" . ,(search-path %load-path
|
||||
"guix/derivations.scm"))
|
||||
("p/q" . ,(search-path %load-path "guix.scm"))
|
||||
("p/z" . ,(search-path %load-path "guix/store.scm"))))
|
||||
(drv (imported-files %store files)))
|
||||
(and (build-derivations %store (list drv))
|
||||
(let ((dir (derivation->output-path drv)))
|
||||
(every (match-lambda
|
||||
((path . source)
|
||||
(equal? (call-with-input-file (string-append dir "/" path)
|
||||
get-bytevector-all)
|
||||
(call-with-input-file source
|
||||
get-bytevector-all))))
|
||||
files)))))
|
||||
|
||||
(test-assert "build-expression->derivation with modules"
|
||||
(let* ((builder `(begin
|
||||
(use-modules (guix build utils))
|
||||
|
|
|
|||
|
|
@ -360,6 +360,40 @@
|
|||
(string=? (readlink (string-append out "/" two "/one"))
|
||||
one)))))))
|
||||
|
||||
(test-assertm "imported-files"
|
||||
(mlet* %store-monad
|
||||
((files -> `(("x" . ,(search-path %load-path "ice-9/q.scm"))
|
||||
("a/b/c" . ,(search-path %load-path
|
||||
"guix/derivations.scm"))
|
||||
("p/q" . ,(search-path %load-path "guix.scm"))
|
||||
("p/z" . ,(search-path %load-path "guix/store.scm"))))
|
||||
(drv (imported-files files)))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list drv))
|
||||
(let ((dir (derivation->output-path drv)))
|
||||
(return
|
||||
(every (match-lambda
|
||||
((path . source)
|
||||
(equal? (call-with-input-file (string-append dir "/" path)
|
||||
get-bytevector-all)
|
||||
(call-with-input-file source
|
||||
get-bytevector-all))))
|
||||
files))))))
|
||||
|
||||
(test-assertm "gexp->derivation #:modules"
|
||||
(mlet* %store-monad
|
||||
((build -> #~(begin
|
||||
(use-modules (guix build utils))
|
||||
(mkdir-p (string-append #$output "/guile/guix/nix"))
|
||||
#t))
|
||||
(drv (gexp->derivation "test-with-modules" build
|
||||
#:modules '((guix build utils)))))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list drv))
|
||||
(let* ((p (derivation->output-path drv))
|
||||
(s (stat (string-append p "/guile/guix/nix"))))
|
||||
(return (eq? (stat:type s) 'directory))))))
|
||||
|
||||
(test-assertm "gexp->derivation #:references-graphs"
|
||||
(mlet* %store-monad
|
||||
((one (text-file "one" "hello, world"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue