nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix package: Refactor 'options->installable'. 

* guix/scripts/package.scm (options->upgrade-predicate)
(store-item->manifest-entry): New procedures.
* guix/scripts/package.scm (options->installable): Use them.  Remove the
'packages-to-upgrade' and 'packages-to-install' variables by getting rid
of a level of indirection.
This commit is contained in:
Ludovic Courtès 2015-11-30 22:00:39 +02:00
parent 6e37017506
commit 27b91d7851
1 changed files with 57 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
guix/scripts/package.scm
View File

@ -510,15 +510,10 @@ kind of search path~%")
%standard-build-options)) %standard-build-options))
(define (options->installable opts manifest) (define (options->upgrade-predicate opts)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', "Return a predicate based on the upgrade/do-not-upgrade regexps in OPTS
return the new list of manifest entries." that, given a package name, returns true if the package is a candidate for
(define (package->manifest-entry* package output) upgrading, #f otherwise."
(check-package-freshness package)
;; When given a package via `-e', install the first of its
;; outputs (XXX).
(package->manifest-entry package output))
(define upgrade-regexps (define upgrade-regexps
(filter-map (match-lambda (filter-map (match-lambda
(('upgrade . regexp) (('upgrade . regexp)
@ -533,63 +528,57 @@ return the new list of manifest entries."
(_ #f)) (_ #f))
opts)) opts))
(define packages-to-upgrade (lambda (name)
(match upgrade-regexps (and (any (cut regexp-exec <> name) upgrade-regexps)
(() (not (any (cut regexp-exec <> name) do-not-upgrade-regexps)))))
'())
((_ ...) (define (store-item->manifest-entry item)
"Return a manifest entry for ITEM, a \"/gnu/store/...\" file name."
(let-values (((name version)
(package-name->name+version (store-path-package-name item))))
(manifest-entry
(name name)
(version version)
(output #f)
(item item))))
(define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
return the new list of manifest entries."
(define (package->manifest-entry* package output)
(check-package-freshness package)
(package->manifest-entry package output))
(define upgrade?
(options->upgrade-predicate opts))
(define to-upgrade
(filter-map (match-lambda (filter-map (match-lambda
(($ <manifest-entry> name version output path _) (($ <manifest-entry> name version output path _)
(and (any (cut regexp-exec <> name) (and (upgrade? name)
upgrade-regexps)
(not (any (cut regexp-exec <> name)
do-not-upgrade-regexps))
(upgradeable? name version path) (upgradeable? name version path)
(let ((output (or output "out"))) (let ((output (or output "out")))
(call-with-values (call-with-values
(lambda () (lambda ()
(specification->package+output name output)) (specification->package+output name output))
list)))) package->manifest-entry*))))
(_ #f)) (_ #f))
(manifest-entries manifest))))) (manifest-entries manifest)))
(define to-upgrade
(map (match-lambda
((package output)
(package->manifest-entry* package output)))
packages-to-upgrade))
(define packages-to-install
(filter-map (match-lambda
(('install . (? package? p))
(list p "out"))
(('install . (? string? spec))
(and (not (store-path? spec))
(let-values (((package output)
(specification->package+output spec)))
(and package (list package output)))))
(_ #f))
opts))
(define to-install (define to-install
(append (map (match-lambda
((package output)
(package->manifest-entry* package output)))
packages-to-install)
(filter-map (match-lambda (filter-map (match-lambda
(('install . (? package?)) (('install . (? package? p))
#f) ;; When given a package via `-e', install the first of its
(('install . (? store-path? path)) ;; outputs (XXX).
(let-values (((name version) (package->manifest-entry* p "out"))
(package-name->name+version (('install . (? string? spec))
(store-path-package-name path)))) (if (store-path? spec)
(manifest-entry (store-item->manifest-entry spec)
(name name) (let-values (((package output)
(version version) (specification->package+output spec)))
(output #f) (package->manifest-entry* package output))))
(item path))))
(_ #f)) (_ #f))
opts))) opts))
(append to-upgrade to-install)) (append to-upgrade to-install))