aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-02-13 17:23:17 +0100
committerLudovic Courtès <ludo@gnu.org>2015-02-13 17:28:19 +0100
commitaa72d9afdfe2d65e73c426c280667323181ae592 (patch)
treeacf6256fe1e17138fceea44f72372be8c381c9a3
parent57a516d3ec6e6166490ce2892b0e767c5199d060 (diff)
downloadguix-aa72d9afdfe2d65e73c426c280667323181ae592.tar
guix-aa72d9afdfe2d65e73c426c280667323181ae592.tar.gz
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.
-rw-r--r--guix/derivations.scm19
-rw-r--r--guix/gexp.scm158
-rw-r--r--tests/derivations.scm17
-rw-r--r--tests/gexp.scm34
4 files changed, 195 insertions, 33 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 678550a39e..e5922365a0 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -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))
diff --git a/guix/gexp.scm b/guix/gexp.scm
index fa712a8b9b..0620683078 100644
--- a/guix/gexp.scm
+++ b/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:
;;;
@@ -502,6 +506,157 @@ package/derivation references."
;;;
+;;; 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.
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 80aabad3a8..e23bdeed77 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -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))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 03722e4669..68c470d3b6 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -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"))