diff options
| -rw-r--r-- | guix/derivations.scm | 19 | ||||
| -rw-r--r-- | guix/gexp.scm | 158 | ||||
| -rw-r--r-- | tests/derivations.scm | 17 | ||||
| -rw-r--r-- | tests/gexp.scm | 34 |
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")) |