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

guix build: Support '--with-source' along with '-e'.

Browse source 
* guix/scripts/build.scm (derivation-from-expression): Remove.
  (options->derivations): Handle pairs of the form
  "('argument . (? derivation?))".
  (options/resolve-packages): Add 'store' parameter; update caller.  Add
  'system' variable.  Add case for 'expression pairs.
* guix/scripts/archive.scm (derivation-from-expression): New procedure.
This commit is contained in:
Ludovic Courtès 2014-03-13 19:21:49 +01:00
parent 9037ea2c12
commit 257b93412a
2 changed files with 34 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/scripts/archive.scm
View file

@ -23,6 +23,7 @@ (define-module (guix scripts archive)
#: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 @@ (define %options
%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."

41
guix/scripts/build.scm
View file

@ -34,32 +34,12 @@ (define-module (guix scripts build)
#: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 @@ (define src? (assoc-ref opts 'source?))
(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 @@ (define sys (assoc-ref opts 'system))
(_ #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))