diff options
Diffstat (limited to 'guix/scripts/package.scm')
| -rw-r--r-- | guix/scripts/package.scm | 67 |
1 files changed, 22 insertions, 45 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 9699c70c6d..99a6cfaa29 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com> +;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -203,8 +204,12 @@ non-zero relevance score." (match m2 ((package2 . score2) (if (= score1 score2) - (string>? (package-full-name package1) - (package-full-name package2)) + (if (string=? (package-name package1) + (package-name package2)) + (version>? (package-version package1) + (package-version package2)) + (string>? (package-name package1) + (package-name package2))) (> score1 score2)))))))))) (define (transaction-upgrade-entry store entry transaction) @@ -334,24 +339,8 @@ Alternately, see @command{guix package --search-paths -p ~s}.") "Search among all the versions of ENTRY's package that are available, and return the shortest unambiguous version prefix for this package. If only one version of ENTRY's package is available, return the empty string." - (let ((name (manifest-entry-name entry))) - (match (map package-version (find-packages-by-name name)) - ((_) - ;; A single version of NAME is available, so do not specify the - ;; version number, even if the available version doesn't match ENTRY. - "") - (versions - ;; If ENTRY uses the latest version, don't specify any version. - ;; Otherwise return the shortest unique version prefix. Note that - ;; this is based on the currently available packages, which could - ;; differ from the packages available in the revision that was used - ;; to build MANIFEST. - (let ((current (manifest-entry-version entry))) - (if (every (cut version>? current <>) - (delete current versions)) - "" - (version-unique-prefix (manifest-entry-version entry) - versions))))))) + (package-unique-version-prefix (manifest-entry-name entry) + (manifest-entry-version entry))) (define* (export-manifest manifest #:optional (port (current-output-port))) @@ -710,10 +699,10 @@ the resulting manifest entry." (manifest-entry-with-provenance (package->manifest-entry package output))) -(define (options->installable opts manifest transaction) - "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', -return an variant of TRANSACTION that accounts for the specified installations -and upgrades." +(define (options->installable opts manifest transform transaction) + "Given MANIFEST, the current manifest, OPTS, and TRANSFORM, the result of +'args-fold', return an variant of TRANSACTION that accounts for the specified +installations, upgrades and transformations." (define upgrade? (options->upgrade-predicate opts)) @@ -730,13 +719,14 @@ and upgrades." (('install . (? package? p)) ;; When given a package via `-e', install the first of its ;; outputs (XXX). - (package->manifest-entry* p "out")) + (package->manifest-entry* (transform p) "out")) (('install . (? string? spec)) (if (store-path? spec) (store-item->manifest-entry spec) (let-values (((package output) (specification->package+output spec))) - (package->manifest-entry* package output)))) + (package->manifest-entry* (transform package) + output)))) (('install . obj) (leave (G_ "cannot install non-package object: ~s~%") obj)) @@ -901,7 +891,8 @@ processed, #f otherwise." (regexps (map (cut make-regexp* <> regexp/icase) patterns)) (matches (find-packages-by-description regexps))) (leave-on-EPIPE - (display-search-results matches (current-output-port))) + (display-search-results matches (current-output-port) + #:regexps regexps)) #t)) (('show _) @@ -994,16 +985,6 @@ processed, #f otherwise." (define profile (or (assoc-ref opts 'profile) %current-profile)) (define transform (options->transformation opts)) - (define (transform-entry entry) - (let ((item (transform (manifest-entry-item entry)))) - (manifest-entry-with-transformations - (manifest-entry - (inherit entry) - (item item) - (version (if (package? item) - (package-version item) - (manifest-entry-version entry))))))) - (when (equal? profile %current-profile) ;; Normally the daemon created %CURRENT-PROFILE when we connected, unless ;; it's a version that lacks the fix for <https://bugs.gnu.org/37744> @@ -1036,16 +1017,12 @@ processed, #f otherwise." (map load-manifest files)))))) (step1 (options->removable opts manifest (manifest-transaction))) - (step2 (options->installable opts manifest step1)) - (step3 (manifest-transaction - (inherit step2) - (install (map transform-entry - (manifest-transaction-install step2))))) - (new (manifest-perform-transaction manifest step3)) + (step2 (options->installable opts manifest transform step1)) + (new (manifest-perform-transaction manifest step2)) (trans (if (null? files) - step3 + step2 (fold manifest-transaction-install-entry - step3 + step2 (manifest-entries manifest))))) (warn-about-old-distro) |