diff options
| -rw-r--r-- | guix/scripts/archive.scm | 19 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 41 |
2 files changed, 34 insertions, 26 deletions
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 8280a821c5..0ab7686585 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -23,6 +23,7 @@ #:use-module (guix store) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix monads) #:use-module (guix ui) #:use-module (guix pki) #:use-module (guix pk-crypto) @@ -143,6 +144,24 @@ Export/import one or more packages from/to the store.\n")) %standard-build-options)) +(define (derivation-from-expression store str package-derivation + system source?) + "Read/eval STR and return the corresponding derivation path for SYSTEM. +When SOURCE? is true and STR evaluates to a package, return the derivation of +the package source; otherwise, use PACKAGE-DERIVATION to compute the +derivation of a package." + (match (read/eval str) + ((? package? p) + (if source? + (let ((source (package-source p))) + (if source + (package-source-derivation store source) + (leave (_ "package `~a' has no source~%") + (package-name p)))) + (package-derivation store p system))) + ((? procedure? proc) + (run-with-store store (proc) #:system system)))) + (define (options->derivations+files store opts) "Given OPTS, the result of 'args-fold', return a list of derivations to build and a list of store files to transfer." diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 8f6ba192c2..35b10a0ec2 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -34,32 +34,12 @@ #:use-module (srfi srfi-37) #:autoload (gnu packages) (find-best-packages-by-name) #:autoload (guix download) (download-to-store) - #:export (derivation-from-expression - - %standard-build-options + #:export (%standard-build-options set-build-options-from-command-line show-build-options-help guix-build)) -(define (derivation-from-expression store str package-derivation - system source?) - "Read/eval STR and return the corresponding derivation path for SYSTEM. -When SOURCE? is true and STR evaluates to a package, return the derivation of -the package source; otherwise, use PACKAGE-DERIVATION to compute the -derivation of a package." - (match (read/eval str) - ((? package? p) - (if source? - (let ((source (package-source p))) - (if source - (package-source-derivation store source) - (leave (_ "package `~a' has no source~%") - (package-name p)))) - (package-derivation store p system))) - ((? procedure? proc) - (run-with-store store (proc) #:system system)))) - (define (specification->package spec) "Return a package matching SPEC. SPEC may be a package name, or a package name followed by a hyphen and a version number. If the version number is not @@ -322,16 +302,15 @@ build." (define sys (assoc-ref opts 'system)) (let ((opts (options/with-source store - (options/resolve-packages opts)))) + (options/resolve-packages store opts)))) (filter-map (match-lambda - (('expression . str) - (derivation-from-expression store str package->derivation - sys src?)) (('argument . (? package? p)) (if src? (let ((s (package-source p))) (package-source-derivation store s)) (package->derivation store p sys))) + (('argument . (? derivation? drv)) + drv) (('argument . (? derivation-path? drv)) (call-with-input-file drv read-derivation)) (('argument . (? store-path?)) @@ -340,14 +319,24 @@ build." (_ #f)) opts))) -(define (options/resolve-packages opts) +(define (options/resolve-packages store opts) "Return OPTS with package specification strings replaced by actual packages." + (define system + (or (assoc-ref opts 'system) (%current-system))) + (map (match-lambda (('argument . (? string? spec)) (if (store-path? spec) `(argument . ,spec) `(argument . ,(specification->package spec)))) + (('expression . str) + (match (read/eval str) + ((? package? p) + `(argument . ,p)) + ((? procedure? proc) + (let ((drv (run-with-store store (proc) #:system system))) + `(argument . ,drv))))) (opt opt)) opts)) |