diff options
| -rw-r--r-- | guix/profiles.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 74 |
2 files changed, 44 insertions, 38 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 8dd04b81c0..91fc2fa435 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -48,7 +48,6 @@ manifest-remove manifest-installed? manifest-matching-entries - manifest=? profile-manifest profile-derivation @@ -196,13 +195,6 @@ must be a manifest-pattern." (filter matches? (manifest-entries manifest))) -(define (manifest=? m1 m2) - "Return #t if manifests M1 and M2 are equal. This differs from 'equal?' in -that the 'inputs' field is ignored for the comparison, since it is know to -have no effect on the manifest contents." - (equal? (manifest->sexp m1) - (manifest->sexp m2))) - ;;; ;;; Profiles. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 0d17414b4f..36e025d479 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -750,6 +750,16 @@ removed from MANIFEST." (unless (string=? profile %current-profile) (add-indirect-root store (canonicalize-path profile)))) +(define (readlink* file) + "Call 'readlink' until the result is not a symlink." + (catch 'system-error + (lambda () + (readlink* (readlink file))) + (lambda args + (if (= EINVAL (system-error-errno args)) + file + (apply throw args))))) + ;;; ;;; Entry point. @@ -921,36 +931,40 @@ more information.~%")) (when (equal? profile %current-profile) (ensure-default-profile)) - (if (manifest=? new manifest) - (format (current-error-port) (_ "nothing to be done~%")) - (let ((prof-drv (profile-derivation (%store) new)) - (remove (manifest-matching-entries manifest remove))) - (show-what-to-remove/install remove install dry-run?) - (show-what-to-build (%store) (list prof-drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - - (or dry-run? - (let* ((prof (derivation->output-path prof-drv)) - (number (generation-number profile)) - - ;; Always use NUMBER + 1 for the new profile, - ;; possibly overwriting a "previous future - ;; generation". - (name (generation-file-name profile - (+ 1 number)))) - (and (build-derivations (%store) (list prof-drv)) - (let ((count (length entries))) - (switch-symlinks name prof) - (switch-symlinks profile name) - (maybe-register-gc-root (%store) profile) - (format #t (N_ "~a package in profile~%" - "~a packages in profile~%" - count) - count) - (display-search-paths entries - profile))))))))))) + (unless (and (null? install) (null? remove)) + (let* ((prof-drv (profile-derivation (%store) new)) + (prof (derivation->output-path prof-drv)) + (remove (manifest-matching-entries manifest remove))) + (show-what-to-remove/install remove install dry-run?) + (show-what-to-build (%store) (list prof-drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?) + + (cond + (dry-run? #t) + ((and (file-exists? profile) + (and=> (readlink* profile) (cut string=? prof <>))) + (format (current-error-port) (_ "nothing to be done~%"))) + (else + (let* ((number (generation-number profile)) + + ;; Always use NUMBER + 1 for the new profile, + ;; possibly overwriting a "previous future + ;; generation". + (name (generation-file-name profile + (+ 1 number)))) + (and (build-derivations (%store) (list prof-drv)) + (let ((count (length entries))) + (switch-symlinks name prof) + (switch-symlinks profile name) + (maybe-register-gc-root (%store) profile) + (format #t (N_ "~a package in profile~%" + "~a packages in profile~%" + count) + count) + (display-search-paths entries + profile)))))))))))) (define (process-query opts) ;; Process any query specified by OPTS. Return #t when a query was |