ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Implement 'imported-modules' & co. using 'gexp->derivation'.

Browse source 
* 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 2015-02-13 17:23:17 +01:00
parent 57a516d3ec
commit aa72d9afdf
4 changed files with 195 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/derivations.scm
View file

@ -96,11 +96,8 @@ (define-module (guix derivations)
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 @@ (define (parent-directories file-name)
(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 @@ (define search-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 @@ (define* (%imported-modules store modules
(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 @@ (define add-label
#: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 @@ (define %build-inputs
(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
View file

@ -21,6 +21,7 @@ (define-module (guix gexp)
#: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 @@ (define-module (guix gexp)
gexp->derivation
gexp->file
gexp->script
text-file*))
text-file*
imported-files
imported-modules
compiled-modules))
;;; Commentary:
;;;
@ -500,6 +504,157 @@ (define (substitute-references exp substs)
(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 @@ (define builder
(gexp->derivation name builder))
;;;
;;; Syntactic sugar.

17
tests/derivations.scm
View file

@ -670,23 +670,6 @@ (define %coreutils
(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))

34
tests/gexp.scm
View file

@ -360,6 +360,40 @@ (define (match-input thing)
(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"))